aboutsummaryrefslogtreecommitdiff
path: root/src/Lazymail/Handlers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Lazymail/Handlers.hs')
-rw-r--r--src/Lazymail/Handlers.hs143
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]
nihil fit ex nihilo