diff options
| -rw-r--r-- | src/Lazymail/Config.hs | 2 | ||||
| -rw-r--r-- | src/Lazymail/Handlers.hs | 143 | ||||
| -rw-r--r-- | src/Lazymail/Keymap.hs | 16 | ||||
| -rw-r--r-- | src/Lazymail/Print.hs | 25 | ||||
| -rw-r--r-- | src/Lazymail/Screen.hs | 93 | ||||
| -rw-r--r-- | src/Lazymail/State.hs | 21 | ||||
| -rw-r--r-- | src/Lazymail/Types.hs | 23 | ||||
| -rw-r--r-- | src/Lazymail/Utils.hs | 56 |
8 files changed, 352 insertions, 27 deletions
diff --git a/src/Lazymail/Config.hs b/src/Lazymail/Config.hs index bfe2333..5769d8e 100644 --- a/src/Lazymail/Config.hs +++ b/src/Lazymail/Config.hs @@ -31,6 +31,8 @@ defaultConfig = LazymailConfig { , indexModeKeymap = defaultIndexKeymap , emailModeKeymap = defaultEmailKeymap , composeModeKeymap = defaultComposeKeymap + , textEditor = "editor" + , sendmailCommand = ["msmtp", "--read-envelope-from", "-t"] } -- 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] diff --git a/src/Lazymail/Keymap.hs b/src/Lazymail/Keymap.hs index cdd57cc..9bb2aaa 100644 --- a/src/Lazymail/Keymap.hs +++ b/src/Lazymail/Keymap.hs @@ -17,17 +17,29 @@ module Lazymail.Keymap import UI.NCurses(Event(..), Key(..)) import Lazymail.Types(Keymap, LazymailState(..), Mode(..), LazymailConfig(..)) -import Lazymail.Handlers(advanceMode, previousMode, scrollUp, scrollDown) +import Lazymail.Handlers( advanceMode, previousMode, scrollUp, scrollDown + , toComposeMode, getFrom, getTo, getSubject, getCc + , getBcc, getReplyTo, editEmail, sendEmail + ) defaultGlobalKeymap = [ ([EventCharacter '\n', EventCharacter ' ', EventSpecialKey KeyRightArrow], advanceMode) , ([EventCharacter 'q', EventCharacter 'Q'], previousMode) , ([EventSpecialKey KeyUpArrow, EventCharacter 'k'], scrollUp) , ([EventSpecialKey KeyDownArrow, EventCharacter 'j'], scrollDown) + , ([EventCharacter 'm'], toComposeMode) ] defaultMaildirKeymap = [] defaultIndexKeymap = [] defaultEmailKeymap = [] -defaultComposeKeymap = [] +defaultComposeKeymap = [ ([EventCharacter 'f'], getFrom) + , ([EventCharacter 't'], getTo) + , ([EventCharacter 's'], getSubject) + , ([EventCharacter 'c'], getCc) + , ([EventCharacter 'b'], getBcc) + , ([EventCharacter 'r'], getReplyTo) + , ([EventCharacter 'e'], editEmail) + , ([EventCharacter 'y'], sendEmail) + ] -- | Try to find a keymap for the current mode. If nothing is found, then -- try looking up in the global keymap. diff --git a/src/Lazymail/Print.hs b/src/Lazymail/Print.hs index 15e9df1..a6a38d1 100644 --- a/src/Lazymail/Print.hs +++ b/src/Lazymail/Print.hs @@ -13,7 +13,7 @@ import Data.List (intercalate) import Lazymail.Email import Codec.Text.Rfc1342 -import Lazymail.Types(Flag(..), Flags) +import Lazymail.Types(Flag(..), Flags, ComposeFields(..), ComposeState(..)) unquote xs= if (head xs == '"' && last xs == '"') then (tail . init) xs else xs @@ -43,18 +43,29 @@ ppFlag FORWARDED = 'P' ppFlag DELETED = 'T' ppFlag (OTHERFLAG [c]) = c +ppComposeState cs = ppComposeFields False (composeFields cs) ++ + [("Body file name: " ++) $ maybe "-" id $ bodyFileName cs] + +ppComposeFields removeEmpty cf | removeEmpty == False = l + | otherwise = filter (\str -> (last str) /= '-') l + where l = [ ("From: " ++) $ maybe "-" id $ fromField cf + , ("To: " ++) $ maybe "-" id $ toField cf + , ("Cc: " ++) $ maybe "-" id $ ccField cf + , ("Bcc: " ++) $ maybe "-" id $ bccField cf + , ("Reply-To: " ++) $ maybe "-" id $ replyToField cf + , ("Subject: " ++) $ maybe "-" id $ subjectField cf + ] + ppSep = " " -normalizeLen len cs = if (length cs > len) - then shorten len cs - else if (length cs < len) - then fillWithSpace len cs - else cs +normalizeLen len cs | (length cs > len) = shorten len cs + | otherwise = if (length cs < len) + then fillWithSpace len cs + else cs fillWithSpace len cs = cs ++ (take (len - length cs) . repeat $ ' ') -- The following functions are from DynamicLog xmonad-contrib source - -- | Wrap a string in delimiters, unless it is empty. wrap :: String -- ^ left delimiter -> String -- ^ right delimiter diff --git a/src/Lazymail/Screen.hs b/src/Lazymail/Screen.hs index ba64cee..a25c880 100644 --- a/src/Lazymail/Screen.hs +++ b/src/Lazymail/Screen.hs @@ -9,12 +9,12 @@ module Lazymail.Screen where -import Codec.MIME.Type(MIMEValue(..)) -import Control.Monad.Trans(liftIO) +import Codec.MIME.Type ( MIMEValue(..) ) +import Control.Monad.Trans ( liftIO ) import Control.Monad.Reader import Control.Monad.State -import Data.Char(toUpper) -import Data.List(isPrefixOf) +import Data.Char ( toUpper, isPrint ) +import Data.List ( isPrefixOf ) import System.Exit import UI.NCurses @@ -22,12 +22,15 @@ import UI.NCurses import Codec.Text.Rfc1342 import Lazymail.Config import qualified Lazymail.Handlers as EH -import Lazymail.Keymap(findHandler) +import Lazymail.Keymap ( findHandler ) import Lazymail.Maildir -import Lazymail.Email(lookupField, getBody, getHeaders, lookupField') +import Lazymail.Email ( lookupField, getBody, getHeaders, lookupField' ) import Lazymail.Print import Lazymail.State import Lazymail.Types +import Lazymail.Utils ( newDialogWindow, liftCurses + , drawCroppedString, drawNotification + ) {- This function is the nexus between Curses and IO -} entryPoint :: Lazymail () @@ -73,7 +76,9 @@ screenLoop = do get >>= \st -> (liftCurses . (updateWindow w) $ runStateT (runReaderT performUpdate cfg) st) >>= put . snd liftCurses $ render - handleEvent + st <- get + if (inputRequested . inputState $ st) + then handleInputRequest else handleEvent get >>= \st -> if (not . exitRequested) st then screenLoop else return () @@ -92,6 +97,7 @@ drawMode :: Mode -> LazymailUpdate () drawMode MaildirMode = get >>= \st -> drawSelectionList $ scrollBufferMD . maildirState $ st drawMode IndexMode = get >>= \st -> drawSelectionList $ scrollBufferIn . indexState $ st drawMode EmailMode = drawEmailHelper +drawMode ComposeMode = drawComposeModeHelper {- Draw a scrollable selection list -} drawSelectionList [] = resetCurrentRow @@ -194,6 +200,24 @@ drawBody row col maxRows (xs:xss) = do drawString xs when (row < maxRows) $ drawBody (row + 1) col maxRows xss +{- Draw the current Compose mode fields -} +drawComposeModeHelper = do + st <- get + let cs = composeState st + let row = curRowAsInteger st + let col = colPadAsInteger st + let maxRows = if statusBar st then (scrRowsAsInteger st) - 1 else scrRowsAsInteger st + liftUpdate $ do + drawComposeModeFields st row col maxRows $ ppComposeState cs + moveCursor (maxRows - 1) col + + where + drawComposeModeFields _ _ _ _ [] = return () + drawComposeModeFields st row col maxRows (f:fs) = do + moveCursor row col + drawCroppedString st f + when (row < maxRows) $ drawComposeModeFields st (row + 1) col maxRows fs + {- Draw a status line with the current mode and other stuff -} drawStatus = do st <- get @@ -218,6 +242,9 @@ drawStatusHelper IndexMode st = {- Status bar string for Email mode -} drawStatusHelper EmailMode st = ["mode: Email"] +{- Status bar string for Compose mode -} +drawStatusHelper ComposeMode st = ["mode: Compose"] + {- Handle an event -} handleEvent :: LazymailCurses () handleEvent = loop where @@ -252,8 +279,52 @@ resetScrollBuffer = do scrollBufferIn = EH.formatIndexModeRows st $ EH.scrollCrop 0 (screenRows st) $ selectedEmails . indexState $ st } put st { indexState = ist } -drawCroppedString st str = drawString $ normalizeLen (screenColumns st) str - --- The type system complains if I want to use the same function for diferents monads -liftCurses = lift . lift liftUpdate = lift . lift + +-- Input handling functions -- +handleInputRequest :: LazymailCurses () +handleInputRequest = do + st <- get + let is = inputState st + (_, cols, w) <- liftCurses $ newDialogWindow st + getLineFromWindow w $ fromIntegral cols + liftCurses $ closeWindow w + +getLineFromWindow :: Window -> Int -> LazymailCurses () +getLineFromWindow w cols = do + st <- get + let is = inputState st + liftCurses $ do + updateWindow w $ do + cleanLine + moveCursor 1 1 + drawString $ (maybe "" id $ prompt is) ++ (currentInput is) + render + loopForEvents w + st <- get + when (inputRequested . inputState $ st) $ getLineFromWindow w cols + + where + cleanLine = moveCursor 1 1 >> (drawString $ replicate (cols - 2) ' ') + + loopForEvents w = do + st <- get + let is = inputState st + let ci = currentInput is + let pr = maybe "" id $ prompt is + ev <- liftCurses $ getEvent w Nothing + case ev of + Nothing -> loopForEvents w + Just ev' -> case ev' of + EventCharacter '\n' -> do + postInputActions is + st' <- get + put $ st' { inputState = (is { inputRequested = False}) } + EventCharacter c | isPrint c -> do + let ci' = if length ci == cols - (length pr) - 2 then ci else ci ++ [c] + put $ st { inputState = (is { currentInput = ci' }) } + EventSpecialKey KeyBackspace -> do + let ci' = if null ci then ci else init ci + put $ st { inputState = (is { currentInput = ci' } ) } + _ -> loopForEvents w + diff --git a/src/Lazymail/State.hs b/src/Lazymail/State.hs index 1323118..bf1e3c2 100644 --- a/src/Lazymail/State.hs +++ b/src/Lazymail/State.hs @@ -29,6 +29,7 @@ initialState = LazymailState { , indexState = initialIndexState , composeState = initialComposeState , emailState = initialEmailState + , inputState = initialInputState , colorStyle = initialColorStyle } @@ -59,7 +60,18 @@ initialEmailState = EmailState { } initialComposeState = ComposeState { - composition = Nothing + composeFields = initialComposeFields + , bodyFileName = Nothing + , bodyReady = False +} + +initialComposeFields = ComposeFields { + fromField = Nothing + , toField = Nothing + , ccField = Nothing + , bccField = Nothing + , subjectField = Nothing + , replyToField = Nothing } initialColorStyle = ColorStyle { @@ -70,6 +82,13 @@ initialColorStyle = ColorStyle { , newEmailColorID = defaultColorID } +initialInputState = InputState { + inputRequested = False + , prompt = Nothing + , currentInput = "" + , postInputActions = return () +} + scrColsAsInteger st = toInteger $ screenColumns st scrRowsAsInteger st = toInteger $ screenRows st curRowAsInteger st = toInteger $ currentRow st diff --git a/src/Lazymail/Types.hs b/src/Lazymail/Types.hs index ce46f65..6ef4f5b 100644 --- a/src/Lazymail/Types.hs +++ b/src/Lazymail/Types.hs @@ -39,6 +39,8 @@ data LazymailConfig = LazymailConfig { , indexModeKeymap :: [Keymap] , emailModeKeymap :: [Keymap] , composeModeKeymap :: [Keymap] + , textEditor :: FilePath + , sendmailCommand :: [String] } data Email = Email { @@ -84,6 +86,7 @@ data LazymailState = LazymailState { , indexState :: IndexState , emailState :: EmailState , composeState :: ComposeState + , inputState :: InputState , colorStyle :: ColorStyle } @@ -107,9 +110,20 @@ data IndexState = IndexState { } data ComposeState = ComposeState { - composition :: Maybe String + composeFields :: ComposeFields + , bodyFileName :: Maybe FilePath + , bodyReady :: Bool } +data ComposeFields = ComposeFields { + fromField :: Maybe String + , toField :: Maybe String + , ccField :: Maybe String + , bccField :: Maybe String + , subjectField :: Maybe String + , replyToField :: Maybe String +} + data EmailState = EmailState { scrollRowEm :: Int , bodyStartRow :: Int @@ -125,4 +139,11 @@ data ColorStyle = ColorStyle { , newEmailColorID :: ColorID } +data InputState = InputState { + inputRequested :: Bool + , prompt :: Maybe String + , currentInput :: String + , postInputActions :: LazymailCurses () +} + type Keymap = ([Event], LazymailCurses ())
\ No newline at end of file diff --git a/src/Lazymail/Utils.hs b/src/Lazymail/Utils.hs new file mode 100644 index 0000000..a31db63 --- /dev/null +++ b/src/Lazymail/Utils.hs @@ -0,0 +1,56 @@ +{- Miscellaneous functions written apart in order to avoid + - cyclics module imports + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + -} + +module Lazymail.Utils ( newDialogWindow, drawNotification + , liftCurses, drawCroppedString + ) where + +import Control.Monad.Trans ( liftIO ) +import Control.Monad.Reader +import Control.Monad.State +import UI.NCurses + +import Lazymail.Print +import Lazymail.Types +import Lazymail.State + +newDialogWindow :: LazymailState -> Curses (Integer, Integer, Window) +newDialogWindow st = + let rows = 3 + cols st = 9 * ((scrColsAsInteger st) `div` 10) + startCol st = 2 * ((scrColsAsInteger st) `div` 20) + startRow st = (div (scrRowsAsInteger st) 2) - 1 + in do + w <- newWindow 3 (cols st) (startRow st) (startCol st) + updateWindow w $ drawBox Nothing Nothing + render + return (rows, cols st, w) + +drawNotification :: String -> LazymailCurses () +drawNotification errorMessage = do + st <- get + (_, cols, w) <- liftCurses $ newDialogWindow st + liftCurses $ do + updateWindow w $ do + moveCursor 1 1 + drawString errorMessage + render + waitFor w (\ev -> ev == EventCharacter 'q' || ev == EventCharacter 'Q' || ev == EventCharacter '\n') + closeWindow w + +waitFor :: Window -> (Event -> Bool) -> Curses () +waitFor w p = loop where + loop = do + ev <- getEvent w Nothing + case ev of + Nothing -> loop + Just ev' -> if p ev' then return () else loop + +liftCurses = lift . lift + +drawCroppedString st str = drawString $ normalizeLen (screenColumns st) str |