Sorted index mode

8 files changed, 133 insertions, 101 deletions

diff --git a/Config.hs b/Config.hs
index b446838..96c9125 100644
--- a/Config.hs
+++ b/Config.hs
@@ -12,24 +12,17 @@ import Data.List(sort, stripPrefix)
 import System.Posix.Files(getSymbolicLinkStatus, isSymbolicLink)
 import UI.NCurses(Color(..))
 
-data LazymailConfig = LazymailConfig {
-    baseColor          :: (Color, Color) -- (foreground, background)
-  , selectionColor     :: (Color, Color)
-  , statusBarColor     :: (Color, Color)
-  , headerColor        :: (Color, Color)  
-  , showStatusBar      :: Bool
-  , initialPath        :: FilePath
-  , filterMaildirsHook :: [FilePath] -> IO [FilePath]
-}
+import Types(LazymailConfig(..))
 
 defaultConfig = LazymailConfig {
     baseColor          = (ColorWhite, ColorBlack)
   , selectionColor     = (ColorYellow, ColorBlack)
   , statusBarColor     = (ColorYellow, ColorBlack)
-  , headerColor        = (ColorYellow, ColorBlack)                         
+  , headerColor        = (ColorYellow, ColorBlack)
   , showStatusBar      = True
   , initialPath        = ""
   , filterMaildirsHook =  \mds -> return mds
+  , indexDateFormat    = "%m %d"                                
 }
 
 --
diff --git a/Handlers.hs b/Handlers.hs
index ccce1d0..fc4c009 100644
--- a/Handlers.hs
+++ b/Handlers.hs
@@ -11,16 +11,17 @@ import Codec.MIME.Parse(parseMIMEMessage)
 import Codec.MIME.Type(MIMEValue(..))
 import Control.Exception(evaluate)
 import Control.Monad.State
-import Data.List(intercalate, stripPrefix)
+import Data.List(intercalate, stripPrefix, sort)
 import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator)
+import System.Locale(rfc822DateFormat)
+import Data.DateTime(parseDateTime, startOfTime, formatDateTime)
 import qualified System.IO.UTF8 as UTF8
 
---import Email(parseEmail, getFields, getSubject, getFrom, getBody, formatBody)
 import Email(lookupField, getBody, formatBody)
 import Maildir
 import Print
 import State
-import Types (LazymailCurses)
+import Types
 
 previousMode :: Mode -> LazymailCurses ()
 previousMode MaildirMode = (=<<) put $ get >>= \st -> return st { exitRequested = True }
@@ -43,17 +44,28 @@ changeMode IndexMode   = do
 
 changeMode MaildirMode =  do
   st <- get
-  selectedEmails' <- liftIO $ do
+  unsortedEmails <- liftIO $ do
     let md = (selectedMD . maildirState) $ st
     emails <- getMaildirEmails md
-    formatIndexModeRows st emails
+    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 = scrollCrop (scrollRowIn . indexState $ st) (screenRows st)  selectedEmails'
+        , scrollBufferIn = formatIndexModeRows st $ scrollCrop scrollRow scrRows selectedEmails'
         }
   put $ st { mode = IndexMode, indexState = indexState' }
 
+  where
+    toEmail fp = do
+      msg <- readFile fp
+      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)
+
 {- Boilerplate code -}
 incSelectedRow IndexMode = do
   st <- get
@@ -66,7 +78,7 @@ incSelectedRow IndexMode = do
   if selRow > startScrolling && (topScrollRow <= (totalRows - (screenRows st)))
      then do -- Scroll emails
        let scrollRowIn'    = scrollRowIn inSt + 1
-       let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
+       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
@@ -113,7 +125,7 @@ decSelectedRow IndexMode = do
   if topScrollRow > 0 && selRow < startScrolling
      then do
        let scrollRowIn'    = scrollRowIn inSt - 1
-       let scrollBufferIn' = scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
+       let scrollBufferIn' = formatIndexModeRows st $ scrollCrop scrollRowIn' (screenRows st) $ selectedEmails inSt
        let inSt'           = inSt { scrollRowIn = scrollRowIn', scrollBufferIn = scrollBufferIn' }
        put st { indexState = inSt' }
       else
@@ -151,17 +163,19 @@ decSelectedRow _ = (=<<) put $ get >>= \st -> return $ decrementSelectedRow st
  - TODO: find a better name -}
 scrollCrop top rows xs = take rows $ drop top xs
 
-formatIndexModeRows st = mapM formatRow where
-  formatRow fp = do
-    msg <- UTF8.readFile fp
-    let email = parseMIMEMessage msg
-    let hs = mime_val_headers email
-    let str = normalizeLen (screenColumns st) $ intercalate ppSep $
+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 $
               [ ppFlags . getFlags $ fp
+              , formatDateTime "%b %d" $ emailDate e
               , normalizeLen fromLen $ ppField $ lookupField "from" hs
               , ppField $ lookupField "subject" hs
               ]
-    return (fp, str)
+    in (fp, str)
 
 formatMaildirModeRows st = mapM formatRow where
   formatRow fp = return $ (fp, (concat $ replicate (numPads - 1) pad) ++ name) where
diff --git a/Lazymail.hs b/Lazymail.hs
index 200b8fd..fbb7e3e 100644
--- a/Lazymail.hs
+++ b/Lazymail.hs
@@ -13,11 +13,7 @@ import Control.Monad.State
 
 import Config
 import State
