From e41dd5091f597e2252deb9ecbde900eda7c15614 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ra=C3=BAl=20Benencia?= Date: Tue, 3 Sep 2013 00:00:50 -0300 Subject: Sorted index mode --- Config.hs | 13 ++------- Handlers.hs | 44 ++++++++++++++++++---------- Lazymail.hs | 6 +--- Main.hs | 8 ++---- Print.hs | 3 ++ Screen.hs | 12 ++++---- State.hs | 53 +--------------------------------- Types.hs | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++++++------ 8 files changed, 133 insertions(+), 101 deletions(-) diff --git a/Config.hs b/Config.hs index b446838..96c9125 100644 --- a/Config.hs +++ b/Config.hs @@ -12,24 +12,17 @@ import Data.List(sort, stripPrefix) import System.Posix.Files(getSymbolicLinkStatus, isSymbolicLink) import UI.NCurses(Color(..)) -data LazymailConfig = LazymailConfig { - baseColor :: (Color, Color) -- (foreground, background) - , selectionColor :: (Color, Color) - , statusBarColor :: (Color, Color) - , headerColor :: (Color, Color) - , showStatusBar :: Bool - , initialPath :: FilePath - , filterMaildirsHook :: [FilePath] -> IO [FilePath] -} +import Types(LazymailConfig(..)) defaultConfig = LazymailConfig { baseColor = (ColorWhite, ColorBlack) , selectionColor = (ColorYellow, ColorBlack) , statusBarColor = (ColorYellow, ColorBlack) - , headerColor = (ColorYellow, ColorBlack) + , headerColor = (ColorYellow, ColorBlack) , showStatusBar = True , initialPath = "" , filterMaildirsHook = \mds -> return mds + , indexDateFormat = "%m %d" } -- diff --git a/Handlers.hs b/Handlers.hs index ccce1d0..fc4c009 100644 --- a/Handlers.hs +++ b/Handlers.hs @@ -11,16 +11,17 @@ import Codec.MIME.Parse(parseMIMEMessage) import Codec.MIME.Type(MIMEValue(..)) import Control.Exception(evaluate) import Control.Monad.State -import Data.List(intercalate, stripPrefix) +import Data.List(intercalate, stripPrefix, sort) import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator) +import System.Locale(rfc822DateFormat) +import Data.DateTime(parseDateTime, startOfTime, formatDateTime) import qualified System.IO.UTF8 as UTF8 ---import Email(parseEmail, getFields, getSubject, getFrom, getBody, formatBody) import Email(lookupField, getBody, formatBody) import Maildir import Print import State -import Types (LazymailCurses) +import Types previousMode :: Mode -> LazymailCurses () previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True } @@ -43,17 +44,28 @@ changeMode IndexMode = do changeMode MaildirMode = do st <- get - selectedEmails' <- liftIO $ do + unsortedEmails <- liftIO $ do let md = (selectedMD . maildirState) $ st emails <- getMaildirEmails md - formatIndexModeRows st emails + mapM toEmail emails + let selectedEmails' = reverse $ sort unsortedEmails + let scrollRow = scrollRowIn . indexState $ st + let scrRows = screenRows st let indexState' = (indexState st) { selectedEmails = selectedEmails' , currentInLen = length selectedEmails' - , scrollBufferIn = scrollCrop (scrollRowIn . indexState $ st) (screenRows st) selectedEmails' + , scrollBufferIn = formatIndexModeRows st $ scrollCrop scrollRow scrRows selectedEmails' } put $ st { mode = IndexMode, indexState = indexState' } + where + toEmail fp = do + msg <- readFile fp + let value = parseMIMEMessage msg + let headers = mime_val_headers value + let date = maybe startOfTime id $ parseDateTime rfc822DateFormat $ takeWhile (/= '(') $ lookupField "date" headers + return (Email value date fp) + {- Boilerplate code -} incSelectedRow IndexMode = do st <- get @@ -66,7 +78,7 @@ incSelectedRow IndexMode = do if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st))) then do -- Scroll emails let scrollRowIn' = scrollRowIn inSt + 1 - let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt + let scrollBufferIn' = formatIndexModeRows st $ scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } put st { indexState = inSt' } else -- Move the selected row @@ -113,7 +125,7 @@ decSelectedRow IndexMode = do if topScrollRow > 0 && selRow < startScrolling then do let scrollRowIn' = scrollRowIn inSt - 1 - let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt + let scrollBufferIn' = formatIndexModeRows st $ scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt let inSt' = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' } put st { indexState = inSt' } else @@ -151,17 +163,19 @@ decSelectedRow _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st - TODO: find a better name -} scrollCrop top rows xs = take rows $ drop top xs -formatIndexModeRows st = mapM formatRow where - formatRow fp = do - msg <- UTF8.readFile fp - let email = parseMIMEMessage msg - let hs = mime_val_headers email - let str = normalizeLen (screenColumns st) $ intercalate ppSep $ +formatIndexModeRows :: LazymailState -> [Email] -> [(FilePath, String)] +formatIndexModeRows st = map formatRow where + formatRow e = + let fp = emailPath e + email = emailValue e + hs = mime_val_headers email + str = normalizeLen (screenColumns st) $ intercalate ppSep $ [ ppFlags . getFlags $ fp + , formatDateTime "%b %d" $ emailDate e , normalizeLen fromLen $ ppField $ lookupField "from" hs , ppField $ lookupField "subject" hs ] - return (fp, str) + in (fp, str) formatMaildirModeRows st = mapM formatRow where formatRow fp = return $ (fp, (concat $ replicate (numPads - 1) pad) ++ name) where diff --git a/Lazymail.hs b/Lazymail.hs index 200b8fd..fbb7e3e 100644 --- a/Lazymail.hs +++ b/Lazymail.hs @@ -13,11 +13,7 @@ import Control.Monad.State import Config import State - -{- Lazymail monad is a ReaderT around a StateT with IO at the bottom of the - - stack. - -} -type Lazymail = ReaderT LazymailConfig (StateT LazymailState IO) +import Types run :: Lazymail a -> IO (a, LazymailState) run k = diff --git a/Main.hs b/Main.hs index ebc4810..416b65a 100644 --- a/Main.hs +++ b/Main.hs @@ -19,12 +19,10 @@ import Screen import State parse ["-h"] = usage >> exit +parse ["--help"] = usage >> exit parse ["-v"] = version >> exit -parse [md] = do - putStrLn $ "Maildirs directory: " ++ md - run entryPoint - -parse [] = usage >> die +parse ["--version"] = version >> exit +parse _ = run entryPoint usage = putStrLn . unlines $ usageText where usageText = ["Usage: ./Main [-vh] " diff --git a/Print.hs b/Print.hs index 8f40491..cae3a45 100644 --- a/Print.hs +++ b/Print.hs @@ -20,6 +20,9 @@ unquote xs= if (head xs == '"' && last xs == '"') then (tail . init) xs else xs ppField = flat . decodeField +{- Pretty print a RFC822 date format -} + + fromLen :: Int fromLen = 20 diff --git a/Screen.hs b/Screen.hs index 90954b1..5150e93 100644 --- a/Screen.hs +++ b/Screen.hs @@ -26,7 +26,7 @@ import Email(lookupField, getBody, getHeaders) import Print import Rfc1342 import State -import Types(LazymailCurses, LazymailUpdate) +import Types {- This function is the nexus between Curses and IO -} entryPoint :: Lazymail () @@ -153,13 +153,15 @@ drawEmailHeader = do let row = curRowAsInteger st setColor $ headerColorID . colorStyle $ st moveCursor row (colPadAsInteger st) - drawCroppedString st $ ("From: " ++) . ppField $ lookupField "from" hs + drawCroppedString st $ ("Date: " ++) . ppField $ lookupField "date" hs moveCursor (row + 1) (colPadAsInteger st) - drawCroppedString st $ ("To: " ++) . ppField $ lookupField "to" hs + drawCroppedString st $ ("From: " ++) . ppField $ lookupField "from" hs moveCursor (row + 2) (colPadAsInteger st) + drawCroppedString st $ ("To: " ++) . ppField $ lookupField "to" hs + moveCursor (row + 3) (colPadAsInteger st) drawCroppedString st $ ("Subject: " ++) . ppField $ lookupField "subject" hs setColor $ baseColorID . colorStyle $ st - put $ st { currentRow = (4 + currentRow st) } + put $ st { currentRow = (5 + currentRow st) } {- Draw the email body -} drawBody _ _ _ [] = return () @@ -233,7 +235,7 @@ resetScrollBuffer = do put st { maildirState = mst} IndexMode -> do let ist = (indexState st) { - scrollBufferIn = EH.scrollCrop 0 (screenRows st) $ selectedEmails . indexState $ st } + scrollBufferIn = EH.formatIndexModeRows st $ EH.scrollCrop 0 (screenRows st) $ selectedEmails . indexState $ st } put st { indexState = ist } drawCroppedString st str = drawString $ normalizeLen (screenColumns st) str diff --git a/State.hs b/State.hs index 357a516..f9c8683 100644 --- a/State.hs +++ b/State.hs @@ -14,58 +14,7 @@ import UI.NCurses(ColorID(..), defaultColorID) import Network.Email.Mailbox(Flag(..), Flags) import System.FilePath -data Mode = MaildirMode | IndexMode | EmailMode | ComposeMode - -data LazymailState = LazymailState { - mode :: Mode - , basePath :: FilePath - , screenRows :: Int - , screenColumns :: Int - , currentRow :: Int - , columnPadding :: Int - , exitRequested :: Bool - , statusBar :: Bool - , maildirState :: MaildirState - , indexState :: IndexState - , emailState :: EmailState - , composeState :: ComposeState - , colorStyle :: ColorStyle -} - -data MaildirState = MaildirState { - selectedRowMD :: Int - , selectedMD :: String - , detectedMDs :: [(FilePath, String)] - , scrollRowMD :: Int - , scrollBufferMD :: [(FilePath, String)] -} - -data IndexState = IndexState { - selectedRowIn :: Int - , selectedEmailPath :: FilePath - , selectedEmails :: [(FilePath, String)] - , scrollRowIn :: Int - , currentInLen :: Int - , scrollBufferIn :: [(FilePath, String)] -} - -data ComposeState = ComposeState { - composition :: Maybe String -} - -data EmailState = EmailState { - scrollRowEm :: Int - , bodyStartRow :: Int - , emailLines :: [String] - , currentEmail :: MIMEValue -} - -data ColorStyle = ColorStyle { - baseColorID :: ColorID - , selectionColorID :: ColorID - , statusBarColorID :: ColorID - , headerColorID :: ColorID -} +import Types initialState = LazymailState { mode = MaildirMode diff --git a/Types.hs b/Types.hs index 4fe658e..82005e2 100644 --- a/Types.hs +++ b/Types.hs @@ -5,18 +5,95 @@ - Licensed under the GNU GPL version 3 or higher -} -module Types - ( - LazymailUpdate - , LazymailCurses - ) where +module Types where +import Codec.MIME.Type(MIMEValue(..)) import Control.Monad.Reader(ReaderT) import Control.Monad.State(StateT) -import UI.NCurses(Curses, Update) - -import Config (LazymailConfig) -import State (LazymailState) +import Data.DateTime(DateTime) +import System.FilePath(FilePath) +import UI.NCurses(Curses, Update, Color(..), ColorID) type LazymailUpdate = ReaderT LazymailConfig (StateT LazymailState Update) type LazymailCurses = ReaderT LazymailConfig (StateT LazymailState Curses) + +{- Lazymail monad is a ReaderT around a StateT with IO at the bottom of the + - stack. + -} +type Lazymail = ReaderT LazymailConfig (StateT LazymailState IO) + +data LazymailConfig = LazymailConfig { + baseColor :: (Color, Color) -- (foreground, background) + , selectionColor :: (Color, Color) + , statusBarColor :: (Color, Color) + , headerColor :: (Color, Color) + , showStatusBar :: Bool + , initialPath :: FilePath + , filterMaildirsHook :: [FilePath] -> IO [FilePath] + , indexDateFormat :: String +} + +data Email = Email { + emailValue :: MIMEValue + , emailDate :: DateTime + , emailPath :: FilePath +} + +instance Eq Email where + (Email _ _ fp1) == (Email _ _ fp2) = fp1 == fp2 + +instance Ord Email where + (Email _ d1 _) `compare` (Email _ d2 _) = d1 `compare` d2 + +data Mode = MaildirMode | IndexMode | EmailMode | ComposeMode + +data LazymailState = LazymailState { + mode :: Mode + , basePath :: FilePath + , screenRows :: Int + , screenColumns :: Int + , currentRow :: Int + , columnPadding :: Int + , exitRequested :: Bool + , statusBar :: Bool + , maildirState :: MaildirState + , indexState :: IndexState + , emailState :: EmailState + , composeState :: ComposeState + , colorStyle :: ColorStyle +} + +data MaildirState = MaildirState { + selectedRowMD :: Int + , selectedMD :: String + , detectedMDs :: [(FilePath, String)] + , scrollRowMD :: Int + , scrollBufferMD :: [(FilePath, String)] +} + +data IndexState = IndexState { + selectedRowIn :: Int + , selectedEmailPath :: FilePath + , selectedEmails :: [Email] + , scrollRowIn :: Int + , currentInLen :: Int + , scrollBufferIn :: [(FilePath, String)] +} + +data ComposeState = ComposeState { + composition :: Maybe String +} + +data EmailState = EmailState { + scrollRowEm :: Int + , bodyStartRow :: Int + , emailLines :: [String] + , currentEmail :: MIMEValue +} + +data ColorStyle = ColorStyle { + baseColorID :: ColorID + , selectionColorID :: ColorID + , statusBarColorID :: ColorID + , headerColorID :: ColorID +} -- cgit v1.2.3