diff options
| -rw-r--r-- | .gitignore | 3 | ||||
| -rw-r--r-- | Config.hs | 16 | ||||
| -rw-r--r-- | Email.hs | 77 | ||||
| -rw-r--r-- | Maildir.hs | 125 | ||||
| -rw-r--r-- | Main.hs | 50 | ||||
| -rw-r--r-- | Print.hs | 85 | ||||
| -rw-r--r-- | Rfc1342.hs | 68 | ||||
| -rw-r--r-- | Screen.hs | 217 | ||||
| -rw-r--r-- | State.hs | 72 |
9 files changed, 713 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f9bb5e3 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +Main +*.o +*.hi
\ No newline at end of file diff --git a/Config.hs b/Config.hs new file mode 100644 index 0000000..b2d865b --- /dev/null +++ b/Config.hs @@ -0,0 +1,16 @@ +-- 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/>. diff --git a/Email.hs b/Email.hs new file mode 100644 index 0000000..78ffff6 --- /dev/null +++ b/Email.hs @@ -0,0 +1,77 @@ +-- 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/>. +module Email where + +import Network.Email.Mailbox(Flag(..), Flags) + +import Text.Parsec.Error(ParseError) +import Text.ParserCombinators.Parsec (parse) +import Text.ParserCombinators.Parsec.Rfc2822 + +data Email = Email { emailPath :: String + , parsedEmail :: Message + } + +parseEmail :: String -> Message +parseEmail msg = unwrapEmail $ parse message "<stdin>" $ fixEol msg + +unwrapEmail (Right email) = email +getFields (Message fs _) = fs + +-- There is obviously a pattern here. Find a way to narrow it down. +getReturnPath fs = do { ReturnPath f <- fs; f } +getFrom fs = do { From f <- fs; f } +getTo fs = do { To f <- fs; f } +getCc fs = do { Cc f <- fs; f } +getBcc fs = do { Bcc f <- fs; f } +getReplyTo fs = do { ReplyTo f <- fs; f } +getSubject fs = do { Subject f <- fs; f } +getMessageID fs = do { MessageID f <- fs; f } +getInReplyTo fs = do { InReplyTo f <- fs; f } +getReferences fs = do { References f <- fs; f } +getComments fs = do { Comments f <- fs; f } +getKeywords fs = do { Keywords f <- fs; f } +--getDate fs = do { Date f <- fs; f } +--getResentDate fs = do { ResentDate f <- fs; f } +getResentFrom fs = do { ResentFrom f <- fs; f } +--getResentSender fs = do { ResentSender f <- fs; f } +getResentTo fs = do { ResentTo f <- fs; f } +getResentCc fs = do { ResentCc f <- fs; f } +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 _ body) = body + +-- Make sure all lines are terminated by CRLF. +fixEol :: String -> String +fixEol ('\r':'\n':xs) = '\r' : '\n' : fixEol xs +fixEol ('\n':xs) = '\r' : '\n' : fixEol xs +fixEol (x:xs) = x : fixEol xs +fixEol [] = [] + +--data DescriptionPP = DescriptionPP { +-- ppOrder :: [String] -> [String] +-- } + + +-- emailDescription = emailDescriptionWithPP defaultDescriptionPP + +-- emailDescriptionWithPP pp + + diff --git a/Maildir.hs b/Maildir.hs new file mode 100644 index 0000000..633db23 --- /dev/null +++ b/Maildir.hs @@ -0,0 +1,125 @@ +-- 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/>. + +module Maildir where + +import Control.Monad.Loops(allM) +import Control.Monad (forM, filterM) +import Data.List(isPrefixOf) +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 +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") + +getIDs :: FilePath -> IO [FilePath] +getIDs fp = do + names <-getDirectoryContents fp + let properNames = filter (`notElem` [".", ".."]) names + return $ map (fp </>) properNames + +listMessageFlags :: Maildir -> IO [(FilePath, Flags)] +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 + | null x = [] + | ":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 + | c == 'F' = FLAGGED + | c == 'D' = DRAFT + | 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. -} +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 + +
\ No newline at end of file @@ -0,0 +1,50 @@ +-- 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/>. + +module Main where + +import System.Environment +import System.Exit +import System.FilePath(takeDirectory) + +import Email +import Maildir +import Screen +import State + +parse ["-h"] = usage >> exit +parse ["-v"] = version >> exit +parse [md] = do + putStrLn $ "Maildirs directory: " ++ md + entryPoint $ initState { initPath = md } + +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) + +main :: IO () +main = do + args <- getArgs + parse args + putStrLn "Game over!" diff --git a/Print.hs b/Print.hs new file mode 100644 index 0000000..2e47c39 --- /dev/null +++ b/Print.hs @@ -0,0 +1,85 @@ +-- 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/>. + +module Print where + +import Network.Email.Mailbox(Flag(..), Flags) +import Text.ParserCombinators.Parsec.Rfc2822(NameAddr(..)) +import Data.Char ( isSpace ) + +import Email +import Rfc1342 + +nameLen = 20 +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 + +subjectLen = 90 +ppSubject = decodeField +ppIndexSubject = normalizeLen subjectLen . ppSubject + +ppFlags :: Flags -> String +ppFlags = map ppFlag + +ppFlag :: Flag -> Char +ppFlag SEEN = 'S' +ppFlag ANSWERED = 'A' +ppFlag FLAGGED = 'F' +ppFlag DRAFT = 'D' +ppFlag FORWARDED = 'P' +ppFlag DELETED = 'T' +ppFlag (OTHERFLAG [c]) = c + +ppSep = "\t" + +normalizeLen len cs = if (length cs > len) + then shorten len cs + 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 + +-- | Wrap a string in delimiters, unless it is empty. +wrap :: String -- ^ left delimiter + -> String -- ^ right delimiter + -> String -- ^ output string + -> String +wrap _ _ "" = "" +wrap l r m = l ++ m ++ r + +-- | Pad a string with a leading and trailing space. +pad :: String -> String +pad = wrap " " " " + +-- | Trim leading and trailing whitespace from a string. +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 + | otherwise = take (n - length end) xs ++ end + where + end = "..." diff --git a/Rfc1342.hs b/Rfc1342.hs new file mode 100644 index 0000000..08822b3 --- /dev/null +++ b/Rfc1342.hs @@ -0,0 +1,68 @@ +-- 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. +module Rfc1342 (decodeField) where + +import qualified Codec.Binary.Base64 as B64 +import qualified Codec.Binary.QuotedPrintable as QP + +import Data.Char (toLower, isSpace, chr) +import Data.List(isPrefixOf) +import Data.Word (Word8) + +import Data.Encoding(decodeString) + +-- Encoding imports. If you want to support more encodings, just add'em here. +import Data.Encoding.UTF8 +import Data.Encoding.ISO88591 +import Data.Encoding.ISO88592 +import Data.Encoding.ISO88598 +import Data.Encoding.ISO88599 + +decodeField :: String -> String +decodeField ('=':'?':cs) = decodeWithCharset dec rest + where (encoding, rest) = span (\c -> c /= '?') cs + dec = case (map toLower encoding) of + "utf-8" -> decodeString UTF8 + "iso-8859-1" -> decodeString ISO88591 + "iso-8859-2" -> decodeString ISO88592 + "iso-8859-8" -> decodeString ISO88598 + "iso-8859-9" -> decodeString ISO88599 + _ -> id +decodeField [] = [] +decodeField (c:cs) = c:decodeField cs + +decodeWithCharset dec [] = [] +decodeWithCharset dec ('?':c:'?':cs) | toLower c == 'b' = dataDecodeWith B64.decode + | toLower c == 'q' = dataDecodeWith QP.decode + | otherwise = cs + where (encoded, rest') = span (\c -> c /= '?') cs + rest = if "?=" `isPrefixOf` rest' + then drop 2 rest' + else rest' + dataDecodeWith datadec = (_2spc . dec . unwrap . datadec $ encoded) ++ (decodeField $ dropWhile isSpace rest) + +unwrap :: Maybe [Word8] -> String +unwrap Nothing = [] +unwrap (Just str) = bytesToString str + +bytesToString :: [Word8] -> String +bytesToString = map (chr . fromIntegral) + +-- Sometimes an underscore represents the SPACE character +_2spc = map (\x -> if x == '_' then ' ' else x)
\ No newline at end of file diff --git a/Screen.hs b/Screen.hs new file mode 100644 index 0000000..fa01584 --- /dev/null +++ b/Screen.hs @@ -0,0 +1,217 @@ +-- 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/>. + +module Screen where + +import Data.List(isPrefixOf) +import UI.NCurses +import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) + +-- Local imports +import Maildir +import Email +import Print +import Rfc1342 +import State + +ppBaseRow = 0 +ppBaseColumn = 0 + +-- +-- | 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 + let st = st' { + scrRows = rows - 1 + , scrColumns = columns - 1 + , selectedColorID = selColID + , detectedMDs = maildirs } + screenLoop st + +screenLoop :: MState -> Curses () +screenLoop st = do + w <- defaultWindow + updateWindow w $ do + clearMain (fromIntegral . scrRows $ st) (fromIntegral . scrColumns $ st) + drawMode (mode st) st + render + st' <- handleEvent st + if (not . exitRequested) st' + then screenLoop st' + else return () + +-- +-- | Handle an event +-- +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 MaildirMode st = drawMaildirHelper st (detectedMDs st) +drawMode EmailMode st = drawEmailHelper st +drawMode IndexMode st = drawIndexHelper 0 0 (curRow st) (colPadding st) (selectedEmails st) + +drawMaildirHelper _ [] = return () +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 () + +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 () + +waitFor :: Window -> (Event -> Bool) -> Curses () +waitFor w p = loop where + loop = do + ev <- getEvent w Nothing + case ev of + Nothing -> loop + Just ev' -> if p ev' then return () else loop + +extractParsedData :: Either a b -> b +extractParsedData (Right msg) = msg +--extractParsedData (Left err) = error err + +drawEmailHelper st = do + let fs = getFields $ selectedEmail st + let cropWith xs = normalizeLen $ (fromIntegral . scrColumns $ 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 (fromIntegral . scrColumns $ st) + where drawBody _ _ [] = return () + drawBody row col (xs:xss) = do + moveCursor row col + 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. +-- +formatBody :: String -> Int -> [String] +formatBody body maxColumns = format [] [] body where + format parsed acc [] = parsed ++ [acc] + 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 + + + +-- drawIndex :: Maildir -> IO () +-- drawIndex md = do +-- emails <- getAll md +-- runCurses $ do +-- setEcho False +-- (rows, columns) <- screenSize +-- w <- defaultWindow +-- updateWindow w $ do +-- clearMain (fromIntegral rows) (fromIntegral columns) +-- drawIndexHelper 0 0 (fromIntegral rows) (fromIntegral columns) emails +-- render +-- waitFor w (\ev -> ev == EventCharacter 'q' || ev == EventCharacter 'Q') +-- let (_, _, msg) = head emails +-- drawEmail $ parseEmail msg + +-- drawEmail :: Message -> IO () +-- drawEmail email = do +-- runCurses $ do +-- setEcho False +-- (rows, columns) <- screenSize +-- w <- defaultWindow +-- updateWindow w $ do +-- clearMain (fromIntegral rows) (fromIntegral columns) +-- drawEmailHelper ppBaseRow ppBaseColumn (fromIntegral rows - 1) (fromIntegral columns - 1) email +-- render +-- waitFor w (\ev -> ev == EventCharacter 'q' || ev == EventCharacter 'Q') + +-- drawMaildir :: MState -> IO () +-- drawMaildir st = do +-- maildirs <- getMaildirsRecursively (initPath st) +-- runCurses $ do +-- setEcho False +-- (rows, columns) <- screenSize +-- selColID <- newColorID ColorBlack ColorWhite 1 +-- let st' = st { +-- scrRows = rows - 1 +-- , scrColumns = columns - 1 +-- , selectedColorID = selColID } +-- w <- defaultWindow +-- updateWindow w $ do +-- clearMain (fromIntegral rows) (fromIntegral columns) +-- drawMaildirHelper st' maildirs +-- render +-- waitFor w (\ev -> ev == EventCharacter 'q' || ev == EventCharacter 'Q') +
\ No newline at end of file diff --git a/State.hs b/State.hs new file mode 100644 index 0000000..3826bfc --- /dev/null +++ b/State.hs @@ -0,0 +1,72 @@ +-- 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/>. + +-- +-- | The top level application state, and operations on that value. +-- +module State where + +import Text.ParserCombinators.Parsec.Rfc2822(Message, GenericMessage(..)) +import UI.NCurses(ColorID(..), defaultColorID) +import Network.Email.Mailbox(Flag(..), Flags) + +data Mode = MaildirMode | IndexMode | EmailMode + +data MState = MState { + selectedRow :: Integer + , mode :: Mode + , initPath :: String + , scrRows :: Integer + , scrColumns :: Integer + , curRow :: Integer + , colPadding :: Integer + , selectedColorID :: ColorID + , selectedEmail :: Message + , selectedEmails :: [(String, [Flag], String)] + , selectedMD :: String + , detectedMDs :: [String] + , exitRequested :: Bool +} + +initState = MState { + selectedRow = 0 + , mode = MaildirMode + , initPath = "" + , scrRows = (-1) + , scrColumns = (-1) + , curRow = 0 + , colPadding = 0 + , selectedColorID = defaultColorID + , selectedEmail = Message [] "Dummy email" + , selectedEmails = [] + , selectedMD = "" + , detectedMDs = [] + , exitRequested = False +} + +incCurRow st = st { curRow = (curRow st) + 1 } + +incSelectedRow st | selectedRow st < fromIntegral limit = st { selectedRow = (selectedRow st) + 1 } + | otherwise = st + where + limit = case (mode st) of + MaildirMode -> (length $ detectedMDs st ) - 1 + IndexMode -> (length $ selectedEmails st) - 1 + _ -> fromIntegral $ scrRows st + +decSelectedRow st | selectedRow st > 0 = st { selectedRow = (selectedRow st) - 1 } + | otherwise = st
\ No newline at end of file |