diff options
| -rw-r--r-- | Config.hs | 14 | ||||
| -rw-r--r-- | Email.hs | 29 | ||||
| -rw-r--r-- | Lazymail.hs | 2 | ||||
| -rw-r--r-- | Maildir.hs | 60 | ||||
| -rw-r--r-- | Main.hs | 23 | ||||
| -rw-r--r-- | Print.hs | 35 | ||||
| -rw-r--r-- | Rfc1342.hs | 25 | ||||
| -rw-r--r-- | Screen.hs | 179 | ||||
| -rw-r--r-- | State.hs | 84 |
9 files changed, 195 insertions, 256 deletions
@@ -3,7 +3,7 @@ - Copyright 2013 Raúl Benencia <rul@kalgan.cc> - - Licensed under the GNU GPL version 3 or higher - - + - -} module Config(LazymailConfig(..), defaultConfig, customConfig) where @@ -13,17 +13,17 @@ import System.FilePath(FilePath) data LazymailConfig = LazymailConfig { baseColor :: (Color, Color) -- (foreground, background) - , selectionColor :: (Color, Color) - , statusBarColor :: (Color, Color) + , selectionColor :: (Color, Color) + , statusBarColor :: (Color, Color) , showStatusBar :: Bool - , initialPath :: FilePath -} + , initialPath :: FilePath +} defaultConfig = LazymailConfig { baseColor = (ColorWhite, ColorBlack) , selectionColor = (ColorBlack, ColorWhite) , statusBarColor = (ColorBlack, ColorWhite) - , showStatusBar = True + , showStatusBar = True , 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 = "/home/rul/mail/kalgan" }
\ No newline at end of file +customConfig = defaultConfig { initialPath = "/home/rul/mail/linti/" }
\ No newline at end of file @@ -1,19 +1,10 @@ --- This module is part of Lazymail, a Haskell email client. --- --- Copyright (C) 2013 Raúl Benencia <rul@kalgan.cc> --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see <http://www.gnu.org/licenses/>. +{- Email accessors. + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + - + -} module Email where import Network.Email.Mailbox(Flag(..), Flags) @@ -25,7 +16,7 @@ import Text.ParserCombinators.Parsec.Rfc2822 data Email = Email { emailPath :: String , parsedEmail :: Message } - + parseEmail :: String -> Message parseEmail msg = unwrapEmail $ parse message "<stdin>" $ fixEol msg @@ -55,7 +46,7 @@ getResentBcc fs = do { ResentBcc f <- fs; f } getResentMessageID fs = do { ResentMessageID f <- fs; f } --getReceived fs = do { Received f <- fs; f } -getBody (Message _ []) = "Empty body" +getBody (Message _ []) = "Empty body" getBody (Message _ body) = body -- Make sure all lines are terminated by CRLF. @@ -72,6 +63,6 @@ fixEol [] = [] -- emailDescription = emailDescriptionWithPP defaultDescriptionPP --- emailDescriptionWithPP pp +-- emailDescriptionWithPP pp diff --git a/Lazymail.hs b/Lazymail.hs index 33a9c11..200b8fd 100644 --- a/Lazymail.hs +++ b/Lazymail.hs @@ -3,7 +3,7 @@ - Copyright 2013 Raúl Benencia <rul@kalgan.cc> - - Licensed under the GNU GPL version 3 or higher - - + - -} module Lazymail where @@ -1,21 +1,12 @@ --- This module is part of Lazymail, a Haskell email client. --- --- Copyright (C) 2013 Raúl Benencia <rul@kalgan.cc> --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see <http://www.gnu.org/licenses/>. +{- Utilities for working with Maildir format. + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + - + -} -module Maildir where +module Maildir where import Control.Monad.Loops(allM) import Control.Monad (forM, filterM) @@ -24,7 +15,7 @@ import System.Directory (doesDirectoryExist, getDirectoryContents) import System.FilePath ((</>)) import System.IO(IOMode(..), hGetContents, openFile) import Network.Email.Mailbox(Flag(..), Flags) - + type Maildir = FilePath isMaildir :: FilePath -> IO Bool @@ -32,20 +23,20 @@ isMaildir fp = allM doesDirectoryExist [ fp , fp </> "cur" , fp </> "new" , fp </> "tmp"] - + listIDs :: Maildir -> IO [FilePath] listIDs md = getNewIDs md `appendM` getReadIDs md where mxs `appendM` mxs' = do xs <- mxs xs' <- mxs' return (xs ++ xs') - + getNewIDs :: Maildir -> IO [FilePath] getNewIDs md = getIDs (md </> "new") getReadIDs :: Maildir -> IO [FilePath] -getReadIDs md = getIDs (md </> "cur") - +getReadIDs md = getIDs (md </> "cur") + getIDs :: FilePath -> IO [FilePath] getIDs fp = do names <-getDirectoryContents fp @@ -57,7 +48,7 @@ listMessageFlags fp = do ids <- (listIDs fp) let flags = map getFlags ids return (zip ids flags) - + getFlags :: FilePath -> Flags getFlags fp = map toFlag $ strip fp where strip x @@ -65,7 +56,7 @@ getFlags fp = map toFlag $ strip fp | ":2," `isPrefixOf` x = drop 3 x | otherwise = let (discard, analyze) = span (/= ':') fp in strip analyze - + toFlag :: Char -> Flag toFlag c | c == 'S' = SEEN | c == 'A' = ANSWERED @@ -74,24 +65,24 @@ toFlag c | c == 'S' = SEEN | c == 'P' = FORWARDED | c == 'T' = DELETED | otherwise = OTHERFLAG [c] - + getAll :: Maildir -> IO [(FilePath, Flags, String)] getAll fp = do ids <- listIDs fp msgs <- mapM (\x -> hGetContents =<< openFile x ReadMode) ids let flags = map getFlags ids return $ zip3 ids flags msgs - -{- | Returns information about specific messages. -} + +{- | 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 :: FilePath -> IO [Maildir] getMaildirsRecursively topdir = do result <- search topdir includeTopDir <- isMaildir topdir @@ -113,13 +104,10 @@ getMaildirsRecursively topdir = do else return [] filterM isMaildir (concat paths) - - + -- Temporal code for testing purposes -defaultPath = "/home/rul/mail/linti/INBOX.academic.c.questions" +defaultPath = "/home/rul/mail/linti/INBOX.academic.c.questions" getFirstEmail = do lst <- getAll defaultPath let (_, _, msg) = head lst return msg - -
\ No newline at end of file @@ -1,19 +1,10 @@ --- This module is part of Lazymail, a Haskell email client. --- --- Copyright (C) 2013 Raúl Benencia <rul@kalgan.cc> --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see <http://www.gnu.org/licenses/>. +{- Main module + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + - + -} module Main (main) where @@ -1,19 +1,10 @@ --- This module is part of Lazymail, a Haskell email client. --- --- Copyright (C) 2013 Raúl Benencia <rul@kalgan.cc> --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see <http://www.gnu.org/licenses/>. +{- Printing utilities. + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + - + -} module Print where @@ -29,13 +20,13 @@ ppNameAddr nas = concat $ map ppNameAddr' nas where ppNameAddr' na = case nameAddr_name na of Nothing -> nameAddr_addr na Just n -> decodeField n - -ppIndexNameAddr = normalizeLen nameLen . ppNameAddr - + +ppIndexNameAddr = normalizeLen nameLen . ppNameAddr + subjectLen = 90 ppSubject = decodeField ppIndexSubject = normalizeLen subjectLen . ppSubject - + ppFlags :: Flags -> String ppFlags = map ppFlag @@ -55,7 +46,7 @@ normalizeLen len cs = if (length cs > len) else 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 @@ -76,7 +67,7 @@ pad = wrap " " " " trim :: String -> String trim = f . f where f = reverse . dropWhile isSpace - + -- | Limit a string to a certain length, adding "..." if truncated. shorten :: Int -> String -> String shorten n xs | length xs < n = xs @@ -1,21 +1,10 @@ --- A simple Haskell RFC1342 decoder --- Copyright (C) 2013 Raúl Benencia <rul@kalgan.cc> --- --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. --- --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. --- --- You should have received a copy of the GNU General Public License --- along with this program. If not, see <http://www.gnu.org/licenses/>. - --- This module is an ugly hack. It has been poorly tested and it'll --- probably blow up in your face. You've been warned. +{- A simple RFC1342 decoder. + - + - Copyright 2013 Raúl Benencia <rul@kalgan.cc> + - + - Licensed under the GNU GPL version 3 or higher + - + -} module Rfc1342 (decodeField) where import qualified Codec.Binary.Base64 as B64 @@ -14,6 +14,7 @@ import Control.Monad.State import Data.List(isPrefixOf) import UI.NCurses as UI import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) +import System.Exit -- Local imports import Config @@ -49,9 +50,9 @@ startCurses = do 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 + let style = ColorStyle defaultColorID selColID staColID + return $ st { screenRows = fromIntegral $ rows - 1 + , screenColumns = fromIntegral $ cols , colorStyle = style } screenLoop @@ -61,7 +62,8 @@ screenLoop = do w <- liftCurses $ defaultWindow st <- get cfg <- ask - liftCurses $ updateWindow w $ do runStateT (runReaderT performUpdate cfg) st + (_, st') <- liftCurses $ updateWindow w $ runStateT (runReaderT performUpdate cfg) st + put st' liftCurses $ render handleEvent st <- get @@ -69,109 +71,114 @@ screenLoop = do then screenLoop else return () -performUpdate :: LazymailUpdate () +--performUpdate :: LazymailUpdate () performUpdate = do st <- get liftUpdate $ clearMain (scrRowsAsInteger st) (screenColumns st) drawMode (mode st) drawStatus + get >>= return --- | Pattern match on the received mode and draw it in the screen. +{- Pattern match on the received mode and draw it in the screen. -} drawMode :: Mode -> LazymailUpdate () -drawMode MaildirMode = do - st <- get - let mdState = maildirState st - drawMaildirHelper $ detectedMDs mdState ---drawMode EmailMode = drawEmailHelper ---drawMode IndexMode = drawIndexHelper (selectedEmails st) +drawMode MaildirMode = get >>= \st -> drawMaildirHelper $ detectedMDs . maildirState $ st +drawMode IndexMode = get >>= \st -> drawIndexHelper $ selectedEmails . indexState $ st +drawMode EmailMode = drawEmailHelper --- | Helper function of drawMode +{- Helper function of drawMode -} drawMaildirHelper :: [FilePath] -> LazymailUpdate () drawMaildirHelper [] = resetCurrentRow drawMaildirHelper (md:mds) = do st <- get - (=<<) put $ liftUpdate $ do - moveCursor (curRowAsInteger st) (colPadAsInteger st) - if (selectedRow st == currentRow st) + liftUpdate $ 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 + liftUpdate $ do + setColor $ selectionColorID . colorStyle $ st + drawString $ normalizeLen (screenColumns st) md + setColor $ baseColorID . colorStyle $ st + let maildirState' = (maildirState st) { selectedMD = md } + put $ st { maildirState = maildirState' } + else liftUpdate $ drawString $ normalizeLen (screenColumns st) md 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 } + incrementCurrentRow drawMaildirHelper mds else resetCurrentRow --- | Empty the whole window. Useful when changing modes. +{- 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) + drawString $ replicate (columns) ' ' + 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 - 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 } - +drawIndexHelper [] = resetCurrentRow +drawIndexHelper ((fp, _, msg):ts) = do + st <- get + (=<<) put $ liftUpdate $ do + moveCursor (curRowAsInteger st) (colPadAsInteger st) + let email = parseEmail msg + let fs = getFields email + let str = normalizeLen (screenColumns st) . concat $ + [ show $ (currentRow st) + 1 + , (ppSep ++) $ ppFlags . getFlags $ fp + , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs + , (ppSep ++) $ ppIndexSubject . getSubject $ fs + ] + if (selectedRow st == currentRow st) + then do + setColor $ selectionColorID . colorStyle $ st + drawString str + setColor $ baseColorID . colorStyle $ st + let indexState' = (indexState st) { selectedEmail = email} + return $ st { indexState = indexState' } + else do + drawString str + return st + + st <- get + let limit = if statusBar st then (screenRows st) - 1 else screenRows st + if currentRow st < limit + then do + incrementCurrentRow + drawIndexHelper ts + else resetCurrentRow + -- | 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 $ (scrColsAsInt st) - (length xs) - let row = curRow st - moveCursor row (colPadding st) - drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs - moveCursor (row + 1) (colPadding st) - drawString $ ("To: " ++) $ cropWith "To: " . ppNameAddr . getTo $ fs - moveCursor (row + 2) (colPadding st) - drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs - - let body = getBody $ selectedEmail st - drawBody (row + 4) (colPadding st) $ formatBody body (scrColsAsInt st) - return st - where drawBody _ _ [] = return () - drawBody row col (xs:xss) = do +-- TODO: Make helpers functions to draw header and body in a separate way. +drawEmailHelper = do + st <- get + let fs = getFields $ selectedEmail . indexState $ st + let cropWith xs = normalizeLen $ (screenColumns st) - (length xs) + let row = curRowAsInteger st + liftUpdate $ do + moveCursor row (colPadAsInteger st) + drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs + moveCursor (row + 1) (colPadAsInteger st) + drawString $ ("To: " ++) $ cropWith "To: " . ppNameAddr . getTo $ fs + moveCursor (row + 2) (colPadAsInteger st) + drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs + + let body = getBody $ selectedEmail . indexState $ st + liftUpdate $ drawBody (row + 4) (colPadAsInteger st) (scrRowsAsInteger st) $ formatBody body (screenColumns st) + + where drawBody _ _ _ [] = return () + drawBody row col maxRows (xs:xss) = do moveCursor row col drawString xs - if row < (scrRows st) then drawBody (row + 1) col xss else return () + if row < maxRows then drawBody (row + 1) col maxRows xss else return () - -- | Convert a String to multiple Strings, cropped by the maximum column -- size if necessary. formatBody :: String -> Int -> [String] @@ -181,12 +188,12 @@ 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 = do st <- get liftUpdate $ do - moveCursor ((scrRowsAsInteger st) - 2) 0 + moveCursor ((scrRowsAsInteger st) - 1) 0 setColor $ statusBarColorID . colorStyle $ st drawString . normalizeLen (screenColumns st) . concat $ drawStatusHelper (mode st) st setColor $ baseColorID . colorStyle $ st @@ -195,9 +202,9 @@ drawStatusHelper MaildirMode st = ["Maildir listing - " , "(", show ((+ 1) . selectedRow $ st), "/" , show (length $ detectedMDs . maildirState $ st), ")"] -drawStatusHelper IndexMode st = ["mode: Index - "] --- , "(", show ((+ 1) . selectedRow $ st), "/" --- , show (length $ selectedEmails . indexState $ st), ")"] +drawStatusHelper IndexMode st = ["mode: Index - " + , "(", show ((+ 1) . selectedRow $ st), "/" + , show (length $ selectedEmails . indexState $ st), ")"] drawStatusHelper EmailMode st = ["mode: Email"] @@ -218,20 +225,24 @@ handleEvent = loop where EmailMode -> put $ st { mode = IndexMode } MaildirMode -> put $ st { exitRequested = True } -{- EventSpecialKey KeyUpArrow -> put $ decSelectedRow st - EventCharacter 'k' -> put $ decSelectedRow st + EventSpecialKey KeyUpArrow -> put $ decrementSelectedRow st + EventCharacter 'k' -> put $ decrementSelectedRow st - EventSpecialKey KeyDownArrow -> put $ incSelectedRow st - EventCharacter 'j' -> put $ incSelectedRow st + EventSpecialKey KeyDownArrow -> put $ incrementSelectedRow st + EventCharacter 'j' -> put $ incrementSelectedRow st EventSpecialKey KeyRightArrow -> do case (mode st) of IndexMode -> put $ st { mode = EmailMode } EmailMode -> return () MaildirMode -> do - selEmails <- liftIO $ getAll . selectedMD $ st - return $ st { mode = IndexMode, selectedEmails = selEmails } -} + selectedEmails' <- liftIO $ do + let md = (selectedMD . maildirState) $ st + getAll md + let indexState' = (indexState st) { selectedEmails = selectedEmails' } + put $ st { mode = IndexMode, indexState = indexState' } _ -> loop -resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
\ No newline at end of file +resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 } +incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (currentRow st) + 1 } @@ -95,64 +95,42 @@ curRowAsInteger st = toInteger $ currentRow st colPadAsInteger st = toInteger $ columnPadding st - -{- data MState = MState { - selectedRowMD :: Integer -- Selected row in MaildirMode - , selectedRowIn :: Integer -- Selected row in IndexMode - , mode :: Mode - , initPath :: String - , scrRows :: Integer - , scrColumns :: Integer - , curRow :: Integer - , colPadding :: Integer - , selectedColorID :: ColorID - , statusColorID :: ColorID - , selectedEmail :: Message - , selectedEmails :: [(String, [Flag], String)] - , selectedMD :: String - , detectedMDs :: [String] - , exitRequested :: Bool - , showStatus :: Bool -} - -initState = MState { - selectedRowMD = 0 - , selectedRowIn = 0 - , mode = MaildirMode - , initPath = "" - , scrRows = (-1) - , scrColumns = (-1) - , curRow = 0 - , colPadding = 0 - , selectedColorID = defaultColorID - , statusColorID = defaultColorID - , selectedEmail = Message [] "Dummy email" - , selectedEmails = [] - , selectedMD = "" - , detectedMDs = [] - , exitRequested = False - , showStatus = True -} - -incCurRow st = st { curRow = (curRow st) + 1 } - -incSelectedRow st | (selectedRow st) < limit = case (mode st) of - MaildirMode -> st { selectedRowMD = (selectedRowMD st) + 1 } - IndexMode -> st { selectedRowIn = (selectedRowIn st) + 1 } - | otherwise = st +incrementSelectedRow st | (selectedRow st) < limit = case (mode st) of + MaildirMode -> + let + sr = (selectedRowMD . maildirState) st + maildirState' = (maildirState st) { selectedRowMD = sr + 1 } + in + st { maildirState = maildirState' } + IndexMode -> + let + sr = (selectedRowIn . indexState) st + indexState' = (indexState st) { selectedRowIn = sr + 1 } + in + st { indexState = indexState' } + | otherwise = st where limit' = case (mode st) of - MaildirMode -> (length $ detectedMDs st ) - 1 - IndexMode -> (length $ selectedEmails st) - 1 - limit = if (showStatus st) && (limit' == scrRowsAsInt st) + MaildirMode -> (length $ detectedMDs . maildirState $ st ) - 1 + IndexMode -> (length $ selectedEmails . indexState $ st) - 1 + limit = if (statusBar st) && (limit' == screenRows st) then fromIntegral $ limit' - 2 else fromIntegral limit' -decSelectedRow st | (selectedRow st) > 0 = case (mode st) of - MaildirMode -> st { selectedRowMD = (selectedRowMD st) - 1 } - IndexMode -> st { selectedRowIn = (selectedRowIn st) - 1 } - | otherwise = st --} +decrementSelectedRow st | (selectedRow st) > 0 = case (mode st) of + MaildirMode -> + let + sr = (selectedRowMD . maildirState) st + maildirState' = (maildirState st) { selectedRowMD = sr - 1 } + in + st { maildirState = maildirState' } + IndexMode -> + let + sr = (selectedRowIn . indexState) st + indexState' = (indexState st) { selectedRowIn = sr - 1 } + in + st { indexState = indexState' } + | otherwise = st selectedRow st = case (mode st) of MaildirMode -> selectedRowMD . maildirState $ st |