New project tree structure

1 files changed, 0 insertions, 268 deletions

diff --git a/Screen.hs b/Screen.hs
deleted file mode 100644
index 6bc5b5e..0000000
--- a/Screen.hs
+++ /dev/null
@@ -1,268 +0,0 @@
-{- Lazymail interaction with curses.
- -
- - Copyright 2013 Raúl Benencia <rul@kalgan.cc>
- -
- - Licensed under the GNU GPL version 3 or higher
- -
- - This code is in an urgent need of a big refactoring.
- -}
-
-module Screen where
-
-import Codec.MIME.Type(MIMEValue(..))
-import Control.Monad.Trans(liftIO)
-import Control.Monad.Reader
-import Control.Monad.State
-import Data.Char(toUpper)
-import Data.List(isPrefixOf)
-import System.Exit
-import UI.NCurses
-
--- Local imports
-import Config
-import qualified Handlers as EH
-import Lazymail
-import Maildir
-import Email(lookupField, getBody, getHeaders, lookupField')
-import Print
-import Rfc1342
-import State
-import Types
-
-{- This function is the nexus between Curses and IO -}
-entryPoint :: Lazymail ()
-entryPoint = do
-  st <- get
-  cfg <- ask
-  maildirs <- liftIO $ do
-    mds <- getMaildirsRecursively $ basePath st
-    (filterMaildirsHook cfg) mds
-  formattedMDs <- EH.formatMaildirModeRows st maildirs
-  let mdState = (maildirState st) { detectedMDs = formattedMDs }
-  liftIO $ runCurses $ runStateT (runReaderT startCurses cfg) (st { maildirState = mdState })
-  return ()
-
-{- Initial point of screen related functions. Get the number of rows,
- - colors, and start drawing the modes -}
-startCurses :: LazymailCurses ()
-startCurses = do
-  st <- get
-  cfg <- ask
-  (=<<) put $ liftCurses $ do
-    setEcho False
-    setCursorMode CursorInvisible
-    (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
-    heaColID <- newColorID (fst . headerColor $ cfg) (snd . headerColor $ cfg) 4
-    newColID <- newColorID (fst . newEmailColor $ cfg) (snd . newEmailColor $ cfg) 5
-    let style = ColorStyle basColID selColID staColID heaColID newColID
-    return $ st { screenRows = fromIntegral $ rows - 1
-                , screenColumns = fromIntegral $ cols
-                , colorStyle = style }
-  resetScrollBuffer
-  screenLoop
-
-{- This function will loop til the user decides to leave -}
-screenLoop :: LazymailCurses ()
-screenLoop = do
-  w <- liftCurses $ defaultWindow
-  cfg <- ask
-  get >>=  \st ->
-    (liftCurses . (updateWindow w) $ runStateT (runReaderT performUpdate cfg) st) >>= put . snd
-  liftCurses $ render
-  handleEvent
-  get >>= \st -> if (not . exitRequested) st
-                 then screenLoop
-                 else return ()
-
-{- Perform the screen update, by cleaning it first. -}
-performUpdate :: LazymailUpdate LazymailState
-performUpdate = do
-  st <- get
-  liftUpdate $ clearMain (scrRowsAsInteger st) (screenColumns st)
-  drawMode (mode st)
-  drawStatus
-  get
-
-{- Pattern match on the received mode and draw it in the screen. -}
-drawMode :: Mode -> LazymailUpdate ()
-drawMode MaildirMode = get >>= \st -> drawSelectionList $ scrollBufferMD . maildirState $ st
-drawMode IndexMode   = get >>= \st -> drawSelectionList $ scrollBufferIn . indexState $ st
-drawMode EmailMode   = drawEmailHelper
-
-{- Draw a scrollable selection list -}
-drawSelectionList [] = resetCurrentRow
-drawSelectionList ((path, str):mds) = do
-  st <- get
-  (=<<) put $ liftUpdate $ do
-    moveCursor (curRowAsInteger st) (colPadAsInteger st)
-    if (selectedRow st == currentRow st)
-      then do
-        setColor $ selectionColorID . colorStyle $ st
-        drawString $ normalizeLen (screenColumns st) str
-        setColor $ baseColorID . colorStyle $ st
-        case (mode st) of
-          MaildirMode -> do
-            let mst = (maildirState st) { selectedMD = path }
-            return $ st { maildirState = mst }
-          IndexMode   -> do
-            let ist = (indexState st) { selectedEmailPath = path }
-            return $ st { indexState = ist }
-      else do
-        drawSimpleRow st path str
-        return st
-
-  st <- get
-  let limit = if statusBar st then (screenRows st) - 1 else screenRows st
-  if currentRow st < limit
-    then do
-      incrementCurrentRow
-      drawSelectionList mds
-    else
-      resetCurrentRow
-
-drawSimpleRow st path str | (mode st) == MaildirMode = drawString $ normalizeLen (screenColumns st) str
-                          | (mode st) == IndexMode   =
-  if isNew path
-  then do
-    setColor $ newEmailColorID . colorStyle $ st
-    drawCroppedString st str
-    setColor $ baseColorID . colorStyle $ st
-  else
-    drawCroppedString st str
-
-{- Empty the whole window. Useful when changing modes. -}
-clearMain rows columns = do
-  drawEmptyLine 0
-  moveCursor 0 0
-  where
-    drawEmptyLine currentRow = do
-      moveCursor currentRow 0
-      drawString $ replicate (columns) ' '
-      when (currentRow < rows - 1) $ drawEmptyLine $ currentRow + 1
-
-{- Helper function of drawMode -}
-drawEmailHelper = do
-  drawEmailHeaders
-
-  st <- get
-  let est = emailState st
-  put $ st { emailState = est { bodyStartRow = (currentRow st ) } }
-  let body = getBody $ currentEmail . emailState $ st
-  let maxRows = if statusBar st then (scrRowsAsInteger st) - 1 else scrRowsAsInteger st
-  liftUpdate $
-    drawBody (curRowAsInteger st) (colPadAsInteger st) maxRows $
-      drop (scrollRowEm est) $ emailLines est
-  resetCurrentRow
-
-{- Draw the email headers -}
-drawEmailHeaders = do
-  st <- get
-  cfg <- ask
-  let hs = getHeaders $ currentEmail . emailState $ st
-  let parsedHeaders = parseHeaders hs 0 $ headersToShow cfg
-
-  liftUpdate $ do
-    setColor $ headerColorID . colorStyle $ st
-    drawHeaders st (curRowAsInteger st) parsedHeaders
-    setColor $ baseColorID . colorStyle $ st
-  put $ st { currentRow = 1 + (length parsedHeaders) + (currentRow st) }
-
-  where
-    parseHeaders _ _ [] = []
-    parseHeaders headers row (h:hs)= do
-      let field = lookupField' h headers
-      case field of
-        Nothing -> parseHeaders headers row hs
-        Just f -> let p = capitalize h ++ ": " ++ (ppField f)
-                  in p:parseHeaders headers (row + 1) hs
-
-    capitalize str = (toUpper . head $ str):(tail str)
-    drawHeaders _ _ []      = return ()
-    drawHeaders st row (h:hs) = do
-      moveCursor row (colPadAsInteger st)
-      drawCroppedString st h
-      drawHeaders st (row + 1) hs
-
-{- Draw the email body -}
-drawBody _ _ _ [] = return ()
-drawBody row col maxRows (xs:xss) = do
-  moveCursor row col
-  drawString xs
-  when (row <  maxRows) $ drawBody (row + 1) col maxRows  xss
-
-{- Draw a status line with the current mode and other stuff -}
-drawStatus  = do
-  st <- get
-  liftUpdate $ do
-    moveCursor (scrRowsAsInteger st) 0
-    setColor $ statusBarColorID . colorStyle $ st
-    drawString $ normalizeLen (screenColumns st - 1)$ concat $ drawStatusHelper (mode st) st -- Can't write in the last char - ncurses bug
-    setColor $ baseColorID . colorStyle $ st
-
-{- Status bar string for Maildir mode -}
-drawStatusHelper MaildirMode st =
-  ["Maildir listing - "
-  , "(", show ((selectedRow st) + (scrollRowMD . maildirState $ st) + 1), "/"
-  ,  show (length $ detectedMDs . maildirState $ st), ")"]
-
-{- Status bar string for Index mode -}
-drawStatusHelper IndexMode st =
-  ["mode: Index - "
-  , "(", show ((selectedRow st) + (scrollRowIn . indexState $ st) + 1), "/"
-  ,  show (currentInLen . indexState $ st), ")"]
-
-{- Status bar string for Email mode -}
-drawStatusHelper EmailMode st = ["mode: Email"]
-
-{- Handle an event
- - TODO: Handle the events in a cleaner way. -}
-handleEvent :: LazymailCurses ()
-handleEvent = loop where
-  loop = do
-    w <- liftCurses $ defaultWindow
-    ev <- liftCurses $ getEvent w Nothing
-    st <- get
-    case ev of
-      Nothing  -> loop
-      Just ev' ->
-        case ev' of
-          EventCharacter 'q'            -> EH.previousMode (mode st)
-
-          EventSpecialKey KeyUpArrow    -> EH.decSelectedRow (mode st)
-          EventCharacter 'k'            -> EH.decSelectedRow (mode st)
-
-          EventSpecialKey KeyDownArrow  -> EH.incSelectedRow (mode st)
-          EventCharacter 'j'            -> EH.incSelectedRow (mode st)
-
-          EventSpecialKey KeyEnter      -> EH.changeMode (mode st)
-          EventSpecialKey KeyRightArrow -> EH.changeMode (mode st)
-
-          _ ->  loop
-
-{- Reset the current row to the beginning -}
-resetCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = 0 }
-
-{- Advance the current row. Useful when drawing modes -}
-incrementCurrentRow = (=<<) put $ get >>= \st -> return $ st { currentRow = (currentRow st) + 1 }
-
-{- Put the scroll at the top -}
-resetScrollBuffer = do
-  st <- get
-  case (mode st) of
-    MaildirMode -> do
-      let mst = (maildirState st) {
-            scrollBufferMD = EH.scrollCrop 0 (screenRows st) $ detectedMDs . maildirState $ st }
-      put st { maildirState = mst}
-    IndexMode -> do
-      let ist = (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
-
--- The type system complains if I want to use the same function for diferents monads
-liftCurses = lift . lift
-liftUpdate  = lift . lift