towards lazy reading (broken)

1 files changed, 28 insertions, 66 deletions

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