Finished porting to state monad

1 files changed, 95 insertions, 84 deletions

diff --git a/Screen.hs b/Screen.hs
index c7969ac..df426fd 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -14,6 +14,7 @@ import Control.Monad.State
 import Data.List(isPrefixOf)
 import UI.NCurses as UI
 import Text.ParserCombinators.Parsec.Rfc2822(Message(..))
+import System.Exit
 
 -- Local imports
 import Config
@@ -49,9 +50,9 @@ startCurses = do
     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
-    let style = ColorStyle basColID selColID staColID
-    return $ st { screenRows = fromIntegral rows
-                , screenColumns = fromIntegral cols
+    let style = ColorStyle defaultColorID selColID staColID
+    return $ st { screenRows = fromIntegral $ rows - 1
+                , screenColumns = fromIntegral $ cols
                 , colorStyle = style }
   screenLoop
 
@@ -61,7 +62,8 @@ screenLoop = do
   w <- liftCurses $ defaultWindow
   st <- get
   cfg <- ask
-  liftCurses $ updateWindow w $ do runStateT (runReaderT performUpdate cfg) st
+  (_, st') <- liftCurses $ updateWindow w $ runStateT (runReaderT performUpdate cfg) st
+  put st'
   liftCurses $ render
   handleEvent
   st <- get
@@ -69,109 +71,114 @@ screenLoop = do
     then screenLoop
     else return ()
 
-performUpdate :: LazymailUpdate ()
+--performUpdate :: LazymailUpdate ()
 performUpdate = do
   st <- get
   liftUpdate $ clearMain (scrRowsAsInteger st) (screenColumns st)
   drawMode (mode st)
   drawStatus
+  get >>= return
 
--- | Pattern match on the received mode and draw it in the screen.
+{- Pattern match on the received mode and draw it in the screen. -}
 drawMode :: Mode -> LazymailUpdate ()
-drawMode MaildirMode = do
-  st <- get
-  let mdState = maildirState st
-  drawMaildirHelper $ detectedMDs mdState
---drawMode EmailMode   = drawEmailHelper
---drawMode IndexMode   = drawIndexHelper (selectedEmails st)
+drawMode MaildirMode = get >>= \st -> drawMaildirHelper $ detectedMDs . maildirState $ st
+drawMode IndexMode   = get >>= \st -> drawIndexHelper $ selectedEmails . indexState $  st
+drawMode EmailMode   = drawEmailHelper
 
--- | Helper function of drawMode
+{- Helper function of drawMode -}
 drawMaildirHelper :: [FilePath] -> LazymailUpdate ()
 drawMaildirHelper [] = resetCurrentRow
 drawMaildirHelper (md:mds) = do
   st <- get
-  (=<<) put $ liftUpdate $ do
-    moveCursor (curRowAsInteger st) (colPadAsInteger st)
-    if (selectedRow st == currentRow st)
+  liftUpdate $  moveCursor (curRowAsInteger st) (colPadAsInteger st)
+  if (selectedRow st == currentRow st)
     then do
-      setColor $ selectionColorID . colorStyle $ st
-      drawString $ normalizeLen (screenColumns st) md
-      setColor $ baseColorID . colorStyle $ st
-      let mdState = (maildirState st) { selectedMD = md }
-      return $ st { maildirState = mdState }
-    else do
-      drawString $ normalizeLen (screenColumns st) md
-      return st
+      liftUpdate $ do
+        setColor $ selectionColorID . colorStyle $ st
+        drawString $ normalizeLen (screenColumns st) md
+        setColor $ baseColorID . colorStyle $ st
+      let maildirState' = (maildirState st) { selectedMD = md }
+      put $ st { maildirState = maildirState' }
+    else liftUpdate $ drawString $ normalizeLen (screenColumns st) md
 
   st <- get
   let limit = if statusBar st then (screenRows st) - 1 else screenRows st
   if currentRow st < limit
     then do
-      put st { currentRow = (currentRow st) + 1 }
+      incrementCurrentRow
       drawMaildirHelper mds
     else
       resetCurrentRow
 
--- | Empty the whole window. Useful when changing modes.
+{- 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)
+      drawString $ replicate (columns) ' '
+      if currentRow < rows - 1
          then drawEmptyLine $ currentRow + 1
          else return ()
 
-{-
+
 -- | Helper function of drawMode
-drawIndexHelper st [] = return $ st { curRow = 0 } --moveCursor 0 0 >> return st 
-drawIndexHelper st ((fp, _, msg):ts) = do
-  moveCursor (curRow st) (colPadding st)
-  let email = parseEmail msg
-  let fs = getFields email
-  let str = normalizeLen (scrColsAsInt st) . concat $
-            [ show $ (curRow st) + 1
-            , (ppSep ++) $ ppFlags . getFlags $ fp
-            , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs    
-            , (ppSep ++) $ ppIndexSubject . getSubject $ fs
-            ]
-  st' <- if (selectedRow st == curRow st)
-         then do
-           setColor $ selectedColorID st
-           drawString str
-           setColor defaultColorID
-           return $ st { selectedEmail = email } 
-         else do
-           drawString str
-           return st
-  if curRow st' < ((scrRows st') - 1)
-    then drawIndexHelper (incCurRow st') ts
-    else return $ st' { curRow = 0 }
-  
+drawIndexHelper [] = resetCurrentRow
+drawIndexHelper ((fp, _, msg):ts) = do
+  st <- get
+  (=<<) put $ liftUpdate $ do
+    moveCursor (curRowAsInteger st) (colPadAsInteger st)
+    let email = parseEmail msg
+    let fs = getFields email
+    let str = normalizeLen (screenColumns st) . concat $
+              [ show $ (currentRow st) + 1
+              , (ppSep ++) $ ppFlags . getFlags $ fp
+              , (ppSep ++) $ ppIndexNameAddr . getFrom $ fs
+              , (ppSep ++) $ ppIndexSubject . getSubject $ fs
+              ]
+    if (selectedRow st == currentRow st)
+      then do
+        setColor $ selectionColorID . colorStyle $ st
+        drawString str
+        setColor $ baseColorID . colorStyle $ st
+        let indexState' = (indexState st) { selectedEmail = email}
+        return $ st { indexState = indexState' }
+      else do
+        drawString str
+        return st
+
+  st <- get
+  let limit = if statusBar st then (screenRows st) - 1 else screenRows st
+  if currentRow st < limit
+     then do
+       incrementCurrentRow
+       drawIndexHelper ts
+     else resetCurrentRow
+
 -- | Helper function of drawMode
---   TODO: Make helpers functions to draw header and body in a separate way.  
-drawEmailHelper st = do
-  let fs = getFields $ selectedEmail st
-  let cropWith xs = normalizeLen $ (scrColsAsInt 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 (scrColsAsInt st)
-  return st
-  where drawBody _ _ [] = return ()
-        drawBody row col (xs:xss) = do
+--   TODO: Make helpers functions to draw header and body in a separate way.
+drawEmailHelper = do
+  st <- get
+  let fs = getFields $ selectedEmail . indexState $ st
+  let cropWith xs = normalizeLen $ (screenColumns st) - (length xs)
+  let row = curRowAsInteger st
+  liftUpdate $ do
+    moveCursor row (colPadAsInteger st)
+    drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs
+    moveCursor (row + 1) (colPadAsInteger st)
+    drawString $ ("To: " ++) $ cropWith "To: " . ppNameAddr . getTo $ fs
+    moveCursor (row + 2) (colPadAsInteger st)
+    drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs
+
+  let body = getBody $ selectedEmail . indexState $ st
+  liftUpdate $ drawBody (row + 4) (colPadAsInteger st) (scrRowsAsInteger st) $ formatBody body (screenColumns st)
+
+  where drawBody _ _ _ [] = return ()
+        drawBody row col maxRows (xs:xss) = do
           moveCursor row col
           drawString xs
-          if row < (scrRows st) then drawBody (row + 1) col xss else return ()
+          if row <  maxRows then drawBody (row + 1) col maxRows  xss else return ()
 
-  
 -- | Convert a String to multiple Strings, cropped by the maximum column
 --   size if necessary.
 formatBody :: String -> Int -> [String]
@@ -181,12 +188,12 @@ formatBody body maxColumns = format [] [] body where
   format parsed acc rest@(x:xs) | length acc < maxColumns = format parsed (acc ++ [x]) xs
                                 | otherwise               = format (parsed ++ [acc]) "+" rest
 
--}
+
 -- | Draw a status line with the current mode and other stuff
 drawStatus  = do
   st <- get
   liftUpdate $ do
-    moveCursor ((scrRowsAsInteger st) - 2) 0
+    moveCursor ((scrRowsAsInteger st) - 1) 0
     setColor $ statusBarColorID . colorStyle $ st
     drawString . normalizeLen (screenColumns st) . concat $ drawStatusHelper (mode st) st
     setColor $ baseColorID . colorStyle $ st
@@ -195,9 +202,9 @@ drawStatusHelper MaildirMode st = ["Maildir listing - "
                                   , "(", show ((+ 1) . selectedRow $ st), "/"
                                   ,  show (length $ detectedMDs . maildirState $ st), ")"]
 
-drawStatusHelper IndexMode st = ["mode: Index - "]
---                                , "(", show ((+ 1) . selectedRow $ st), "/"
---                                ,  show (length $ selectedEmails . indexState $ st), ")"]
+drawStatusHelper IndexMode st = ["mode: Index - "
+                                , "(", show ((+ 1) . selectedRow $ st), "/"
+                                ,  show (length $ selectedEmails . indexState $ st), ")"]
 
 drawStatusHelper EmailMode st = ["mode: Email"]
 
@@ -218,20 +225,24 @@ handleEvent = loop where
                         EmailMode   -> put $ st { mode = IndexMode }
                         MaildirMode -> put $ st { exitRequested = True }
 
-{-                  EventSpecialKey KeyUpArrow  -> put $ decSelectedRow st
-                    EventCharacter 'k'          -> put $ decSelectedRow st
+                    EventSpecialKey KeyUpArrow  -> put $ decrementSelectedRow st
+                    EventCharacter 'k'          -> put $ decrementSelectedRow st
 
-                    EventSpecialKey KeyDownArrow -> put $ incSelectedRow st
-                    EventCharacter 'j'           -> put $ incSelectedRow st
+                    EventSpecialKey KeyDownArrow -> put $ incrementSelectedRow st
+                    EventCharacter 'j'           -> put $ incrementSelectedRow st
 
                     EventSpecialKey KeyRightArrow -> do
                       case (mode st) of
                         IndexMode   -> put $ st { mode = EmailMode }
                         EmailMode   -> return ()
                         MaildirMode -> do
-                          selEmails <- liftIO $ getAll . selectedMD $ st
-                          return $ st { mode = IndexMode, selectedEmails = selEmails } -}
+                          selectedEmails' <- liftIO $ do
+                            let md = (selectedMD . maildirState) $ st
+                            getAll md
+                          let indexState' =  (indexState st) { selectedEmails = selectedEmails' }
+                          put $ st { mode = IndexMode, indexState = indexState' }
 
                     _ ->  loop
 
-resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
\ No newline at end of file
+resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
+incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (currentRow st) + 1 }