diff options
| -rw-r--r-- | Handlers.hs | 61 | ||||
| -rw-r--r-- | Maildir.hs | 81 | ||||
| -rw-r--r-- | Screen.hs | 94 | ||||
| -rw-r--r-- | State.hs | 4 | ||||
| -rw-r--r-- | Types.hs | 22 |
5 files changed, 155 insertions, 107 deletions
diff --git a/Handlers.hs b/Handlers.hs new file mode 100644 index 0000000..566fca9 --- /dev/null +++ b/Handlers.hs @@ -0,0 +1,61 @@ +{- Event handlers for Lazymail + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + -} + +module Handlers where + +import Control.Monad.State + +import Maildir +import State +import Types (LazymailCurses) + +previousMode :: Mode -> LazymailCurses () +previousMode IndexMode = (=<<) put $ get >>= \st -> return st { mode = MaildirMode } +previousMode EmailMode = (=<<) put $ get >>= \st -> return st { mode = IndexMode } +previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True } + +changeMode IndexMode = (=<<) put $ get >>= \st -> return st { mode = EmailMode } +changeMode EmailMode = return () +changeMode MaildirMode = do + st <- get + selectedEmails' <- liftIO $ do + let md = (selectedMD . maildirState) $ st + getMaildirEmails md + let indexState' = (indexState st) { + selectedEmails = selectedEmails' + , currentInLen = length selectedEmails' + , scrollBufferIn = scrollCrop (scrollRowIn . indexState $ st) (screenRows st) selectedEmails' + } + put $ st { mode = IndexMode, indexState = indexState' } + +incSelectedRow IndexMode = do + st <- get + let inSt = indexState st + if (selectedRowIn inSt) > (div (screenRows st) 2) + then do + let scrollRowIn' = scrollRowIn inSt + 1 + let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt + let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } + put st { indexState = inSt' } + else put $ incrementSelectedRow st +incSelectedRow _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st + +decSelectedRow IndexMode = do + st <- get + let inSt = indexState st + if (scrollRowIn inSt) > 0 + then do + let scrollRowIn' = scrollRowIn inSt - 1 + let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt + let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } + put st { indexState = inSt' } + else put $ decrementSelectedRow st +decSelectedRow _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st + +{- Given a list, it returns the elements that will be in the next screen refresh + - TODO: find a better name -} +scrollCrop top rows xs = take rows $ drop top xs @@ -24,6 +24,48 @@ isMaildir fp = allM doesDirectoryExist [ fp , fp </> "new" , fp </> "tmp"] +getMaildirEmails md = do + r <- (getReadEmails md) + n <- (getNewEmails md) + return $ r ++ n + +getReadEmails md = getDirectoryContents $ md </> "cur" +getNewEmails md = getDirectoryContents $ md </> "new" + +{- | 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 topdir = do + result <- search topdir + includeTopDir <- isMaildir topdir + if includeTopDir + then return (topdir:result) + else return result + + where + search topdir = do + names <- getDirectoryContents topdir + let properNames = filter (`notElem` [".", ".."]) names + paths <- forM properNames $ \name -> do + let path = topdir </> name + isDirectory <- doesDirectoryExist path + if isDirectory + then do + result <- search path + return ([path] ++ result) + else return [] + + filterM isMaildir (concat paths) + + +{- The following code is an implementation of the Mailbox interface -} listIDs :: Maildir -> IO [FilePath] listIDs md = getNewIDs md `appendM` getReadIDs md where mxs `appendM` mxs' = do @@ -72,42 +114,3 @@ getAll fp = do msgs <- mapM (\x -> hGetContents =<< openFile x ReadMode) ids let flags = map getFlags ids return $ zip3 ids flags msgs - -{- | 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 topdir = do - result <- search topdir - includeTopDir <- isMaildir topdir - if includeTopDir - then return (topdir:result) - else return result - - where - search topdir = do - names <- getDirectoryContents topdir - let properNames = filter (`notElem` [".", ".."]) names - paths <- forM properNames $ \name -> do - let path = topdir </> name - isDirectory <- doesDirectoryExist path - if isDirectory - then do - result <- search path - return ([path] ++ result) - else return [] - - filterM isMaildir (concat paths) - --- Temporal code for testing purposes -defaultPath = "/home/rul/mail/linti/INBOX.academic.c.questions" -getFirstEmail = do - lst <- getAll defaultPath - let (_, _, msg) = head lst - return msg @@ -4,6 +4,7 @@ - - Licensed under the GNU GPL version 3 or higher - + - This code is in an urgent need of a big refactoring. -} module Screen where @@ -12,24 +13,21 @@ import Control.Monad.Trans(liftIO) import Control.Monad.Reader import Control.Monad.State import Data.List(isPrefixOf) -import UI.NCurses as UI -import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) import System.Exit +import System.IO(IOMode(..), hGetContents, openFile) +import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) +import UI.NCurses -- Local imports import Config +import qualified Handlers as EH import Lazymail import Maildir import Email import Print import Rfc1342 import State - -type LazymailUpdate = ReaderT LazymailConfig (StateT LazymailState Update) -type LazymailCurses = ReaderT LazymailConfig (StateT LazymailState Curses) - -liftCurses = lift . lift -liftUpdate = lift . lift +import Types(LazymailCurses, LazymailUpdate) entryPoint :: Lazymail () entryPoint = do @@ -47,8 +45,8 @@ startCurses = do st <- get cfg <- ask (=<<) put $ liftCurses $ do - UI.setEcho False - (rows, cols) <- UI.screenSize + setEcho False + (rows, cols) <- screenSize basColID <- newColorID (fst . baseColor $ cfg) (snd . baseColor $ cfg) 1 selColID <- newColorID (fst . selectionColor $ cfg) (snd . selectionColor $ cfg) 2 staColID <- newColorID (fst . statusBarColor $ cfg) (snd . statusBarColor $ cfg) 3 @@ -125,15 +123,16 @@ clearMain rows columns = do -- | Helper function of drawMode drawIndexHelper [] = resetCurrentRow -drawIndexHelper ((fp, _, msg):ts) = do +drawIndexHelper (m:ms) = do st <- get (=<<) put $ liftUpdate $ do + msg <- liftToUpdate $ hGetContents =<< (openFile m ReadMode) moveCursor (curRowAsInteger st) (colPadAsInteger st) let email = parseEmail msg let fs = getFields email let str = normalizeLen (screenColumns st) . concat $ [ show $ (currentRow st) + (scrollRowIn . indexState $ st) + 1 - , (ppSep ++) $ ppFlags . getFlags $ fp + , (ppSep ++) $ ppFlags . getFlags $ m , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs , (ppSep ++) $ ppIndexSubject . getSubject $ fs ] @@ -153,7 +152,7 @@ drawIndexHelper ((fp, _, msg):ts) = do if currentRow st < limit then do incrementCurrentRow - drawIndexHelper ts + drawIndexHelper ms else resetCurrentRow -- | Helper function of drawMode @@ -190,7 +189,7 @@ formatBody body maxColumns = format [] [] body where | otherwise = format (parsed ++ [acc]) "+" rest --- | Draw a status line with the current mode and other stuff +{- Draw a status line with the current mode and other stuff -} drawStatus = do st <- get liftUpdate $ do @@ -219,63 +218,26 @@ handleEvent = loop where st <- get case ev of Nothing -> loop - Just ev' -> case ev' of - EventCharacter c | c == 'q' || c == 'Q' -> do - case (mode st) of - IndexMode -> put $ st { mode = MaildirMode } - EmailMode -> put $ st { mode = IndexMode } - MaildirMode -> put $ st { exitRequested = True } - - EventSpecialKey KeyUpArrow -> decrementActions (mode st) - EventCharacter 'k' -> decrementActions (mode st) - - EventSpecialKey KeyDownArrow -> incrementActions (mode st) - EventCharacter 'j' -> incrementActions (mode st) + Just ev' -> + case ev' of + EventCharacter 'q' -> EH.previousMode (mode st) - EventSpecialKey KeyRightArrow -> do - case (mode st) of - IndexMode -> put $ st { mode = EmailMode } - EmailMode -> return () - MaildirMode -> do - selectedEmails' <- liftIO $ do - let md = (selectedMD . maildirState) $ st - getAll md - let indexState' = (indexState st) { selectedEmails = selectedEmails' - , currentInLen = length selectedEmails' - , scrollBufferIn = scrollCrop (scrollRowIn . indexState $ st) (screenRows st) selectedEmails' - } - put $ st { mode = IndexMode, indexState = indexState' } + EventSpecialKey KeyUpArrow -> EH.decSelectedRow (mode st) + EventCharacter 'k' -> EH.decSelectedRow (mode st) - _ -> loop + EventSpecialKey KeyDownArrow -> EH.incSelectedRow (mode st) + EventCharacter 'j' -> EH.incSelectedRow (mode st) -{- Given a list, it returns the elements that will be in the next screen refresh - - TODO: find a better name -} -scrollCrop top rows xs = take rows $ drop top xs + EventSpecialKey KeyEnter -> EH.changeMode (mode st) + EventSpecialKey KeyRightArrow -> EH.changeMode (mode st) -incrementActions IndexMode = do - st <- get - let inSt = indexState st - if (selectedRowIn inSt) > (div (screenRows st) 2) - then do - let scrollRowIn' = scrollRowIn inSt + 1 - let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt - let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } - put st { indexState = inSt' } - else put $ incrementSelectedRow st -incrementActions _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st - -decrementActions IndexMode = do - st <- get - let inSt = indexState st - if (scrollRowIn inSt) > 0 - then do - let scrollRowIn' = scrollRowIn inSt - 1 - let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt - let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } - put st { indexState = inSt' } - else put $ decrementSelectedRow st -decrementActions _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st + _ -> loop resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 } incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (currentRow st) + 1 } +liftCurses = lift . lift +liftUpdate = lift . lift + +liftToUpdate :: IO a -> Update a +liftToUpdate io = Update $ lift (liftIO io)
\ No newline at end of file @@ -39,10 +39,10 @@ data MaildirState = MaildirState { data IndexState = IndexState { selectedRowIn :: Int , selectedEmail :: Message - , selectedEmails :: [(String, [Flag], String)] + , selectedEmails :: [FilePath] , scrollRowIn :: Int , currentInLen :: Int - , scrollBufferIn :: [(String, [Flag], String)] + , scrollBufferIn :: [FilePath] } data ComposeState = ComposeState { diff --git a/Types.hs b/Types.hs new file mode 100644 index 0000000..4fe658e --- /dev/null +++ b/Types.hs @@ -0,0 +1,22 @@ +{- Common types of Lazymail + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + -} + +module Types + ( + LazymailUpdate + , LazymailCurses + ) where + +import Control.Monad.Reader(ReaderT) +import Control.Monad.State(StateT) +import UI.NCurses(Curses, Update) + +import Config (LazymailConfig) +import State (LazymailState) + +type LazymailUpdate = ReaderT LazymailConfig (StateT LazymailState Update) +type LazymailCurses = ReaderT LazymailConfig (StateT LazymailState Curses) |