diff options
| -rw-r--r-- | Screen.hs | 157 | ||||
| -rw-r--r-- | State.hs | 39 |
2 files changed, 134 insertions, 62 deletions
@@ -17,6 +17,7 @@ module Screen where +import Control.Monad.Trans(liftIO) import Data.List(isPrefixOf) import UI.NCurses import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) @@ -36,84 +37,86 @@ entryPoint st' = do runCurses $ do setEcho False (rows, columns) <- screenSize - selColID <- newColorID ColorBlack ColorWhite 1 + 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 - updateWindow w $ do - clearMain (fromIntegral . scrRows $ st) (fromIntegral . scrColumns $ st) - drawMode (mode st) st + 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' + st'' <- handleEvent st' + if (not . exitRequested) st'' + then screenLoop st'' else return () --- | Handle an event --- TODO: Handle the events in a cleaner way. -handleEvent :: MState -> Curses MState -handleEvent st = loop where - loop = do - w <- defaultWindow - ev <- getEvent w Nothing - case ev of - Nothing -> loop - Just ev' -> case ev' of - EventCharacter c | c == 'q' || c == 'Q' -> return $ st { exitRequested = True } - EventSpecialKey KeyUpArrow -> return $ decSelectedRow st - EventCharacter 'k' -> return $ decSelectedRow st - - EventSpecialKey KeyDownArrow -> return $ incSelectedRow st - EventCharacter 'j' -> return $ incSelectedRow st - - _ -> loop - -- | Pattern match on the received mode and draw it in the screen. -drawMode :: Mode -> MState -> Update () +drawMode :: Mode -> MState -> Update MState drawMode MaildirMode st = drawMaildirHelper st (detectedMDs st) drawMode EmailMode st = drawEmailHelper st -drawMode IndexMode st = drawIndexHelper 0 0 (curRow st) (colPadding st) (selectedEmails st) +drawMode IndexMode st = drawIndexHelper st $ (selectedEmails st) -- | Helper function of drawMode -drawMaildirHelper _ [] = return () +drawMaildirHelper st [] = return $ st { curRow = 0 } drawMaildirHelper st (md:mds) = do moveCursor (curRow st) (colPadding st) - if (selectedRow st == curRow st) - then do - setColor $ selectedColorID st - drawString $ normalizeLen (fromIntegral . scrColumns $ st) md - setColor defaultColorID - else drawString $ normalizeLen (fromIntegral . scrColumns $ st) md - if curRow st < scrRows st - then drawMaildirHelper (incCurRow st) mds - else return () + 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 } -- | Helper function of drawMode -drawIndexHelper origRow origColumn rows columns [] = moveCursor 0 0 -drawIndexHelper origRow origColumn rows columns ((fp, _, msg):ts) = do - moveCursor origRow origColumn - let fs = getFields $ parseEmail msg - drawString $ show $ origRow + 1 - drawString $ (ppSep ++) $ ppFlags . getFlags $ fp - drawString $ (ppSep ++) $ ppIndexNameAddr . getFrom $ fs - drawString $ (ppSep ++) $ ppIndexSubject . getSubject $ fs - if origRow < (rows - 1) - then drawIndexHelper (origRow + 1) origColumn rows columns ts - else return () +drawIndexHelper st [] = return $ st { curRow = 0 } --moveCursor 0 0 >> return st +drawIndexHelper st ((fp, _, msg):ts) = do + moveCursor (curRow st) (colPadding st) + let email = parseEmail msg + let fs = getFields email + let str = normalizeLen (scrColsAsInt st) . concat $ + [ show $ (curRow st) + 1 + , (ppSep ++) $ ppFlags . getFlags $ fp + , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs + , (ppSep ++) $ ppIndexSubject . getSubject $ fs + ] + st' <- if (selectedRow st == curRow st) + then do + setColor $ selectedColorID st + drawString str + setColor defaultColorID + return $ st { selectedEmail = email } + else do + drawString str + return st + if curRow st' < ((scrRows st') - 1) + then drawIndexHelper (incCurRow st') ts + else return $ st' { curRow = 0 } -- | Helper function of drawMode -- TODO: Make helpers functions to draw header and body in a separate way. drawEmailHelper st = do let fs = getFields $ selectedEmail st - let cropWith xs = normalizeLen $ (fromIntegral . scrColumns $ st) - (length xs) + let cropWith xs = normalizeLen $ (scrColsAsInt st) - (length xs) let row = curRow st moveCursor row (colPadding st) drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs @@ -123,7 +126,8 @@ drawEmailHelper st = do drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs let body = getBody $ selectedEmail st - drawBody (row + 4) (colPadding st) $ formatBody body (fromIntegral . scrColumns $ st) + drawBody (row + 4) (colPadding st) $ formatBody body (scrColsAsInt st) + return st where drawBody _ _ [] = return () drawBody row col (xs:xss) = do moveCursor row col @@ -150,3 +154,52 @@ formatBody body maxColumns = format [] [] body where 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 + +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), ")"] + +drawStatusHelper EmailMode st = ["mode: Email"] + +-- | Handle an event +-- TODO: Handle the events in a cleaner way. +handleEvent :: MState -> Curses MState +handleEvent st = loop where + loop = do + w <- defaultWindow + ev <- getEvent w Nothing + 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 + + EventSpecialKey KeyRightArrow -> do + case (mode st) of + IndexMode -> return $ st { mode = EmailMode } + EmailMode -> return st + MaildirMode -> do + selEmails <-liftIO $ getAll . selectedMD $ st + return $ st { mode = IndexMode, selectedEmails = selEmails } + + _ -> loop @@ -27,7 +27,8 @@ import Network.Email.Mailbox(Flag(..), Flags) data Mode = MaildirMode | IndexMode | EmailMode data MState = MState { - selectedRow :: Integer + selectedRowMD :: Integer -- Selected row in MaildirMode + , selectedRowIn :: Integer -- Selected row in IndexMode , mode :: Mode , initPath :: String , scrRows :: Integer @@ -35,15 +36,18 @@ data MState = MState { , curRow :: Integer , colPadding :: Integer , selectedColorID :: ColorID + , statusColorID :: ColorID , selectedEmail :: Message , selectedEmails :: [(String, [Flag], String)] , selectedMD :: String , detectedMDs :: [String] - , exitRequested :: Bool + , exitRequested :: Bool + , showStatus :: Bool } initState = MState { - selectedRow = 0 + selectedRowMD = 0 + , selectedRowIn = 0 , mode = MaildirMode , initPath = "" , scrRows = (-1) @@ -51,22 +55,37 @@ initState = MState { , curRow = 0 , colPadding = 0 , selectedColorID = defaultColorID + , statusColorID = defaultColorID , selectedEmail = Message [] "Dummy email" , selectedEmails = [] , selectedMD = "" , detectedMDs = [] - , exitRequested = False + , exitRequested = False + , showStatus = True } incCurRow st = st { curRow = (curRow st) + 1 } -incSelectedRow st | selectedRow st < fromIntegral limit = st { selectedRow = (selectedRow st) + 1 } - | otherwise = st +incSelectedRow st | (selectedRow st) < limit = case (mode st) of + MaildirMode -> st { selectedRowMD = (selectedRowMD st) + 1 } + IndexMode -> st { selectedRowIn = (selectedRowIn st) + 1 } + | otherwise = st where - limit = case (mode st) of + limit' = case (mode st) of MaildirMode -> (length $ detectedMDs st ) - 1 IndexMode -> (length $ selectedEmails st) - 1 - _ -> fromIntegral $ scrRows st + limit = if (showStatus st) && (limit' == scrRowsAsInt st) + then fromIntegral $ limit' - 2 + else fromIntegral limit' -decSelectedRow st | selectedRow st > 0 = st { selectedRow = (selectedRow st) - 1 } - | otherwise = st
\ No newline at end of file +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 + +scrColsAsInt st = fromIntegral $ scrColumns st +scrRowsAsInt st = fromIntegral $ scrRows st
\ No newline at end of file |