aboutsummaryrefslogtreecommitdiff
path: root/Maildir.hs
diff options
context:
space:
mode:
authorRaúl Benencia <rul@kalgan.cc>2013-09-05 19:36:33 -0300
committerRaúl Benencia <rul@kalgan.cc>2013-09-05 19:36:33 -0300
commit41b53ca04b6d52457f331930e8fea68416498882 (patch)
treeee63ce86ab4d9a4fc09637a0d5d4015e9f3c9956 /Maildir.hs
parent84fa12fef1736d04ee79e40cebaadadda262f063 (diff)
New project tree structure
Diffstat (limited to 'Maildir.hs')
-rw-r--r--Maildir.hs142
1 files changed, 0 insertions, 142 deletions
diff --git a/Maildir.hs b/Maildir.hs
deleted file mode 100644
index 752f6f0..0000000
--- a/Maildir.hs
+++ /dev/null
@@ -1,142 +0,0 @@
-{- Utilities for working with Maildir format.
- -
- - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
- -
- - Licensed under the GNU GPL version 3 or higher
- -
- -}
-
-module Maildir where
-
-import Control.Monad.Loops(allM)
-import Control.Monad (forM, filterM)
-import Data.List(isPrefixOf)
-import System.Directory (doesDirectoryExist, getDirectoryContents, renameFile)
-import System.FilePath ((</>), takeFileName, takeDirectory, splitDirectories, joinPath)
-import System.IO(IOMode(..), hGetContents, openFile)
-
-import Types(Maildir, Flag(..), Flags)
-
-isMaildir :: FilePath -> IO Bool
-isMaildir fp = allM doesDirectoryExist [ fp
- , fp </> "cur"
- , fp </> "new"
- , fp </> "tmp"]
-
-getMaildirEmails md = do
- r <- (getReadEmails md)
- n <- (getNewEmails md)
- return $ r ++ n
-
-getReadEmails md = getEmails $ md </> "cur"
-getNewEmails md = getEmails $ md </> "new"
-
-getEmails fp = do
- contents <- getDirectoryContents fp
- return $ map (fp </>) $ filter (`notElem` [".", ".."]) contents
-
-{- | Returns information about specific messages. -}
-getMessages :: Maildir -> [FilePath] -> IO [(FilePath, Flags, String)]
-getMessages mb list = do
- messages <- getAll mb
- return $ filter (\(id, f, m) -> id `elem` list) messages
-
-{- Given a mail in a Maildir, mark it as read -}
-markAsRead :: FilePath -> IO FilePath
-markAsRead fp =
- case newPath of
- Nothing -> return fp
- Just path -> do
- renameFile fp path
- return path
- where newPath =
- if not $ isNew fp
- then Just fp
- else do
- let fil = takeFileName fp
- let dir = takeDirectory fp
- let spl = splitDirectories dir
- case last spl of
- "cur" -> Just $ fp ++ "S"
- "new" -> Just $ (joinPath . init $ spl) </> ("cur" </> (fil ++ "S"))
- _ -> Nothing
-
-
--- Based on getRecursiveContents from Real World Haskell
-getMaildirsRecursively :: FilePath -> IO [Maildir]
-getMaildirsRecursively topdir = do
- result <- search topdir
- includeTopDir <- isMaildir topdir
- if includeTopDir
- then return (topdir:result)
- else return result
-
- where
- search topdir = do
- names <- getDirectoryContents topdir
- let properNames = filter (`notElem` [".", ".."]) names
- paths <- forM properNames $ \name -> do
- let path = topdir </> name
- isDirectory <- doesDirectoryExist path
- if isDirectory
- then do
- result <- search path
- return ([path] ++ result)
- else return []
-
- filterM isMaildir (concat paths)
-
-
-{- The following code is an implementation of the Mailbox interface -}
-listIDs :: Maildir -> IO [FilePath]
-listIDs md = getNewIDs md `appendM` getReadIDs md
- where mxs `appendM` mxs' = do
- xs <- mxs
- xs' <- mxs'
- return (xs ++ xs')
-
-getNewIDs :: Maildir -> IO [FilePath]
-getNewIDs md = getIDs (md </> "new")
-
-getReadIDs :: Maildir -> IO [FilePath]
-getReadIDs md = getIDs (md </> "cur")
-
-getIDs :: FilePath -> IO [FilePath]
-getIDs fp = do
- names <-getDirectoryContents fp
- let properNames = filter (`notElem` [".", ".."]) names
- return $ map (fp </>) properNames
-
-listMessageFlags :: Maildir -> IO [(FilePath, Flags)]
-listMessageFlags fp = do
- ids <- (listIDs fp)
- let flags = map getFlags ids
- return (zip ids flags)
-
-getFlags :: FilePath -> Flags
-getFlags fp = addNew $ map toFlag $ strip fp
- where strip x
- | null x = []
- | ":2," `isPrefixOf` x = drop 3 x
- | otherwise = let (discard, analyze) = span (/= ':') fp
- in strip analyze
- addNew flags = if elem SEEN flags then flags else (NEW:flags)
-
-isNew :: FilePath -> Bool
-isNew fp = elem NEW $ getFlags fp
-
-toFlag :: Char -> Flag
-toFlag c | c == 'S' = SEEN
- | c == 'A' = ANSWERED
- | c == 'F' = FLAGGED
- | c == 'D' = DRAFT
- | c == 'P' = FORWARDED
- | c == 'T' = DELETED
- | otherwise = OTHERFLAG [c]
-
-getAll :: Maildir -> IO [(FilePath, Flags, String)]
-getAll fp = do
- ids <- listIDs fp
- msgs <- mapM (\x -> hGetContents =<< openFile x ReadMode) ids
- let flags = map getFlags ids
- return $ zip3 ids flags msgs
nihil fit ex nihilo