Moved all code to src/

9 files changed, 1179 insertions, 0 deletions

diff --git a/src/Lazymail/Config.hs b/src/Lazymail/Config.hs
new file mode 100644
index 0000000..2566bc9
--- /dev/null
+++ b/src/Lazymail/Config.hs
@@ -0,0 +1,55 @@
+{- Lazymail user configuration
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -
+ -}
+
+module Lazymail.Config(LazymailConfig(..), defaultConfig, customConfig) where
+
+import Data.List(sort, stripPrefix)
+import System.Posix.Files(getSymbolicLinkStatus, isSymbolicLink)
+import UI.NCurses(Color(..))
+
+import Lazymail.Keymap
+import Lazymail.Types(LazymailConfig(..))
+
+defaultConfig = LazymailConfig {
+    baseColor          = (ColorWhite, ColorBlack)
+  , selectionColor     = (ColorBlack, ColorWhite)
+  , statusBarColor     = (ColorBlack, ColorBlue)
+  , headerColor        = (ColorGreen, ColorBlack)
+  , newEmailColor      = (ColorBlue, ColorBlack)
+  , showStatusBar      = True
+  , initialPath        = ""
+  , filterMaildirsHook =  \mds -> return mds
+  , indexDateFormat    = "%m %d"
+  , headersToShow      = ["date", "from", "to", "cc", "bcc", "subject", "reply-to"]
+  , globalKeymaps      = defaultGlobalKeymap
+  , maildirModeKeymap  = defaultMaildirKeymap
+  , indexModeKeymap    = defaultIndexKeymap
+  , emailModeKeymap    = defaultEmailKeymap
+  , composeModeKeymap  = defaultComposeKeymap
+}
+
+--
+-- | Users should modify customConfig in order to set-up their
+-- preferences. In a possible future maybe I'll work in a not-so-crappy
+-- config system.
+--
+--customConfig = defaultConfig { initialPath = "/home/rul/mail/"}
+
+customConfig = defaultConfig { initialPath = "/home/rul/mail/"
+                             , filterMaildirsHook = filterSymlinks }
+
+filterSymlinks :: [FilePath] -> IO [FilePath]
+filterSymlinks [] = return []
+filterSymlinks (md:mds) = do
+  filtered <- do
+    fs <- getSymbolicLinkStatus md
+    rest <- filterSymlinks mds
+    if isSymbolicLink fs
+      then return rest
+      else return (md:rest)
+  return $ sort filtered
\ No newline at end of file
diff --git a/src/Lazymail/Email.hs b/src/Lazymail/Email.hs
new file mode 100644
index 0000000..fc63a89
--- /dev/null
+++ b/src/Lazymail/Email.hs
@@ -0,0 +1,132 @@
+{- Email accessors.
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -
+ -}
+module Lazymail.Email where
+
+import Codec.MIME.Type(MIMEValue(..), MIMEContent(..), showMIMEType, Type(..), MIMEType(..))
+import Data.Char(toLower)
+import Data.List(find)
+
+getBody :: MIMEValue -> String
+getBody msg =
+  case mime_val_content msg of
+    Single c -> c
+    Multi mvs -> case firstTextPart mvs of
+      Just mv -> unwrapContent . mime_val_content $ mv
+      Nothing -> "This email has no displayable content."
+  where
+    unwrapContent (Single c) = c
+
+-- hackish function for showing the email. In he future the logic of this
+-- function should be improved.
+firstTextPart []       = Nothing
+firstTextPart (mv:mvs) = case mime_val_content mv of
+  Single c   -> if isText mv then Just mv else firstTextPart mvs
+  Multi mvs' -> firstTextPart mvs'
+
+  where
+  isText = \mv -> case (mimeType $ mime_val_type mv) of
+    Text text -> True
+    _         -> False
+
+getHeaders :: MIMEValue -> [(String,String)]
+getHeaders = mime_val_headers
+
+-- | 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
+
+
+-- The following function is a verbatim copy of the unexported function in
+-- Codec.MIME.Parse.
+-- case in-sensitive lookup of field names or attributes\/parameters.
+lookupField' :: String -> [(String,a)] -> Maybe a
+lookupField' n ns =
+   -- assume that inputs have been mostly normalized already
+   -- (i.e., lower-cased), but should the lookup fail fall back
+   -- to a second try where we do normalize before giving up.
+  case lookup n ns of
+    x@Just{} -> x
+    Nothing  ->
+      let nl = map toLower n in
+      case find (\ (y,_) -> nl == map toLower y) ns of
+        Nothing -> Nothing
+	Just (_,x)  -> Just x
+
+unwrapField = maybe "" id
+
+lookupField n ns = unwrapField $ lookupField' n ns
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+{-import Text.Parsec.Error(ParseError)
+import Text.ParserCombinators.Parsec (parse)
+import Text.ParserCombinators.Parsec.Rfc2822
+
+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 []               = []-}
diff --git a/src/Lazymail/Handlers.hs b/src/Lazymail/Handlers.hs
new file mode 100644
index 0000000..b0b1165
--- /dev/null
+++ b/src/Lazymail/Handlers.hs
@@ -0,0 +1,232 @@
+{- Event handlers for Lazymail
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -}
+
+module Lazymail.Handlers where
+
+import Codec.MIME.Parse(parseMIMEMessage)
+import Codec.MIME.Type(MIMEValue(..))
+import Control.Exception(evaluate)
+import Control.Monad.State
+import Data.List(intercalate, stripPrefix, sort)
+import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator)
+import System.IO(openFile, IOMode(..), hClose)
+import System.Locale(rfc822DateFormat)
+import Data.DateTime(parseDateTime, startOfTime, formatDateTime)
+import qualified System.IO.UTF8 as UTF8
+
+import Lazymail.Email(lookupField, getBody, formatBody)
+import Lazymail.Maildir
+import Lazymail.Print
+import Lazymail.State
+import Lazymail.Types
+
+previousMode :: Mode -> LazymailCurses ()
+previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True }
+previousMode EmailMode   = do
+  st <- get
+  if (triggerUpdateIn . indexState $ st)
+  then do
+    changeMode MaildirMode
+    solveIndexUpdate
+  else put $ st { mode = IndexMode }
+previousMode IndexMode   = do
+  st <- get
+  let ist = (indexState st) { selectedRowIn = 0, scrollRowIn = 0 }
+  put $ st { mode = MaildirMode, indexState = ist }
+
+changeMode :: Mode -> LazymailCurses ()
+changeMode EmailMode   = return ()
+changeMode IndexMode   = do
+  st <- get
+  let fp = selectedEmailPath . indexState $ st
+  nfp <- if (isNew fp)
+         then liftIO $ markAsRead fp
+         else return fp
+  when (fp /= nfp) triggerIndexUpdate
+  st <- get
+  msg <- liftIO $ UTF8.readFile nfp
+  let email = parseMIMEMessage msg
+  let body = getBody $ email
+  let el = formatBody body $ screenColumns st
+  let est = (emailState st) { currentEmail = email, emailLines = el, scrollRowEm = 0 }
+  put $ st { mode = EmailMode, emailState = est }
+
+changeMode MaildirMode =  do
+  st <- get
+  unsortedEmails <- liftIO $ do
+    freeOldHandlers st
+    let md = (selectedMD . maildirState) $ st
+    emails <- getMaildirEmails md
+    mapM toEmail emails
+  let selectedEmails' = reverse $ sort unsortedEmails
+  let scrollRow = scrollRowIn . indexState $ st
+  let scrRows = screenRows st
+  let indexState' = (indexState st) {
+          selectedEmails = selectedEmails'
+        , currentInLen   = length selectedEmails'
+        , scrollBufferIn = formatIndexModeRows st $ scrollCrop scrollRow scrRows selectedEmails'
+        }
+  put $ st { mode = IndexMode, indexState = indexState' }
+
+  where
+    toEmail fp = do
+      handle <- openFile fp ReadMode
+      msg <- UTF8.hGetContents handle
+      let value = parseMIMEMessage msg
+      let headers = mime_val_headers value
+      let date = maybe startOfTime id $ parseDateTime rfc822DateFormat $ takeWhile (/= '(') $ lookupField "date" headers
+      return (Email value date fp handle)
+
+freeOldHandlers st = mapM (hClose . emailHandle) $ selectedEmails . indexState $ st
+
+{- Boilerplate code -}
+incSelectedRow IndexMode = do
+  st <- get
+  let inSt = indexState st
+  let selRow = selectedRowIn inSt
+  let topScrollRow = scrollRowIn inSt
+  let startScrolling = (div (screenRows st) 4) * 3
+  let totalRows = currentInLen inSt
+
+  if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st)))
+     then do -- Scroll emails
+       let scrollRowIn'    = scrollRowIn inSt + 1
+       let scrollBufferIn' = formatIndexModeRows st $ scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
+       let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
+       put st { indexState = inSt' }
+     else -- Move the selected row
+       put $ incrementSelectedRow st
+
+incSelectedRow MaildirMode = do
+  st <- get
+  let mdSt = maildirState st
+  let selRow = selectedRowMD mdSt
+  let topScrollRow = scrollRowMD mdSt
+  let startScrolling = (div (screenRows st) 4) * 3
+  let totalRows = length $ detectedMDs mdSt
+
+  if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st)))
+     then do -- Scroll emails
+       let scrollRowMD'    = topScrollRow + 1
+       let scrollBufferMD' = scrollCrop scrollRowMD' (screenRows st) $ detectedMDs mdSt
+       let mdSt'           = mdSt { scrollRowMD = scrollRowMD', scrollBufferMD = scrollBufferMD' }
+       put st { maildirState = mdSt' }
+     else -- Move the selected row
+       put $ incrementSelectedRow st
+
+{- Down-scrolling in Email mode -}
+incSelectedRow EmailMode = do
+  st <- get
+  let est = emailState st
+  let cur = scrollRowEm est
+  let scrRows = screenRows st
+  let totalRows = length $ emailLines est
+  let est' = est { scrollRowEm = (cur + 1) }
+
+  when ((totalRows - scrRows + (bodyStartRow est) - 1) > (scrollRowEm est)) $
+    put $ st { emailState = est' }
+
+incSelectedRow _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
+
+{- More boilerplate code -}
+decSelectedRow IndexMode = do
+  st <- get
+  let inSt = indexState st
+  let selRow = selectedRowIn inSt
+  let startScrolling = (div (screenRows st) 4)
+  let topScrollRow = scrollRowIn inSt
+  if topScrollRow > 0 && selRow < startScrolling
+     then do
+       let scrollRowIn'    = scrollRowIn inSt - 1
+       let scrollBufferIn' = formatIndexModeRows st $ scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
+       let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
+       put st { indexState = inSt' }
+      else
+        put $ decrementSelectedRow st
+
+decSelectedRow MaildirMode = do
+  st <- get
+  let mdSt = maildirState st
+  let selRow = selectedRowMD mdSt
+  let startScrolling = (div (screenRows st) 4)
+  let topScrollRow = scrollRowMD mdSt
+  if topScrollRow > 0 && selRow < startScrolling
+     then do
+       let scrollRowMD'    = scrollRowMD mdSt - 1
+       let scrollBufferMD' = scrollCrop scrollRowMD' (screenRows st) $ detectedMDs mdSt
+       let mdSt'           = mdSt { scrollRowMD = scrollRowMD', scrollBufferMD = scrollBufferMD' }
+       put st { maildirState = mdSt' }
+      else
+        put $ decrementSelectedRow st
+
+decSelectedRow EmailMode = do
+  st <- get
+  let est = emailState st
+  let cur = scrollRowEm est
+  let scrRows = screenRows st
+  let totalRows = length $ emailLines est
+  let est' = est { scrollRowEm = (cur - 1) }
+
+  when (cur > 0) $
+    put $ st { emailState = est' }
+
+decSelectedRow _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
+
+{- Given a list, it returns the elements that will be in the next screen refresh
+ - TODO: find a better name -}
+scrollCrop top rows xs = take rows $ drop top xs
+
+formatIndexModeRows :: LazymailState -> [Email] -> [(FilePath, String)]
+formatIndexModeRows st = map formatRow where
+  formatRow e = 
+    let fp = emailPath e
+        email = emailValue e
+        hs = mime_val_headers email
+        str = normalizeLen (screenColumns st) $ intercalate ppSep $
+              [ "[" ++ normalizeLen maxFlags (ppFlags . getFlags $ fp) ++ "]"
+              , formatDateTime "%b %d" $ emailDate e
+              , normalizeLen fromLen $ ppField $ lookupField "from" hs
+              , ppField $ lookupField "subject" hs
+              ]
+    in (fp, str)
+
+formatMaildirModeRows st = mapM formatRow where
+  formatRow fp = return $ (fp, (concat $ replicate (numPads - 1) pad) ++ name) where
+    bp      = basePath st
+    str     = case (stripPrefix bp fp) of
+                Nothing  -> fp
+                Just s    -> s
+    name'   = takeFileName . dropTrailingPathSeparator $ str
+    name    = takeFileName $ map (\x -> if x `elem` imapSep then '/' else x) name'
+    pad     = "  "
+    numPads = (length $ filter (== '/') str) + (length $ filter (`elem` imapSep) str)
+    imapSep = ['.'] -- IMAP usually separates its directories with dots
+
+triggerIndexUpdate :: LazymailCurses ()
+triggerIndexUpdate = do
+  st <- get
+  let ist = indexState st
+  put $ st { indexState = (ist { triggerUpdateIn = True }) }
+  
+solveIndexUpdate :: LazymailCurses ()
+solveIndexUpdate = do
+  st <- get
+  let ist = indexState st
+  put $ st { indexState = (ist { triggerUpdateIn = False }) }  
+  
+triggerMaildirUpdate :: LazymailCurses ()
+triggerMaildirUpdate = do
+  st <- get
+  let mst = maildirState st
+  put $ st { maildirState = (mst { triggerUpdateMD = True }) }
+  
+solveMaildirUpdate :: LazymailCurses ()
+solveMaildirUpdate = do
+  st <- get
+  let mst = maildirState st
+  put $ st { maildirState = (mst { triggerUpdateMD = False }) }
+
diff --git a/src/Lazymail/Keymap.hs b/src/Lazymail/Keymap.hs
new file mode 100644
index 0000000..1cef1b1
--- /dev/null
+++ b/src/Lazymail/Keymap.hs
@@ -0,0 +1,16 @@
+module Lazymail.Keymap
+       ( defaultGlobalKeymap
+       , defaultMaildirKeymap
+       , defaultIndexKeymap
+       , defaultEmailKeymap
+       , defaultComposeKeymap
+       ) where
+
+import UI.NCurses(Event(..))
+import Lazymail.Types(LazymailCurses)
+
+defaultGlobalKeymap = []
+defaultMaildirKeymap = []
+defaultIndexKeymap = []
+defaultEmailKeymap = []
+defaultComposeKeymap = []
\ No newline at end of file
diff --git a/src/Lazymail/Maildir.hs b/src/Lazymail/Maildir.hs
new file mode 100644
index 0000000..1793105
--- /dev/null
+++ b/src/Lazymail/Maildir.hs
@@ -0,0 +1,142 @@
+{- Utilities for working with Maildir format.
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -
+ -}
+
+module Lazymail.Maildir  where
+
+import Control.Monad.Loops(allM)
+import Control.Monad (forM, filterM)
+import Data.List(isPrefixOf)
+import System.Directory (doesDirectoryExist, getDirectoryContents, renameFile)
+import System.FilePath ((</>), takeFileName, takeDirectory, splitDirectories, joinPath)
+import System.IO(IOMode(..), hGetContents, openFile)
+
+import Lazymail.Types(Maildir, Flag(..), Flags)
+
+isMaildir :: FilePath -> IO Bool
+isMaildir fp = allM doesDirectoryExist [ fp
+                                       , fp </> "cur"
+                                       , fp </> "new"
+                                       , fp </> "tmp"]
+
+getMaildirEmails md = do
+  r <- (getReadEmails md)
+  n <- (getNewEmails md)
+  return $ r ++ n
+
+getReadEmails md = getEmails $ md </> "cur"
+getNewEmails  md = getEmails $ md </> "new"
+
+getEmails fp = do
+  contents <- getDirectoryContents fp
+  return $  map (fp </>) $ filter (`notElem` [".", ".."]) contents
+
+{- | 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
+  
+{- Given a mail in a Maildir, mark it as read -}
+markAsRead :: FilePath -> IO FilePath
+markAsRead fp =
+  case newPath of
+    Nothing -> return fp
+    Just path -> do
+      renameFile fp path
+      return path
+  where newPath = 
+          if not $ isNew fp
+          then Just fp
+          else do
+            let fil = takeFileName fp
+            let dir = takeDirectory fp
+            let spl = splitDirectories dir
+            case last spl of
+              "cur" -> Just $ fp ++ "S"
+              "new" -> Just $ (joinPath . init $ spl) </> ("cur" </> (fil ++ "S"))
+              _     -> Nothing
+
+
+-- 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)
+
+
+{- The following code is an implementation of the Mailbox interface -}
+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 = addNew $ map toFlag $ strip fp
+  where strip x
+          | null x               = []
+          | ":2," `isPrefixOf` x = drop 3 x
+          | otherwise            = let (discard, analyze) = span (/= ':') fp
+                                   in strip analyze
+        addNew flags = if elem SEEN flags then flags else (NEW:flags)
+
+isNew :: FilePath -> Bool
+isNew fp = elem NEW $ getFlags fp
+
+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
diff --git a/src/Lazymail/Print.hs b/src/Lazymail/Print.hs
new file mode 100644
index 0000000..15e9df1
--- /dev/null
+++ b/src/Lazymail/Print.hs
@@ -0,0 +1,80 @@
+{- Printing utilities.
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -
+ -}
+
+module Lazymail.Print where
+
+import Data.Char (isSpace)
+import Data.List (intercalate)
+
+import Lazymail.Email
+import Codec.Text.Rfc1342
+import Lazymail.Types(Flag(..), Flags)
+
+unquote xs= if (head xs == '"' && last xs == '"') then (tail . init) xs else xs
+
+ppField = flat . decodeField
+
+{- Pretty print a RFC822 date format -}
+
+
+fromLen :: Int
+fromLen = 20
+
+maxFlags :: Int
+maxFlags = 4
+
+flat xs = intercalate " " $ map (dropWhile isSpace) $ map (filter (/= '\r')) $ lines xs
+
+ppFlags :: Flags -> String
+ppFlags = map ppFlag
+
+ppFlag :: Flag -> Char
+ppFlag NEW       = 'N'
+ppFlag SEEN      = 'S'
+ppFlag ANSWERED  = 'A'
+ppFlag FLAGGED   = 'F'
+ppFlag DRAFT     = 'D'
+ppFlag FORWARDED = 'P'
+ppFlag DELETED   = 'T'
+ppFlag (OTHERFLAG [c]) = c
+
+ppSep = "  "
+
+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/src/Lazymail/Screen.hs b/src/Lazymail/Screen.hs
new file mode 100644
index 0000000..699f84e
--- /dev/null
+++ b/src/Lazymail/Screen.hs
@@ -0,0 +1,268 @@
+{- Lazymail interaction with curses.
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -
+ - This code is in an urgent need of a big refactoring.
+ -}
+
+module Lazymail.Screen where
+
+import Codec.MIME.Type(MIMEValue(..))
+import Control.Monad.Trans(liftIO)
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Char(toUpper)
+import Data.List(isPrefixOf)
+import System.Exit
+import UI.NCurses
+
+-- Local imports
+import Lazymail.Config
+import qualified Lazymail.Handlers as EH
+import Lazymail.Maildir
+import Lazymail.Email(lookupField, getBody, getHeaders, lookupField')
+import Lazymail.Print
+import Codec.Text.Rfc1342
+import Lazymail.State
+import Lazymail.Types
+
+{- This function is the nexus between Curses and IO -}
+entryPoint :: Lazymail ()
+entryPoint = do
+  st <- get
+  cfg <- ask
+  maildirs <- liftIO $ do
+    mds <- getMaildirsRecursively $ basePath st
+    (filterMaildirsHook cfg) mds
+  formattedMDs <- EH.formatMaildirModeRows st maildirs
+  let mdState = (maildirState st) { detectedMDs = formattedMDs }
+  liftIO $ runCurses $ runStateT (runReaderT startCurses cfg) (st { maildirState = mdState })
+  return ()
+
+{- Initial point of screen related functions. Get the number of rows,
+ - colors, and start drawing the modes -}
+startCurses :: LazymailCurses ()
+startCurses = do
+  st <- get
+  cfg <- ask
+  (=<<) put $ liftCurses $ do
+    setEcho False
+    setCursorMode CursorInvisible
+    w <- defaultWindow
+    (rows, cols) <- 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
+    heaColID <- newColorID (fst . headerColor $ cfg) (snd . headerColor $ cfg) 4
+    newColID <- newColorID (fst . newEmailColor $ cfg) (snd . newEmailColor $ cfg) 5
+    let style = ColorStyle basColID selColID staColID heaColID newColID
+    return $ st { screenRows = fromIntegral $ rows - 1
+                , screenColumns = fromIntegral $ cols
+                , colorStyle = style }
+  resetScrollBuffer
+  screenLoop
+
+{- This function will loop til the user decides to leave -}
+screenLoop :: LazymailCurses ()
+screenLoop = do
+  w <- liftCurses $ defaultWindow
+  cfg <- ask
+  get >>=  \st ->
+    (liftCurses . (updateWindow w) $ runStateT (runReaderT performUpdate cfg) st) >>= put . snd
+  liftCurses $ render
+  handleEvent
+  get >>= \st -> if (not . exitRequested) st
+                 then screenLoop
+                 else return ()
+
+{- Perform the screen update, by cleaning it first. -}
+performUpdate :: LazymailUpdate LazymailState
+performUpdate = do
+  st <- get
+  liftUpdate $ clearMain (scrRowsAsInteger st) (screenColumns st)
+  drawMode (mode st)
+  drawStatus
+  get
+
+{- Pattern match on the received mode and draw it in the screen. -}
+drawMode :: Mode -> LazymailUpdate ()
+drawMode MaildirMode = get >>= \st -> drawSelectionList $ scrollBufferMD . maildirState $ st
+drawMode IndexMode   = get >>= \st -> drawSelectionList $ scrollBufferIn . indexState $ st
+drawMode EmailMode   = drawEmailHelper
+
+{- Draw a scrollable selection list -}
+drawSelectionList [] = resetCurrentRow
+drawSelectionList ((path, str):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) str
+        setColor $ baseColorID . colorStyle $ st
+        case (mode st) of
+          MaildirMode -> do
+            let mst = (maildirState st) { selectedMD = path }
+            return $ st { maildirState = mst }
+          IndexMode   -> do
+            let ist = (indexState st) { selectedEmailPath = path }
+            return $ st { indexState = ist }
+      else do
+        drawSimpleRow st path str
+        return st
+
+  st <- get
+  let limit = if statusBar st then (screenRows st) - 1 else screenRows st
+  if currentRow st < limit
+    then do
+      incrementCurrentRow
+      drawSelectionList mds
+    else
+      resetCurrentRow
+
+drawSimpleRow st path str | (mode st) == MaildirMode = drawString $ normalizeLen (screenColumns st) str
+                          | (mode st) == IndexMode   =
+  if isNew path
+  then do
+    setColor $ newEmailColorID . colorStyle $ st
+    drawCroppedString st str
+    setColor $ baseColorID . colorStyle $ st
+  else
+    drawCroppedString st str
+
+{- Empty the whole window. Useful when changing modes. -}
+clearMain rows columns = do
+  drawEmptyLine 0
+  moveCursor 0 0
+  where
+    drawEmptyLine currentRow = do
+      moveCursor currentRow 0
+      drawString $ replicate (columns) ' '
+      when (currentRow < rows - 1) $ drawEmptyLine $ currentRow + 1
+
+{- Helper function of drawMode -}
+drawEmailHelper = do
+  drawEmailHeaders
+
+  st <- get
+  let est = emailState st
+  put $ st { emailState = est { bodyStartRow = (currentRow st ) } }
+  let body = getBody $ currentEmail . emailState $ st
+  let maxRows = if statusBar st then (scrRowsAsInteger st) - 1 else scrRowsAsInteger st
+  liftUpdate $
+    drawBody (curRowAsInteger st) (colPadAsInteger st) maxRows $
+      drop (scrollRowEm est) $ emailLines est
+  resetCurrentRow
+
+{- Draw the email headers -}
+drawEmailHeaders = do
+  st <- get
+  cfg <- ask
+  let hs = getHeaders $ currentEmail . emailState $ st
+  let parsedHeaders = parseHeaders hs 0 $ headersToShow cfg
+
+  liftUpdate $ do
+    setColor $ headerColorID . colorStyle $ st
+    drawHeaders st (curRowAsInteger st) parsedHeaders
+    setColor $ baseColorID . colorStyle $ st
+  put $ st { currentRow = 1 + (length parsedHeaders) + (currentRow st) }
+
+  where
+    parseHeaders _ _ [] = []
+    parseHeaders headers row (h:hs)= do
+      let field = lookupField' h headers
+      case field of
+        Nothing -> parseHeaders headers row hs
+        Just f -> let p = capitalize h ++ ": " ++ (ppField f)
+                  in p:parseHeaders headers (row + 1) hs
+
+    capitalize str = (toUpper . head $ str):(tail str)
+    drawHeaders _ _ []      = return ()
+    drawHeaders st row (h:hs) = do
+      moveCursor row (colPadAsInteger st)
+      drawCroppedString st h
+      drawHeaders st (row + 1) hs
+
+{- Draw the email body -}
+drawBody _ _ _ [] = return ()
+drawBody row col maxRows (xs:xss) = do
+  moveCursor row col
+  drawString xs
+  when (row <  maxRows) $ drawBody (row + 1) col maxRows  xss
+
+{- Draw a status line with the current mode and other stuff -}
+drawStatus  = do
+  st <- get
+  liftUpdate $ do
+    moveCursor (scrRowsAsInteger st) 0
+    setColor $ statusBarColorID . colorStyle $ st
+    drawString $ normalizeLen (screenColumns st - 1)$ concat $ drawStatusHelper (mode st) st -- Can't write in the last char - ncurses bug
+    setColor $ baseColorID . colorStyle $ st
+
+{- Status bar string for Maildir mode -}
+drawStatusHelper MaildirMode st =
+  ["Maildir listing - "
+  , "(", show ((selectedRow st) + (scrollRowMD . maildirState $ st) + 1), "/"
+  ,  show (length $ detectedMDs . maildirState $ st), ")"]
+
+{- Status bar string for Index mode -}
+drawStatusHelper IndexMode st =
+  ["mode: Index - "
+  , "(", show ((selectedRow st) + (scrollRowIn . indexState $ st) + 1), "/"
+  ,  show (currentInLen . indexState $ st), ")"]
+
+{- Status bar string for Email mode -}
+drawStatusHelper EmailMode st = ["mode: Email"]
+
+{- Handle an event
+ - TODO: Handle the events in a cleaner way. -}
+handleEvent :: LazymailCurses ()
+handleEvent = loop where
+  loop = do
+    w <- liftCurses $ defaultWindow
+    ev <- liftCurses $ getEvent w Nothing
+    st <- get
+    case ev of
+      Nothing  -> loop
+      Just ev' ->
+        case ev' of
+          EventCharacter 'q'            -> EH.previousMode (mode st)
+
+          EventSpecialKey KeyUpArrow    -> EH.decSelectedRow (mode st)
+          EventCharacter 'k'            -> EH.decSelectedRow (mode st)
+
+          EventSpecialKey KeyDownArrow  -> EH.incSelectedRow (mode st)
+          EventCharacter 'j'            -> EH.incSelectedRow (mode st)
+
+          EventCharacter '\n'           -> EH.changeMode (mode st)
+          EventSpecialKey KeyRightArrow -> EH.changeMode (mode st)
+
+          _ ->  loop
+
+{- Reset the current row to the beginning -}
+resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
+
+{- Advance the current row. Useful when drawing modes -}
+incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (currentRow st) + 1 }
+
+{- Put the scroll at the top -}
+resetScrollBuffer = do
+  st <- get
+  case (mode st) of
+    MaildirMode -> do
+      let mst = (maildirState st) {
+            scrollBufferMD = EH.scrollCrop 0 (screenRows st) $ detectedMDs . maildirState $ st }
+      put st { maildirState = mst}
+    IndexMode -> do
+      let ist = (indexState st) {
+            scrollBufferIn = EH.formatIndexModeRows st $  EH.scrollCrop 0 (screenRows st) $ selectedEmails . indexState $ st }
+      put st { indexState = ist }
+
+drawCroppedString st str = drawString $ normalizeLen (screenColumns st) str
+
+-- The type system complains if I want to use the same function for diferents monads
+liftCurses = lift . lift
+liftUpdate  = lift . lift
diff --git a/src/Lazymail/State.hs b/src/Lazymail/State.hs
new file mode 100644
index 0000000..06353da
--- /dev/null
+++ b/src/Lazymail/State.hs
@@ -0,0 +1,126 @@
+{- Lazymail state, and operations on it.
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -
+ -}
+
+module Lazymail.State where
+
+import Codec.MIME.Type(MIMEValue, nullMIMEValue)
+import Text.ParserCombinators.Parsec.Rfc2822(Message, GenericMessage(..))
+import UI.NCurses(ColorID(..), defaultColorID)
+import Network.Email.Mailbox(Flag(..), Flags)
+import System.FilePath
+
+import Lazymail.Types
+
+initialState = LazymailState {
+    mode          = MaildirMode
+  , basePath      = ""
+  , screenRows    = 0
+  , screenColumns = 0
+  , currentRow    = 0
+  , columnPadding = 0
+  , exitRequested = False
+  , statusBar     = True
+  , maildirState  = initialMaildirState
+  , indexState    = initialIndexState
+  , composeState  = initialComposeState
+  , emailState    = initialEmailState
+  , colorStyle    = initialColorStyle
+}
+
+initialMaildirState = MaildirState {
+    selectedRowMD   = 0
+  , selectedMD      = ""
+  , detectedMDs     = []
+  , scrollRowMD     = 0
+  , scrollBufferMD  = []
+  , triggerUpdateMD = False
+}
+
+initialIndexState = IndexState {
+    selectedRowIn      = 0
+  , selectedEmailPath  = ""
+  , selectedEmails     = []
+  , scrollRowIn        = 0
+  , currentInLen       = 0
+  , scrollBufferIn     = []
+  , triggerUpdateIn    = False
+}
+
+initialEmailState = EmailState {
+    scrollRowEm    = 0
+  , bodyStartRow  = 0
+  , emailLines     = []
+  , currentEmail   = nullMIMEValue
+}
+
+initialComposeState = ComposeState {
+    composition = Nothing
+}
+
+initialColorStyle = ColorStyle {
+    baseColorID      = defaultColorID
+  , selectionColorID = defaultColorID
+  , statusBarColorID = defaultColorID
+  , headerColorID    = defaultColorID
+  , newEmailColorID  = defaultColorID
+}
+
+scrColsAsInteger st = toInteger $ screenColumns st
+scrRowsAsInteger st = toInteger $ screenRows st
+curRowAsInteger  st = toInteger $ currentRow st
+colPadAsInteger  st = toInteger $ columnPadding 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' }
+    _ -> st
+                        | otherwise = st
+  where
+    scrRows = screenRows st
+    curInLen = length $ selectedEmails . indexState $ st
+    curMDLen = length $ detectedMDs . maildirState $ st
+    limit' = case (mode st) of
+      MaildirMode -> if curMDLen < scrRows then curMDLen - 1 else scrRows
+      IndexMode   -> if curInLen < scrRows then curInLen - 1 else scrRows
+    limit = if (statusBar st) && (limit' == scrRows)
+            then fromIntegral $ limit' - 2
+            else fromIntegral limit'
+
+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' }
+    _ -> st
+                        | otherwise = st
+
+selectedRow st = case (mode st) of
+      MaildirMode -> selectedRowMD . maildirState $ st
+      IndexMode   -> selectedRowIn . indexState   $ st
+
diff --git a/src/Lazymail/Types.hs b/src/Lazymail/Types.hs
new file mode 100644
index 0000000..fb30f91
--- /dev/null
+++ b/src/Lazymail/Types.hs
@@ -0,0 +1,128 @@
+{- Common types of Lazymail
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -}
+
+module Lazymail.Types where
+
+import Codec.MIME.Type(MIMEValue(..))
+import Control.Monad.Reader(ReaderT)
+import Control.Monad.State(StateT)
+import Data.DateTime(DateTime)
+import System.FilePath(FilePath)
+import System.IO(Handle)
+import UI.NCurses(Curses, Update, Color(..), ColorID, Event(..))
+
+type LazymailUpdate = ReaderT LazymailConfig (StateT LazymailState Update)
+type LazymailCurses = ReaderT LazymailConfig (StateT LazymailState Curses)
+
+{- Lazymail monad is a ReaderT around a StateT with IO at the bottom of the
+ - stack.
+ -}
+type Lazymail = ReaderT LazymailConfig (StateT LazymailState IO)
+
+data LazymailConfig = LazymailConfig {
+    baseColor          :: (Color, Color) -- (foreground, background)
+  , selectionColor     :: (Color, Color)
+  , statusBarColor     :: (Color, Color)
+  , headerColor        :: (Color, Color)
+  , newEmailColor      :: (Color, Color)
+  , showStatusBar      :: Bool
+  , initialPath        :: FilePath
+  , filterMaildirsHook :: [FilePath] -> IO [FilePath]
+  , indexDateFormat    :: String
+  , headersToShow      :: [String]
+  , globalKeymaps      :: [Keymap]
+  , maildirModeKeymap  :: [Keymap]
+  , indexModeKeymap    :: [Keymap]
+  , emailModeKeymap    :: [Keymap]
+  , composeModeKeymap  :: [Keymap]
+}
+
+data Email = Email {
+    emailValue  :: MIMEValue
+  , emailDate   :: DateTime
+  , emailPath   :: FilePath
+  , emailHandle :: Handle
+}
+
+instance Eq Email where
+  (Email _ _ fp1 _) == (Email _ _ fp2 _) = fp1 == fp2
+
+instance Ord Email where
+  (Email _ d1 _ _) `compare` (Email _ d2 _ _) = d1 `compare` d2
+
+data Mode = MaildirMode | IndexMode | EmailMode | ComposeMode
+                                                  deriving (Show, Eq)
+
+type Maildir = FilePath
+
+data Flag = NEW
+          | SEEN
+          | ANSWERED
+          | FLAGGED
+          | DELETED
+          | DRAFT
+          | FORWARDED
+          | OTHERFLAG String
+            deriving (Eq)
+
+type Flags = [Flag]
+
+data LazymailState = LazymailState {
+    mode            :: Mode
+  , basePath        :: FilePath
+  , screenRows      :: Int
+  , screenColumns   :: Int
+  , currentRow      :: Int
+  , columnPadding   :: Int
+  , exitRequested   :: Bool
+  , statusBar       :: Bool
+  , maildirState    :: MaildirState
+  , indexState      :: IndexState
+  , emailState      :: EmailState
+  , composeState    :: ComposeState
+  , colorStyle      :: ColorStyle
+}
+
+data MaildirState = MaildirState {
+    selectedRowMD   :: Int
+  , selectedMD      :: String
+  , detectedMDs     :: [(FilePath, String)]
+  , scrollRowMD     :: Int
+  , scrollBufferMD  :: [(FilePath, String)]
+  , triggerUpdateMD :: Bool 
+}
+
+data IndexState = IndexState {
+    selectedRowIn     :: Int
+  , selectedEmailPath :: FilePath
+  , selectedEmails    :: [Email]
+  , scrollRowIn       :: Int
+  , currentInLen      :: Int
+  , scrollBufferIn    :: [(FilePath, String)]
+  , triggerUpdateIn   :: Bool
+}
+
+data ComposeState = ComposeState {
+    composition     :: Maybe String
+}
+
+data EmailState = EmailState {
+    scrollRowEm    :: Int
+  , bodyStartRow   :: Int
+  , emailLines     :: [String]
+  , currentEmail   :: MIMEValue
+}
+
+data ColorStyle = ColorStyle {
+    baseColorID      :: ColorID
+  , selectionColorID :: ColorID
+  , statusBarColorID :: ColorID
+  , headerColorID    :: ColorID
+  , newEmailColorID  :: ColorID
+}
+
+type Keymap = ([Event], LazymailCurses ())
\ No newline at end of file