diff options
| -rw-r--r-- | Config.hs | 6 | ||||
| -rw-r--r-- | Lazymail.hs | 6 | ||||
| -rw-r--r-- | Main.hs | 9 | ||||
| -rw-r--r-- | Screen.hs | 227 | ||||
| -rw-r--r-- | State.hs | 16 |
5 files changed, 142 insertions, 122 deletions
@@ -16,7 +16,7 @@ data LazymailConfig = LazymailConfig { , selectionColor :: (Color, Color) , statusBarColor :: (Color, Color) , showStatusBar :: Bool - , initialPath :: Maybe FilePath + , initialPath :: FilePath } defaultConfig = LazymailConfig { @@ -24,7 +24,7 @@ defaultConfig = LazymailConfig { , selectionColor = (ColorBlack, ColorWhite) , statusBarColor = (ColorBlack, ColorWhite) , showStatusBar = True - , initialPath = Nothing + , initialPath = "" } -- @@ -32,4 +32,4 @@ defaultConfig = LazymailConfig { -- preferences. In a possible future maybe I'll work in a not-so-crappy -- config system. -- -customConfig = defaultConfig { initialPath = Just "/home/rul/mail/kalgan" }
\ No newline at end of file +customConfig = defaultConfig { initialPath = "/home/rul/mail/kalgan" }
\ No newline at end of file diff --git a/Lazymail.hs b/Lazymail.hs index 70a6b96..33a9c11 100644 --- a/Lazymail.hs +++ b/Lazymail.hs @@ -11,8 +11,8 @@ module Lazymail where import Control.Monad.Reader import Control.Monad.State -import Config(LazymailConfig, customConfig) -import State(LazymailState, initialState) +import Config +import State {- Lazymail monad is a ReaderT around a StateT with IO at the bottom of the - stack. @@ -22,5 +22,5 @@ type Lazymail = ReaderT LazymailConfig (StateT LazymailState IO) run :: Lazymail a -> IO (a, LazymailState) run k = let config = customConfig - state = initialState + state = initialState { basePath = initialPath config } in runStateT (runReaderT k config) state
\ No newline at end of file @@ -21,6 +21,7 @@ import System.Environment import System.Exit import System.FilePath(takeDirectory) +import Lazymail import Email import Maildir import Screen @@ -30,15 +31,15 @@ parse ["-h"] = usage >> exit parse ["-v"] = version >> exit parse [md] = do putStrLn $ "Maildirs directory: " ++ md - entryPoint $ initState { initPath = md } - -parse []= usage >> die + run entryPoint + +parse [] = usage >> die usage = putStrLn . unlines $ usageText where usageText = ["Usage: ./Main [-vh] <maildirs>" ," where <maildirs> is a directory with Maildirs, or a Maildir itself." ," Lazymail will recursively search for Maildirs. "] - + version = putStrLn "Haskell lazymail 0.0001" exit = exitWith ExitSuccess die = exitWith (ExitFailure 1) @@ -3,7 +3,7 @@ - Copyright 2013 Raúl Benencia <rul@kalgan.cc> - - Licensed under the GNU GPL version 3 or higher - - + - -} module Screen where @@ -24,84 +24,106 @@ import Print import Rfc1342 import State +type LazymailUpdate = ReaderT LazymailConfig (StateT LazymailState Update) type LazymailCurses = ReaderT LazymailConfig (StateT LazymailState Curses) -liftCurses = lift . lift + +liftCurses = lift . lift +liftUpdate = lift . lift entryPoint :: Lazymail () entryPoint = do st <- get - cfg <- ask maildirs <- liftIO $ getMaildirsRecursively $ basePath st - liftIO $ runCurses $ runStateT (runReaderT startCurses cfg) st + let mdState = (maildirState st) { detectedMDs = maildirs } + cfg <- ask + liftIO $ runCurses $ runStateT (runReaderT startCurses cfg) (st { maildirState = mdState }) return () - + startCurses :: LazymailCurses () startCurses = do st <- get - (rows, columns) <- liftCurses $ do + cfg <- ask + (=<<) put $ liftCurses $ do UI.setEcho False - UI.screenSize - - return () - -{-- | Main entry point -entryPoint :: MState -> IO () -entryPoint st' = do - maildirs <- getMaildirsRecursively (initPath st') - putStrLn $ "We could get " ++ (show . length) maildirs ++ " maildirs." - runCurses $ do - setEcho False - (rows, columns) <- screenSize - selColID <- newColorID ColorBlack ColorWhite 1 - staColID <- newColorID ColorWhite ColorGreen 2 - let st = st' { - scrRows = rows - 1 - , scrColumns = columns - 1 - , selectedColorID = selColID - , statusColorID = staColID - , detectedMDs = maildirs } - screenLoop st - --- | This functions will loop til the user decides to leave -screenLoop :: MState -> Curses () -screenLoop st = do - w <- defaultWindow - st' <- updateWindow w $ do - clearMain (scrRowsAsInt st) (scrColsAsInt st) - st'' <- drawMode (mode st) st - drawStatus st'' - return st'' - render - st'' <- handleEvent st' - if (not . exitRequested) st'' - then screenLoop st'' + (rows, cols) <- UI.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 + let style = ColorStyle basColID selColID staColID + return $ st { screenRows = fromIntegral rows + , screenColumns = fromIntegral cols + , colorStyle = style } + screenLoop + +{- This function will loop til the user decides to leave -} +screenLoop :: LazymailCurses () +screenLoop = do + w <- liftCurses $ defaultWindow + st <- get + cfg <- ask + liftCurses $ updateWindow w $ do runStateT (runReaderT performUpdate cfg) st + liftCurses $ render + handleEvent + st <- get + if (not . exitRequested) st + then screenLoop else return () - + +performUpdate :: LazymailUpdate () +performUpdate = do + st <- get + liftUpdate $ clearMain (scrRowsAsInteger st) (screenColumns st) + drawMode (mode st) + drawStatus + -- | Pattern match on the received mode and draw it in the screen. -drawMode :: Mode -> MState -> Update MState -drawMode MaildirMode st = drawMaildirHelper st (detectedMDs st) -drawMode EmailMode st = drawEmailHelper st -drawMode IndexMode st = drawIndexHelper st $ (selectedEmails st) +drawMode :: Mode -> LazymailUpdate () +drawMode MaildirMode = do + st <- get + let mdState = maildirState st + drawMaildirHelper $ detectedMDs mdState +--drawMode EmailMode = drawEmailHelper +--drawMode IndexMode = drawIndexHelper (selectedEmails st) -- | Helper function of drawMode -drawMaildirHelper st [] = return $ st { curRow = 0 } -drawMaildirHelper st (md:mds) = do - moveCursor (curRow st) (colPadding st) - st' <- if (selectedRow st == curRow st) - then do - setColor $ selectedColorID st - drawString $ normalizeLen (scrColsAsInt st) md - setColor defaultColorID - return $ st { selectedMD = md } - else do - drawString $ normalizeLen (scrColsAsInt st) md - return st - - let limit = if showStatus st' then (scrRows st') - 1 else scrRows st' - if curRow st' < limit - then drawMaildirHelper (incCurRow st') mds - else return $ st' { curRow = 0 } +drawMaildirHelper :: [FilePath] -> LazymailUpdate () +drawMaildirHelper [] = resetCurrentRow +drawMaildirHelper (md:mds) = do + st <- get + (=<<) put $ liftUpdate $ do + moveCursor (curRowAsInteger st) (colPadAsInteger st) + if (selectedRow st == currentRow st) + then do + setColor $ selectionColorID . colorStyle $ st + drawString $ normalizeLen (screenColumns st) md + setColor $ baseColorID . colorStyle $ st + let mdState = (maildirState st) { selectedMD = md } + return $ st { maildirState = mdState } + else do + drawString $ normalizeLen (screenColumns st) md + return st + st <- get + let limit = if statusBar st then (screenRows st) - 1 else screenRows st + if currentRow st < limit + then do + put st { currentRow = (currentRow st) + 1 } + drawMaildirHelper mds + else + resetCurrentRow + +-- | Empty the whole window. Useful when changing modes. +clearMain rows columns = do + drawEmptyLine 0 + where + drawEmptyLine currentRow = do + moveCursor currentRow 0 + drawString $ replicate (columns - 1) ' ' + if currentRow < (rows - 1) + then drawEmptyLine $ currentRow + 1 + else return () + +{- -- | Helper function of drawMode drawIndexHelper st [] = return $ st { curRow = 0 } --moveCursor 0 0 >> return st drawIndexHelper st ((fp, _, msg):ts) = do @@ -149,16 +171,6 @@ drawEmailHelper st = do drawString xs if row < (scrRows st) then drawBody (row + 1) col xss else return () --- | Empty the whole window. Useful when changing modes. -clearMain rows columns = do - drawEmptyLine 0 - where - drawEmptyLine currentRow = do - moveCursor currentRow 0 - drawString $ replicate (columns - 1) ' ' - if currentRow < (rows - 1) - then drawEmptyLine $ currentRow + 1 - else return () -- | Convert a String to multiple Strings, cropped by the maximum column -- size if necessary. @@ -168,55 +180,58 @@ formatBody body maxColumns = format [] [] body where format parsed acc ('\r':'\n':xs) = format (parsed ++ [acc]) [] xs format parsed acc rest@(x:xs) | length acc < maxColumns = format parsed (acc ++ [x]) xs | otherwise = format (parsed ++ [acc]) "+" rest - +-} -- | Draw a status line with the current mode and other stuff -drawStatus st = do - moveCursor ((scrRows st) - 1) 0 - setColor $ statusColorID st - drawString . normalizeLen (scrColsAsInt st) . concat $ drawStatusHelper (mode st) st - setColor defaultColorID - +drawStatus = do + st <- get + liftUpdate $ do + moveCursor ((scrRowsAsInteger st) - 2) 0 + setColor $ statusBarColorID . colorStyle $ st + drawString . normalizeLen (screenColumns st) . concat $ drawStatusHelper (mode st) st + setColor $ baseColorID . colorStyle $ st + drawStatusHelper MaildirMode st = ["Maildir listing - " - , "(", show ((+ 1) . selectedRowMD $ st), "/" - , show (length $ detectedMDs st), ")"] - -drawStatusHelper IndexMode st = ["mode: Index - " - , "(", show ((+ 1) . selectedRowIn $ st), "/" - , show (length $ selectedEmails st), ")"] + , "(", show ((+ 1) . selectedRow $ st), "/" + , show (length $ detectedMDs . maildirState $ st), ")"] + +drawStatusHelper IndexMode st = ["mode: Index - "] +-- , "(", show ((+ 1) . selectedRow $ st), "/" +-- , show (length $ selectedEmails . indexState $ st), ")"] drawStatusHelper EmailMode st = ["mode: Email"] -- | Handle an event --- TODO: Handle the events in a cleaner way. -handleEvent :: MState -> Curses MState -handleEvent st = loop where +-- TODO: Handle the events in a cleaner way. +handleEvent :: LazymailCurses () +handleEvent = loop where loop = do - w <- defaultWindow - ev <- getEvent w Nothing + w <- liftCurses $ defaultWindow + ev <- liftCurses $ getEvent w Nothing + st <- get case ev of Nothing -> loop Just ev' -> case ev' of EventCharacter c | c == 'q' || c == 'Q' -> do case (mode st) of - IndexMode -> return $ st { mode = MaildirMode } - EmailMode -> return $ st { mode = IndexMode } - MaildirMode -> return $ st { exitRequested = True } - - EventSpecialKey KeyUpArrow -> return $ decSelectedRow st - EventCharacter 'k' -> return $ decSelectedRow st - - EventSpecialKey KeyDownArrow -> return $ incSelectedRow st - EventCharacter 'j' -> return $ incSelectedRow st + IndexMode -> put $ st { mode = MaildirMode } + EmailMode -> put $ st { mode = IndexMode } + MaildirMode -> put $ st { exitRequested = True } + +{- EventSpecialKey KeyUpArrow -> put $ decSelectedRow st + EventCharacter 'k' -> put $ decSelectedRow st + + EventSpecialKey KeyDownArrow -> put $ incSelectedRow st + EventCharacter 'j' -> put $ incSelectedRow st EventSpecialKey KeyRightArrow -> do case (mode st) of - IndexMode -> return $ st { mode = EmailMode } - EmailMode -> return st + IndexMode -> put $ st { mode = EmailMode } + EmailMode -> return () MaildirMode -> do - selEmails <-liftIO $ getAll . selectedMD $ st - return $ st { mode = IndexMode, selectedEmails = selEmails } - + selEmails <- liftIO $ getAll . selectedMD $ st + return $ st { mode = IndexMode, selectedEmails = selEmails } -} + _ -> loop --}
\ No newline at end of file +resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
\ No newline at end of file @@ -89,6 +89,12 @@ initialColorStyle = ColorStyle { , statusBarColorID = defaultColorID } +scrColsAsInteger st = toInteger $ screenColumns st +scrRowsAsInteger st = toInteger $ screenRows st +curRowAsInteger st = toInteger $ currentRow st +colPadAsInteger st = toInteger $ columnPadding st + + {- data MState = MState { selectedRowMD :: Integer -- Selected row in MaildirMode @@ -146,11 +152,9 @@ decSelectedRow st | (selectedRow st) > 0 = case (mode st) of MaildirMode -> st { selectedRowMD = (selectedRowMD st) - 1 } IndexMode -> st { selectedRowIn = (selectedRowIn st) - 1 } | otherwise = st - +-} + selectedRow st = case (mode st) of - MaildirMode -> selectedRowMD st - IndexMode -> selectedRowIn st + MaildirMode -> selectedRowMD . maildirState $ st + IndexMode -> selectedRowIn . indexState $ st -scrColsAsInt st = fromIntegral $ scrColumns st -scrRowsAsInt st = fromIntegral $ scrRows st --}
\ No newline at end of file |