diff options
Diffstat (limited to 'Maildir.hs')
| -rw-r--r-- | Maildir.hs | 60 |
1 files changed, 24 insertions, 36 deletions
@@ -1,21 +1,12 @@ --- This module is part of Lazymail, a Haskell email client. --- --- Copyright (C) 2013 Raúl Benencia <rul@kalgan.cc> --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see <http://www.gnu.org/licenses/>. +{- 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 +module Maildir where import Control.Monad.Loops(allM) import Control.Monad (forM, filterM) @@ -24,7 +15,7 @@ import System.Directory (doesDirectoryExist, getDirectoryContents) import System.FilePath ((</>)) import System.IO(IOMode(..), hGetContents, openFile) import Network.Email.Mailbox(Flag(..), Flags) - + type Maildir = FilePath isMaildir :: FilePath -> IO Bool @@ -32,20 +23,20 @@ isMaildir fp = allM doesDirectoryExist [ fp , fp </> "cur" , fp </> "new" , fp </> "tmp"] - + 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") - +getReadIDs md = getIDs (md </> "cur") + getIDs :: FilePath -> IO [FilePath] getIDs fp = do names <-getDirectoryContents fp @@ -57,7 +48,7 @@ listMessageFlags fp = do ids <- (listIDs fp) let flags = map getFlags ids return (zip ids flags) - + getFlags :: FilePath -> Flags getFlags fp = map toFlag $ strip fp where strip x @@ -65,7 +56,7 @@ getFlags fp = map toFlag $ strip fp | ":2," `isPrefixOf` x = drop 3 x | otherwise = let (discard, analyze) = span (/= ':') fp in strip analyze - + toFlag :: Char -> Flag toFlag c | c == 'S' = SEEN | c == 'A' = ANSWERED @@ -74,24 +65,24 @@ toFlag c | c == 'S' = SEEN | 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 - -{- | Returns information about specific messages. -} + +{- | 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 - --- + +-- -- | Based on getRecursiveContents from Real World Haskell --- -getMaildirsRecursively :: FilePath -> IO [Maildir] +-- +getMaildirsRecursively :: FilePath -> IO [Maildir] getMaildirsRecursively topdir = do result <- search topdir includeTopDir <- isMaildir topdir @@ -113,13 +104,10 @@ getMaildirsRecursively topdir = do else return [] filterM isMaildir (concat paths) - - + -- Temporal code for testing purposes -defaultPath = "/home/rul/mail/linti/INBOX.academic.c.questions" +defaultPath = "/home/rul/mail/linti/INBOX.academic.c.questions" getFirstEmail = do lst <- getAll defaultPath let (_, _, msg) = head lst return msg - -
\ No newline at end of file |