Source

imm / Imm / Maildir.hs

Full commit
module Imm.Maildir where

-- {{{ Imports
import Imm.Error
import Imm.Mail
import Imm.Util

import Control.Monad.Error
import Control.Monad.Reader

import qualified Data.Text.Lazy.IO as T
import qualified Data.Text.Lazy as TL
import Data.Time.Clock.POSIX

import Network.BSD

import System.Directory
import System.FilePath
import System.Log.Logger
import System.Random
-- }}}

type Maildir = FilePath

class MaildirWriter m where
    -- | Build a maildir with subdirectories cur, new and tmp.
    init :: m ()
    -- | Add a mail to the maildir
    write  :: Mail -> m ()

instance (MonadBase IO m, MonadError ImmError m) => MaildirWriter (ReaderT Maildir m) where
    init = do
        theMaildir <- ask
        io . debugM "imm.maildir" $ "Creating maildir [" ++ theMaildir ++ "]"
        try $ createDirectoryIfMissing True theMaildir
        try $ createDirectoryIfMissing True (theMaildir </> "cur")
        try $ createDirectoryIfMissing True (theMaildir </> "new")
        try $ createDirectoryIfMissing True (theMaildir </> "tmp")
    write mail = do
        fileName   <- io getUniqueName
        theMaildir <- ask
        io . debugM "imm.maildir" $ "Writing new mail in maildir [" ++ theMaildir ++ "]"
        try $ T.writeFile (theMaildir </> "new" </> fileName) (TL.pack $ show mail)

-- | Return an allegedly unique filename; useful to add new mail files in a maildir.
getUniqueName :: MonadBase IO m => m String
getUniqueName = io $ do
    time     <- show <$> getPOSIXTime
    hostname <- getHostName
    rand     <- show <$> (getStdRandom $ randomR (1,100000) :: IO Int)

    return . concat $ [time, ".", rand, ".", hostname]