diff options
Diffstat (limited to 'src/Lazymail/Handlers.hs')
-rw-r--r-- | src/Lazymail/Handlers.hs | 143 |
1 files changed, 138 insertions, 5 deletions
diff --git a/src/Lazymail/Handlers.hs b/src/Lazymail/Handlers.hs index c63d6fc..dc1d389 100644 --- a/src/Lazymail/Handlers.hs +++ b/src/Lazymail/Handlers.hs @@ -9,20 +9,27 @@ module Lazymail.Handlers where import Codec.MIME.Parse(parseMIMEMessage) import Codec.MIME.Type(MIMEValue(..)) -import Control.Exception(evaluate) +import Control.Monad.Reader import Control.Monad.State import Data.List(intercalate, stripPrefix, sort) -import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator) -import System.IO(openFile, IOMode(..), hClose) +import System.Directory(getTemporaryDirectory) +import System.Exit(ExitCode(..)) +import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator, (</>)) +import System.IO(openFile, IOMode(..), hClose, hSeek, SeekMode(..), hPutStrLn) import System.Locale(rfc822DateFormat) +import System.Process(runProcess, waitForProcess) +import System.Random(randomR, getStdGen, setStdGen) import Data.DateTime(parseDateTime, startOfTime, formatDateTime) import qualified System.IO.UTF8 as UTF8 +import qualified System.IO.Strict as Strict +import UI.NCurses(setEcho) import Lazymail.Email(lookupField, getBody, formatBody) import Lazymail.Maildir import Lazymail.Print import Lazymail.State import Lazymail.Types +import Lazymail.Utils(drawNotification) previousMode :: LazymailCurses () previousMode = get >>= \st -> previousMode' (mode st) @@ -40,6 +47,8 @@ previousMode' IndexMode = do let ist = (indexState st) { selectedRowIn = 0, scrollRowIn = 0 } put $ st { mode = MaildirMode, indexState = ist } +previousMode' _ = get >>= \st -> put $ st { mode = MaildirMode} + advanceMode :: LazymailCurses () advanceMode = get >>= \st -> advanceMode' (mode st) @@ -86,6 +95,9 @@ advanceMode' MaildirMode = do advanceMode' _ = return () +toComposeMode :: LazymailCurses () +toComposeMode = get >>= \st -> put $ st { mode = ComposeMode } + freeOldHandlers st = mapM (hClose . emailHandle) $ selectedEmails . indexState $ st scrollDown :: LazymailCurses () @@ -138,7 +150,7 @@ scrollDown' EmailMode = do when ((totalRows - scrRows + (bodyStartRow est) - 1) > (scrollRowEm est)) $ put $ st { emailState = est' } -scrollDown' _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st +scrollDown' _ = return () scrollUp :: LazymailCurses () scrollUp = get >>= \st -> scrollUp' (mode st) @@ -185,7 +197,7 @@ scrollUp' EmailMode = do when (cur > 0) $ put $ st { emailState = est' } -scrollUp' _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st +scrollUp' _ = return () incrementSelectedRow st | (selectedRow st) < limit = case (mode st) of @@ -286,3 +298,124 @@ solveMaildirUpdate = do let mst = maildirState st put $ st { maildirState = (mst { triggerUpdateMD = False }) } +getField :: Maybe String -> LazymailCurses () -> LazymailCurses () +getField pr postActions = do + st <- get + let is = initialInputState { inputRequested = True + , prompt = pr + , postInputActions = postActions} + put $ st { inputState = is } + +updateField :: (ComposeFields -> String -> ComposeFields) -> LazymailCurses () +updateField f = do + st <- get + let value = currentInput . inputState $ st + let cf = (composeFields . composeState $ st) + let cs = (composeState st) { composeFields = (f cf value) } + put $ st { inputState = initialInputState + , composeState = cs + } + +getFrom :: LazymailCurses () +getFrom = let postActions = updateField $ \cf val -> cf { fromField = Just val } + in getField (Just "From: ") postActions + +getTo :: LazymailCurses () +getTo = let postActions = updateField $ \cf val -> cf { toField = Just val } + in getField (Just "To: ") postActions + +getSubject :: LazymailCurses () +getSubject = let postActions = updateField $ \cf val -> cf { subjectField = Just val } + in getField (Just "Subject: ") postActions + +getCc :: LazymailCurses () +getCc = let postActions = updateField $ \cf val -> cf { ccField = Just val } + in getField (Just "Cc: ") postActions + +getBcc :: LazymailCurses () +getBcc = let postActions = updateField $ \cf val -> cf { bccField = Just val } + in getField (Just "Bcc: ") postActions + +getReplyTo :: LazymailCurses () +getReplyTo = let postActions = updateField $ \cf val -> cf { replyToField = Just val } + in getField (Just "Reply-To: ") postActions + +editEmail :: LazymailCurses () +editEmail = do + st <- get + cfg <- ask + fp <- getFileName + exitStatus <- liftIO $ do + child <- runProcess (textEditor cfg) [fp] Nothing Nothing Nothing Nothing Nothing + waitForProcess child + case exitStatus of + ExitSuccess -> do + st <- get + let cs = (composeState st) { bodyReady = True } + put $ st { composeState = cs } + _ -> drawNotification "The text editor exited abnormally" + +-- | Retrieve current file name. Create a randomized one if its's Nothing. +getFileName :: LazymailCurses FilePath +getFileName = do + st <- get + let cs = composeState st + case bodyFileName cs of + Just fp -> return fp + Nothing -> do + fp <- liftIO $ newFilename + let cs = (composeState st) { bodyFileName = Just fp } + put $ st { composeState = cs } + return fp + + where + newFilename = do + tmp <- getTemporaryDirectory + num <- getRandomNumber + return $ (tmp </>) $ ("lazymail-" ++ ) $ show num + +getRandomNumber :: IO Int +getRandomNumber = do + r1 <- getStdGen + let (num, r2) = randomR (100000,999999) r1 + setStdGen r2 + return num + +sendEmail :: LazymailCurses () +sendEmail = do + st <- get + cfg <- ask + let cs = composeState st + if not . readyToSend $ cs + then drawNotification $ + "The email is not ready to be sent. Please check that all fields are correct." + else do + exitStatus <- liftIO $ do + emailHandle <- prepareEmail cs + child <- runProcess (head . sendmailCommand $ cfg) + (tail . sendmailCommand $ cfg) + Nothing Nothing (Just emailHandle) Nothing Nothing + e <- waitForProcess child + hClose emailHandle + return e + handleExitStatus exitStatus + + where + handleExitStatus ExitSuccess = do + drawNotification $ "The email was successfully sent." + st <- get + put $ st { mode = MaildirMode, composeState = initialComposeState } + handleExitStatus _ = drawNotification $ + "Could not send the email. Please, check the logs of for your SMTP client." + prepareEmail cs = do + let fs = composeFields cs + let fileName = (maybe "" id $ bodyFileName cs) + body <- (Strict.hGetContents =<< openFile fileName ReadMode) + emailHandle <- openFile fileName WriteMode + hPutStrLn emailHandle $ (unlines . ppComposeFields True $ fs) ++ body + hClose emailHandle >> openFile fileName ReadMode + +readyToSend cs = + let from = maybe False (\_ -> True) $ fromField . composeFields $ cs + to = maybe False (\_ -> True) $ toField . composeFields $ cs + in all id [from, to, bodyReady cs] |