towards lazy reading (broken)

5 files changed, 155 insertions, 107 deletions

diff --git a/Handlers.hs b/Handlers.hs
new file mode 100644
index 0000000..566fca9
--- /dev/null
+++ b/Handlers.hs
@@ -0,0 +1,61 @@
+{- Event handlers for Lazymail
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -}
+
+module Handlers where
+
+import Control.Monad.State
+
+import Maildir
+import State
+import Types (LazymailCurses)
+
+previousMode :: Mode -> LazymailCurses ()
+previousMode IndexMode   = (=<<) put $ get >>= \st -> return st { mode = MaildirMode }
+previousMode EmailMode   = (=<<) put $ get >>= \st -> return st { mode = IndexMode }
+previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True }
+
+changeMode IndexMode   = (=<<) put $ get >>= \st -> return st { mode = EmailMode }
+changeMode EmailMode   = return ()
+changeMode MaildirMode =  do
+  st <- get
+  selectedEmails' <- liftIO $ do
+    let md = (selectedMD . maildirState) $ st
+    getMaildirEmails md
+  let indexState' = (indexState st) {
+          selectedEmails = selectedEmails'
+        , currentInLen   = length selectedEmails'
+        , scrollBufferIn = scrollCrop (scrollRowIn . indexState $ st) (screenRows st)  selectedEmails'
+        }
+  put $ st { mode = IndexMode, indexState = indexState' }
+
+incSelectedRow IndexMode = do
+  st <- get
+  let inSt = indexState st
+  if (selectedRowIn inSt) > (div (screenRows st) 2)
+     then do
+       let scrollRowIn'    = scrollRowIn inSt + 1
+       let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
+       let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
+       put st { indexState = inSt' }
+     else put $ incrementSelectedRow st
+incSelectedRow _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
+
+decSelectedRow IndexMode = do
+  st <- get
+  let inSt = indexState st
+  if (scrollRowIn inSt) > 0
+     then do
+       let scrollRowIn'    = scrollRowIn inSt - 1
+       let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
+       let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
+       put st { indexState = inSt' }
+     else put $ decrementSelectedRow st
+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
diff --git a/Maildir.hs b/Maildir.hs
index b60b300..f76695a 100644
--- a/Maildir.hs
+++ b/Maildir.hs
@@ -24,6 +24,48 @@ isMaildir fp = allM doesDirectoryExist [ fp
                                        , fp </> "new"
                                        , fp </> "tmp"]
 
+getMaildirEmails md = do
+  r <- (getReadEmails md)
+  n <- (getNewEmails md)
+  return $ r ++ n
+
+getReadEmails md = getDirectoryContents $ md </> "cur"
+getNewEmails  md = getDirectoryContents $ md </> "new"
+
+{- | 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)
+
+
+{- 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
@@ -72,42 +114,3 @@ getAll fp = do
   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
diff --git a/Screen.hs b/Screen.hs
index e5b97cf..42f8ac8 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -4,6 +4,7 @@
  -
  - Licensed under the GNU GPL version 3 or higher
  -
+ - This code is in an urgent need of a big refactoring.
  -}
 
 module Screen where
@@ -12,24 +13,21 @@ import Control.Monad.Trans(liftIO)
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.List(isPrefixOf)
-import UI.NCurses as UI
-import Text.ParserCombinators.Parsec.Rfc2822(Message(..))
 import System.Exit
+import System.IO(IOMode(..), hGetContents, openFile)
+import Text.ParserCombinators.Parsec.Rfc2822(Message(..))
+import UI.NCurses
 
 -- Local imports
 import Config
+import qualified Handlers as EH
 import Lazymail
 import Maildir
 import Email
 import Print
 import Rfc1342
 import State
-
-type LazymailUpdate = ReaderT LazymailConfig (StateT LazymailState Update)
-type LazymailCurses = ReaderT LazymailConfig (StateT LazymailState Curses)
-
-liftCurses = lift . lift
-liftUpdate  = lift . lift
+import Types(LazymailCurses, LazymailUpdate)
 
 entryPoint :: Lazymail ()
 entryPoint = do
@@ -47,8 +45,8 @@ startCurses = do
   st <- get
   cfg <- ask
   (=<<) put $ liftCurses $ do
-    UI.setEcho False
-    (rows, cols) <- UI.screenSize
+    setEcho False
+    (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
@@ -125,15 +123,16 @@ clearMain rows columns = do
 
 -- | Helper function of drawMode
 drawIndexHelper [] = resetCurrentRow
-drawIndexHelper ((fp, _, msg):ts) = do
+drawIndexHelper (m:ms) = do
   st <- get
   (=<<) put $ liftUpdate $ do
+    msg <- liftToUpdate $ hGetContents =<< (openFile m ReadMode)
     moveCursor (curRowAsInteger st) (colPadAsInteger st)
     let email = parseEmail msg
     let fs = getFields email
     let str = normalizeLen (screenColumns st) . concat $
               [ show $ (currentRow st) + (scrollRowIn . indexState $ st) + 1
-              , (ppSep ++) $ ppFlags . getFlags $ fp
+              , (ppSep ++) $ ppFlags . getFlags $ m
               , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs
               , (ppSep ++) $ ppIndexSubject . getSubject $ fs
               ]
@@ -153,7 +152,7 @@ drawIndexHelper ((fp, _, msg):ts) = do
   if currentRow st < limit
      then do
        incrementCurrentRow
-       drawIndexHelper ts
+       drawIndexHelper ms
      else resetCurrentRow
 
 -- | Helper function of drawMode
@@ -190,7 +189,7 @@ formatBody body maxColumns = format [] [] body where
                                 | otherwise               = format (parsed ++ [acc]) "+" rest
 
 
--- | Draw a status line with the current mode and other stuff
+{- Draw a status line with the current mode and other stuff -}
 drawStatus  = do
   st <- get
   liftUpdate $ do
@@ -219,63 +218,26 @@ handleEvent = loop where
     st <- get
     case ev of
       Nothing  -> loop
-      Just ev' -> case ev' of
-                    EventCharacter c | c == 'q' || c == 'Q' -> do
-                      case (mode st) of
-                        IndexMode   -> put $ st { mode = MaildirMode }
-                        EmailMode   -> put $ st { mode = IndexMode }
-                        MaildirMode -> put $ st { exitRequested = True }
-
-                    EventSpecialKey KeyUpArrow  -> decrementActions (mode st)
-                    EventCharacter 'k'          -> decrementActions (mode st)
-
-                    EventSpecialKey KeyDownArrow -> incrementActions (mode st)
-                    EventCharacter 'j'           -> incrementActions (mode st)
+      Just ev' ->
+        case ev' of
+          EventCharacter 'q'            -> EH.previousMode (mode st)
 
-                    EventSpecialKey KeyRightArrow -> do
-                      case (mode st) of
-                        IndexMode   -> put $ st { mode = EmailMode }
-                        EmailMode   -> return ()
-                        MaildirMode -> do
-                          selectedEmails' <- liftIO $ do
-                            let md = (selectedMD . maildirState) $ st
-                            getAll md
-                          let indexState' = (indexState st) { selectedEmails = selectedEmails'
-                                                            , currentInLen   = length selectedEmails'
-                                                            , scrollBufferIn = scrollCrop (scrollRowIn . indexState $ st) (screenRows st)  selectedEmails'
-                                                            }
-                          put $ st { mode = IndexMode, indexState = indexState' }
+          EventSpecialKey KeyUpArrow    -> EH.decSelectedRow (mode st)
+          EventCharacter 'k'            -> EH.decSelectedRow (mode st)
 
-                    _ ->  loop
+          EventSpecialKey KeyDownArrow  -> EH.incSelectedRow (mode st)
+          EventCharacter 'j'            -> EH.incSelectedRow (mode 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
+          EventSpecialKey KeyEnter      -> EH.changeMode (mode st)
+          EventSpecialKey KeyRightArrow -> EH.changeMode (mode st)
 
-incrementActions IndexMode = do
-  st <- get
-  let inSt = indexState st
-  if (selectedRowIn inSt) > (div (screenRows st) 2)
-     then do
-       let scrollRowIn'    = scrollRowIn inSt + 1
-       let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
-       let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
-       put st { indexState = inSt' }
-     else put $ incrementSelectedRow st
-incrementActions _ = (=<<) put $ get >>= \st -> return $ incrementSelectedRow st
-
-decrementActions IndexMode = do
-  st <- get
-  let inSt = indexState st
-  if (scrollRowIn inSt) > 0
-     then do
-       let scrollRowIn'    = scrollRowIn inSt - 1
-       let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
-       let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
-       put st { indexState = inSt' }
-     else put $ decrementSelectedRow st
-decrementActions _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
+          _ ->  loop
 
 resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
 incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (currentRow st) + 1 }
 
+liftCurses = lift . lift
+liftUpdate  = lift . lift
+
+liftToUpdate :: IO a -> Update a
+liftToUpdate io = Update $ lift (liftIO io)
\ No newline at end of file
diff --git a/State.hs b/State.hs
index a3fbef0..f9623dc 100644
--- a/State.hs
+++ b/State.hs
@@ -39,10 +39,10 @@ data MaildirState = MaildirState {
 data IndexState = IndexState {
     selectedRowIn   :: Int
   , selectedEmail   :: Message
-  , selectedEmails  :: [(String, [Flag], String)]
+  , selectedEmails  :: [FilePath]
   , scrollRowIn     :: Int
   , currentInLen    :: Int
-  , scrollBufferIn  :: [(String, [Flag], String)]
+  , scrollBufferIn  :: [FilePath]
 }
 
 data ComposeState = ComposeState {
diff --git a/Types.hs b/Types.hs
new file mode 100644
index 0000000..4fe658e
--- /dev/null
+++ b/Types.hs
@@ -0,0 +1,22 @@
+{- Common types of Lazymail
+ -
+ - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
+ -
+ - Licensed under the GNU GPL version 3 or higher
+ -}
+
+module Types
+       (
+         LazymailUpdate
+       , LazymailCurses
+       ) where
+
+import Control.Monad.Reader(ReaderT)
+import Control.Monad.State(StateT)
+import UI.NCurses(Curses, Update)
+
+import Config (LazymailConfig)
+import State (LazymailState)
+
+type LazymailUpdate = ReaderT LazymailConfig (StateT LazymailState Update)
+type LazymailCurses = ReaderT LazymailConfig (StateT LazymailState Curses)