-
-{- Lazymail monad is a ReaderT around a StateT with IO at the bottom of the
- - stack.
- -}
-type Lazymail = ReaderT LazymailConfig (StateT LazymailState IO)
+import Types
 
 run :: Lazymail a -> IO (a, LazymailState)
 run k =
diff --git a/Main.hs b/Main.hs
index ebc4810..416b65a 100644
--- a/Main.hs
+++ b/Main.hs
@@ -19,12 +19,10 @@ import Screen
 import State
 
 parse ["-h"] = usage   >> exit
+parse ["--help"] = usage   >> exit
 parse ["-v"] = version >> exit
-parse [md]   = do
-  putStrLn $ "Maildirs directory: " ++ md
-  run entryPoint
-
-parse [] = usage >> die
+parse ["--version"] = version >> exit
+parse _   = run entryPoint
 
 usage   = putStrLn . unlines $ usageText where
   usageText = ["Usage: ./Main [-vh] <maildirs>"
diff --git a/Print.hs b/Print.hs
index 8f40491..cae3a45 100644
--- a/Print.hs
+++ b/Print.hs
@@ -20,6 +20,9 @@ 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
 
diff --git a/Screen.hs b/Screen.hs
index 90954b1..5150e93 100644
--- a/Screen.hs
+++ b/Screen.hs
@@ -26,7 +26,7 @@ import Email(lookupField, getBody, getHeaders)
 import Print
 import Rfc1342
 import State
-import Types(LazymailCurses, LazymailUpdate)
+import Types
 
 {- This function is the nexus between Curses and IO -}
 entryPoint :: Lazymail ()
@@ -153,13 +153,15 @@ drawEmailHeader = do
     let row = curRowAsInteger st
     setColor $ headerColorID . colorStyle $ st
     moveCursor row (colPadAsInteger st)
-    drawCroppedString st $ ("From: " ++) . ppField $ lookupField "from" hs
+    drawCroppedString st $ ("Date: " ++) . ppField $ lookupField "date" hs
     moveCursor (row + 1) (colPadAsInteger st)
-    drawCroppedString st $ ("To: " ++) . ppField $ lookupField "to" hs
+    drawCroppedString st $ ("From: " ++) . ppField $ lookupField "from" hs
     moveCursor (row + 2) (colPadAsInteger st)
+    drawCroppedString st $ ("To: " ++) . ppField $ lookupField "to" hs
+    moveCursor (row + 3) (colPadAsInteger st)
     drawCroppedString st $ ("Subject: " ++) . ppField $ lookupField "subject" hs
     setColor $ baseColorID . colorStyle $ st
-  put $ st { currentRow = (4 + currentRow st) }
+  put $ st { currentRow = (5 + currentRow st) }
 
 {- Draw the email body -}
 drawBody _ _ _ [] = return ()
@@ -233,7 +235,7 @@ resetScrollBuffer = do
       put st { maildirState = mst}
     IndexMode -> do
       let ist = (indexState st) {
-            scrollBufferIn = EH.scrollCrop 0 (screenRows st) $ selectedEmails . 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
diff --git a/State.hs b/State.hs
index 357a516..f9c8683 100644
--- a/State.hs
+++ b/State.hs
@@ -14,58 +14,7 @@ import UI.NCurses(ColorID(..), defaultColorID)
 import Network.Email.Mailbox(Flag(..), Flags)
 import System.FilePath
 
-data Mode = MaildirMode | IndexMode | EmailMode | ComposeMode
-
-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)]
-}
-
-data IndexState = IndexState {
-    selectedRowIn     :: Int
-  , selectedEmailPath :: FilePath
-  , selectedEmails    :: [(FilePath, String)]
-  , scrollRowIn       :: Int
-  , currentInLen      :: Int
-  , scrollBufferIn    :: [(FilePath, String)]
-}
-
-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
-}
+import Types
 
 initialState = LazymailState {
     mode          = MaildirMode
diff --git a/Types.hs b/Types.hs
index 4fe658e..82005e2 100644
--- a/Types.hs
+++ b/Types.hs
@@ -5,18 +5,95 @@
  - Licensed under the GNU GPL version 3 or higher
  -}
 
-module Types
-       (
-         LazymailUpdate
-       , LazymailCurses
-       ) where
+module Types where
 
+import Codec.MIME.Type(MIMEValue(..))
 import Control.Monad.Reader(ReaderT)
 import Control.Monad.State(StateT)
-import UI.NCurses(Curses, Update)
-
-import Config (LazymailConfig)
-import State (LazymailState)
+import Data.DateTime(DateTime)
+import System.FilePath(FilePath)
+import UI.NCurses(Curses, Update, Color(..), ColorID)
 
 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)
+  , showStatusBar      :: Bool
+  , initialPath        :: FilePath
+  , filterMaildirsHook :: [FilePath] -> IO [FilePath]
+  , indexDateFormat    :: String
+}
+
+data Email = Email {
+    emailValue :: MIMEValue
+  , emailDate  :: DateTime
+  , emailPath  :: FilePath
+}
+
+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
+
+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)]
+}
+
+data IndexState = IndexState {
+    selectedRowIn     :: Int
+  , selectedEmailPath :: FilePath
+  , selectedEmails    :: [Email]
+  , scrollRowIn       :: Int
+  , currentInLen      :: Int
+  , scrollBufferIn    :: [(FilePath, String)]
+}
+
+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
+}