Semi-functional core

1 files changed, 105 insertions, 52 deletions

diff --git a/Screen.hs b/Screen.hs
index 8d83ed7..df6ed92 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -17,6 +17,7 @@
 
 module Screen where
 
+import Control.Monad.Trans(liftIO)
 import Data.List(isPrefixOf)
 import UI.NCurses
 import Text.ParserCombinators.Parsec.Rfc2822(Message(..))
@@ -36,84 +37,86 @@ entryPoint st' = do
   runCurses $ do
     setEcho False
     (rows, columns) <- screenSize    
-    selColID <- newColorID ColorBlack ColorWhite 1    
+    selColID <- newColorID ColorBlack ColorWhite 1
+    staColID <- newColorID ColorWhite ColorGreen 2
     let st = st' {
             scrRows = rows  - 1
           , scrColumns = columns - 1
           , selectedColorID = selColID
+          , statusColorID   = staColID
           , detectedMDs = maildirs }
     screenLoop st
     
 -- | This functions will loop til the user decides to leave
 screenLoop :: MState -> Curses ()    
 screenLoop st = do
-  w <- defaultWindow
-  updateWindow w $ do
-    clearMain (fromIntegral . scrRows $ st) (fromIntegral . scrColumns $ st)
-    drawMode (mode st) st
+  w   <- defaultWindow
+  st' <- updateWindow w $ do
+    clearMain (scrRowsAsInt st) (scrColsAsInt st)
+    st'' <- drawMode (mode st) st
+    drawStatus st''
+    return st''
   render
-  st' <- handleEvent st
-  if (not . exitRequested) st'
-    then screenLoop st'
+  st'' <- handleEvent st'
+  if (not . exitRequested) st''
+    then screenLoop st''
     else return ()
          
--- | Handle an event
---   TODO: Handle the events in a cleaner way.  
-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 :: Mode -> MState -> Update MState
 drawMode MaildirMode st = drawMaildirHelper st (detectedMDs st)
 drawMode EmailMode   st = drawEmailHelper st
-drawMode IndexMode   st = drawIndexHelper 0 0 (curRow st) (colPadding st) (selectedEmails st)
+drawMode IndexMode   st = drawIndexHelper st $ (selectedEmails st)
 
 -- | Helper function of drawMode
-drawMaildirHelper _ [] = return ()
+drawMaildirHelper st [] = return $ st { curRow = 0 }
 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 ()    
+  st' <- if (selectedRow st == curRow st)
+         then do
+           setColor $ selectedColorID st
+           drawString $ normalizeLen (scrColsAsInt st) md
+           setColor defaultColorID
+           return $ st { selectedMD = md } 
+         else do
+           drawString $ normalizeLen (scrColsAsInt st) md
+           return st
+           
+  let limit = if showStatus st' then (scrRows st') - 1 else scrRows st'
+  if curRow st' < limit
+    then drawMaildirHelper (incCurRow st') mds
+    else return $ st' { curRow = 0 }
 
 -- | Helper function of drawMode
-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 ()
+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 }
   
 -- | 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 $ (fromIntegral . scrColumns $ st) - (length xs)
+  let cropWith xs = normalizeLen $ (scrColsAsInt st) - (length xs)
   let row = curRow st
   moveCursor row (colPadding st)
   drawString $ ("From: " ++) $ cropWith "From: " . ppNameAddr . getFrom $ fs
@@ -123,7 +126,8 @@ drawEmailHelper st = do
   drawString $ ("Subject: " ++) $ cropWith "Subject: " . ppSubject . getSubject $ fs
   
   let body = getBody $ selectedEmail st
-  drawBody (row + 4) (colPadding st) $ formatBody body (fromIntegral . scrColumns $ st)
+  drawBody (row + 4) (colPadding st) $ formatBody body (scrColsAsInt st)
+  return st
   where drawBody _ _ [] = return ()
         drawBody row col (xs:xss) = do
           moveCursor row col
@@ -150,3 +154,52 @@ 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 st = do
+  moveCursor ((scrRows st) - 1) 0
+  setColor $ statusColorID st
+  drawString . normalizeLen (scrColsAsInt st) . concat $ drawStatusHelper (mode st) st
+  setColor defaultColorID
+  
+drawStatusHelper MaildirMode st = ["Maildir listing - "
+                                  , "(", show ((+ 1) . selectedRowMD $ st), "/"
+                                  ,  show (length $ detectedMDs st), ")"]
+    
+drawStatusHelper IndexMode st = ["mode: Index - "
+                                , "(", show ((+ 1) . selectedRowIn $ st), "/"
+                                ,  show (length $ selectedEmails st), ")"]
+
+drawStatusHelper EmailMode st = ["mode: Email"]
+
+-- | Handle an event
+--   TODO: Handle the events in a cleaner way.  
+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' -> do
+                      case (mode st) of
+                        IndexMode   -> return $ st { mode = MaildirMode }
+                        EmailMode   -> return $ st { mode = IndexMode }
+                        MaildirMode -> return $ st { exitRequested = True }
+  
+                    EventSpecialKey KeyUpArrow  -> return $ decSelectedRow st
+                    EventCharacter 'k'          -> return $ decSelectedRow st
+                    
+                    EventSpecialKey KeyDownArrow -> return $ incSelectedRow st
+                    EventCharacter 'j'           -> return $ incSelectedRow st
+
+                    EventSpecialKey KeyRightArrow -> do
+                      case (mode st) of
+                        IndexMode   -> return $ st { mode = EmailMode }
+                        EmailMode   -> return st 
+                        MaildirMode -> do
+                          selEmails <-liftIO $ getAll . selectedMD $ st
+                          return $ st { mode = IndexMode, selectedEmails = selEmails }
+                    
+                    _ ->  loop