From ce68d07f31019bf318a75e0ef9c438f0d25ae846 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ra=C3=BAl=20Benencia?= Date: Tue, 20 Aug 2013 20:37:34 -0300 Subject: first commit --- .gitignore | 3 + Config.hs | 16 +++++ Email.hs | 77 ++++++++++++++++++++++ Maildir.hs | 125 +++++++++++++++++++++++++++++++++++ Main.hs | 50 ++++++++++++++ Print.hs | 85 ++++++++++++++++++++++++ Rfc1342.hs | 68 +++++++++++++++++++ Screen.hs | 217 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ State.hs | 72 ++++++++++++++++++++ 9 files changed, 713 insertions(+) create mode 100644 .gitignore create mode 100644 Config.hs create mode 100644 Email.hs create mode 100644 Maildir.hs create mode 100644 Main.hs create mode 100644 Print.hs create mode 100644 Rfc1342.hs create mode 100644 Screen.hs create mode 100644 State.hs 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 +-- +-- 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 . 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 +-- +-- 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 . +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 "" $ 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 +-- +-- 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 . + +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 diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..1c79c07 --- /dev/null +++ b/Main.hs @@ -0,0 +1,50 @@ +-- This module is part of Lazymail, a Haskell email client. +-- +-- Copyright (C) 2013 Raúl Benencia +-- +-- 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 . + +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] " + ," where 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 +-- +-- 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 . + +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 +-- +-- 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 . + +-- 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 +-- +-- 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 . + +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 +-- +-- 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 . + +-- +-- | 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 -- cgit v1.2.3