[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit b88b1a1fddeee91239120b2fcc22830975d02a1d
Author: John Goerzen <jgoerzen at complete.org>
Date:   Sat Oct 1 08:30:40 2005 +0100

    More work on email stuff

diff --git a/MissingH.cabal b/MissingH.cabal
index 913f762..f52812d 100644
--- a/MissingH.cabal
+++ b/MissingH.cabal
@@ -7,7 +7,7 @@ Stability: Alpha
 Copyright: Copyright (c) 2004-2005 John Goerzen
 Exposed-Modules: MissingH.Str, MissingH.IO, MissingH.IO.Binary, MissingH.List,
   MissingH.Daemon,
-  MissingH.Email.Mailbox,
+  MissingH.Email.Mailbox, MissingH.Email.Mailbox.Maildir,
   MissingH.Logging, MissingH.Logging.Handler,
     MissingH.Logging.Handler.Simple, MissingH.Logging.Handler.Syslog,
     MissingH.Logging.Logger, 
diff --git a/MissingH/Email/Mailbox.hs b/MissingH/Email/Mailbox.hs
index 7072500..e041167 100644
--- a/MissingH/Email/Mailbox.hs
+++ b/MissingH/Email/Mailbox.hs
@@ -42,6 +42,7 @@ data Flag =
            | FLAGGED
            | DELETED
            | DRAFT
+           | FORWARDED
            | OTHERFLAG String
            deriving (Eq, Show)
            
@@ -81,7 +82,7 @@ class (Show a, Show b, Eq b) => MailboxReader a b where
            return $ filter (\(id, f, m) -> id `elem` list) messages
     
 class (MailboxReader a b) => MailboxWriter a b where
-    appendMessage :: a -> Flags -> Message -> IO b
+    appendMessages :: a -> [(Flags, Message)] -> IO [b]
     deleteMessages :: a -> [b] -> IO ()
     addFlags :: a -> [b] -> Flags -> IO ()
     removeFlags :: a -> [b] -> Flags -> IO ()
diff --git a/MissingH/Email/Mailbox/Maildir.hs b/MissingH/Email/Mailbox/Maildir.hs
index c34be0b..b8678f0 100644
--- a/MissingH/Email/Mailbox/Maildir.hs
+++ b/MissingH/Email/Mailbox/Maildir.hs
@@ -17,7 +17,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 
 {- |
-   Module     : MissingH.Email.Mailbox
+   Module     : MissingH.Email.Mailbox.Maildir
    Copyright  : Copyright (C) 2005 John Goerzen
    License    : GNU GPL, version 2 or above
 
@@ -25,39 +25,43 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    Stability  : provisional
    Portability: portable
 
-General support for e-mail mailboxes
+Support for Maildir-style mailboxes.
+
+Information about the Maildir format can be found at:
+
+ * <http://www.qmail.org/qmail-manual-html/man5/maildir.html>
+ * <http://cr.yp.to/proto/maildir.html>
 
 Written by John Goerzen, jgoerzen\@complete.org
 -}
 
-module MissingH.Email.Mailbox(Flag(..), Message, Flags,
-                              MailboxReader(..),
-                              MailboxWriter(..))
+module MissingH.Email.Mailbox.Maildir(Maildir(..), readMaildir)
 where
 
-type Message = String
-
-data Flag = 
-           SEEN
-           | ANSWERED
-           | FLAGGED
-           | DELETED
-           | DRAFT
-           | OTHERFLAG String
-           deriving (Eq, Show)
-           
-type Flags = [Flag]
-
-class (Show a, Show b) => MailboxReader a b where
-    listMessageIDs :: a -> IO [b]
-    listMessageFlags :: a -> IO [(b, Flags)]
-    getAll :: a -> IO [(b, Flags, Message)]
-    getMessages :: a -> [b] -> IO [(b, Flags, Message)]
-    
-class (MailboxReader a b) => MailboxWriter a b where
-    appendMessage :: a -> Flags -> Message -> IO b
-    deleteMessages :: a -> [b] -> IO ()
-    addFlags :: a -> [b] -> Flags -> IO ()
-    removeFlags :: a -> [b] -> Flags -> IO ()
-    setFlags :: a -> [b] -> Flags -> IO ()
+import MissingH.Email.Mailbox
+import System.Posix.IO(OpenMode(..))
+import System.Directory
+import MissingH.Path
+import MissingH.Maybe
+import Control.Monad
+
+data Maildir = Maildir 
+    {loc :: FilePath}
+instance Show Maildir
+    where show x = loc x
+                       
+
+{- | Open a Maildir mailbox. -}
+-- For reading only, for now.
+
+readMaildir :: FilePath -> IO Maildir
+readMaildir fp =
+    do cwd <- getCurrentDirectory
+       let abspath = forceMaybeMsg "abspath readMaildir" $ absNormPath cwd fp
+       c <- getDirectoryContents fp
+       unless ("cur" `elem` c && "new" `elem` c && "tmp" `elem` c)
+              $ error (fp ++ " is not a valid Maildir.")
+       return (Maildir fp)
+
 
+        
\ No newline at end of file

-- 
haskell-testpack