diff options
| -rw-r--r-- | Email.hs | 91 | ||||
| -rw-r--r-- | Handlers.hs | 20 | ||||
| -rw-r--r-- | Print.hs | 16 | ||||
| -rw-r--r-- | Screen.hs | 12 | ||||
| -rw-r--r-- | State.hs | 5 |
5 files changed, 90 insertions, 54 deletions
@@ -7,16 +7,75 @@ -} module Email where -import Network.Email.Mailbox(Flag(..), Flags) +import Codec.MIME.Type(MIMEValue(..), MIMEContent(..)) +import Data.Char(toLower) +import Data.List(find) -import Text.Parsec.Error(ParseError) +getBody :: MIMEValue -> String +getBody msg = + case mime_val_content msg of + Single c -> c + _ -> "Buggity Buggity Buggity!" + +getHeaders :: MIMEValue -> [(String,String)] +getHeaders = mime_val_headers + +-- | Convert a String to multiple Strings, cropped by the maximum column +-- size if necessary. +formatBody :: String -> Int -> [String] +formatBody body maxColumns = format [] [] body where + format parsed acc [] = parsed ++ [acc] + format parsed acc ('\r':'\n':xs) = format (parsed ++ [acc]) [] xs + format parsed acc rest@(x:xs) | length acc < maxColumns = format parsed (acc ++ [x]) xs + | otherwise = format (parsed ++ [acc]) "+" rest + + +-- The following function is a verbatim copy of the unexported function in +-- Codec.MIME.Parse. +-- case in-sensitive lookup of field names or attributes\/parameters. +lookupField' :: String -> [(String,a)] -> Maybe a +lookupField' n ns = + -- assume that inputs have been mostly normalized already + -- (i.e., lower-cased), but should the lookup fail fall back + -- to a second try where we do normalize before giving up. + case lookup n ns of + x@Just{} -> x + Nothing -> + let nl = map toLower n in + case find (\ (y,_) -> nl == map toLower y) ns of + Nothing -> Nothing + Just (_,x) -> Just x + +unwrapField = maybe "" id + +lookupField n ns = unwrapField $ lookupField' n ns + + + + + + + + + + + + + + + + + + + + + + + +{-import Text.Parsec.Error(ParseError) import Text.ParserCombinators.Parsec (parse) import Text.ParserCombinators.Parsec.Rfc2822 -data Email = Email { emailPath :: String - , parsedEmail :: Message - } - parseEmail :: String -> Message parseEmail msg = unwrapEmail $ parse message "<stdin>" $ fixEol msg @@ -49,27 +108,9 @@ getResentMessageID fs = do { ResentMessageID f <- fs; f } getBody (Message _ []) = "Empty body" getBody (Message _ body) = body --- | Convert a String to multiple Strings, cropped by the maximum column --- size if necessary. -formatBody :: String -> Int -> [String] -formatBody body maxColumns = format [] [] body where - format parsed acc [] = parsed ++ [acc] - format parsed acc ('\r':'\n':xs) = format (parsed ++ [acc]) [] xs - format parsed acc rest@(x:xs) | length acc < maxColumns = format parsed (acc ++ [x]) xs - | otherwise = format (parsed ++ [acc]) "+" rest - -- Make sure all lines are terminated by CRLF. fixEol :: String -> String fixEol ('\r':'\n':xs) = '\r' : '\n' : fixEol xs fixEol ('\n':xs) = '\r' : '\n' : fixEol xs fixEol (x:xs) = x : fixEol xs -fixEol [] = [] - ---data DescriptionPP = DescriptionPP { --- ppOrder :: [String] -> [String] --- } - - --- emailDescription = emailDescriptionWithPP defaultDescriptionPP - --- emailDescriptionWithPP pp
\ No newline at end of file +fixEol [] = []-} diff --git a/Handlers.hs b/Handlers.hs index 3e27b79..503358b 100644 --- a/Handlers.hs +++ b/Handlers.hs @@ -7,16 +7,18 @@ module Handlers where -import Data.List(intercalate) +import Codec.MIME.Parse(parseMIMEMessage) +import Codec.MIME.Type(MIMEValue(..)) import Control.Monad.State -import Data.List(stripPrefix) +import Data.List(intercalate, stripPrefix) import System.FilePath(FilePath, takeFileName, dropTrailingPathSeparator) +import qualified System.IO.UTF8 as UTF8 -import Email(parseEmail, getFields, getSubject, getFrom, getBody, formatBody) +--import Email(parseEmail, getFields, getSubject, getFrom, getBody, formatBody) +import Email(lookupField, getBody, formatBody) import Maildir import Print import State -import qualified System.IO.UTF8 as UTF8 import Types (LazymailCurses) previousMode :: Mode -> LazymailCurses () @@ -32,7 +34,7 @@ changeMode EmailMode = return () changeMode IndexMode = do st <- get msg <- liftIO $ UTF8.readFile . selectedEmailPath . indexState $ st - let email = parseEmail msg + let email = parseMIMEMessage msg let body = getBody $ email let el = formatBody body $ screenColumns st let est = (emailState st) { currentEmail = email, emailLines = el, scrollRowEm = 0 } @@ -151,12 +153,12 @@ scrollCrop top rows xs = take rows $ drop top xs formatIndexModeRows st = mapM formatRow where formatRow fp = do msg <- UTF8.readFile fp - let email = parseEmail msg - let fs = getFields email + let email = parseMIMEMessage msg + let hs = mime_val_headers email let str = normalizeLen (screenColumns st) $ intercalate ppSep $ [ ppFlags . getFlags $ fp - , ppIndexNameAddr . getFrom $ fs - , ppSubject . getSubject $ fs + , normalizeLen fromLen $ ppField $ lookupField "from" hs + , ppField $ lookupField "subject" hs ] return (fp, str) @@ -16,20 +16,12 @@ import Text.ParserCombinators.Parsec.Rfc2822(NameAddr(..)) import Email import Rfc1342 -nameLen = 20 -ppNameAddr nas = intercalate ", " $ map ppNameAddr' nas - where ppNameAddr' na = case nameAddr_name na of - Nothing -> nameAddr_addr na - Just n -> unquote (decodeField n) ++ " <" ++ nameAddr_addr na ++ ">" - -ppIndexNameAddr nas = normalizeLen nameLen $ concat $ map ppNameAddr' nas - where ppNameAddr' na = case nameAddr_name na of - Nothing -> nameAddr_addr na - Just n -> unquote (decodeField n) - unquote xs= if (head xs == '"' && last xs == '"') then (tail . init) xs else xs -ppSubject = flat . decodeField +ppField = flat . decodeField + +fromLen :: Int +fromLen = 20 flat xs = intercalate " " $ map (dropWhile isSpace) $ map (filter (/= '\r')) $ lines xs @@ -9,12 +9,12 @@ module Screen where +import Codec.MIME.Type(MIMEValue(..)) import Control.Monad.Trans(liftIO) import Control.Monad.Reader import Control.Monad.State import Data.List(isPrefixOf) import System.Exit -import Text.ParserCombinators.Parsec.Rfc2822(Message(..)) import UI.NCurses -- Local imports @@ -22,7 +22,7 @@ import Config import qualified Handlers as EH import Lazymail import Maildir -import Email +import Email(lookupField, getBody, getHeaders) import Print import Rfc1342 import State @@ -148,16 +148,16 @@ drawEmailHelper = do drawEmailHeader = do st <- get liftUpdate $ do - let fs = getFields $ currentEmail . emailState $ st + let hs = getHeaders $ currentEmail . emailState $ st let cropWith xs = normalizeLen $ (screenColumns st) - (length xs) let row = curRowAsInteger st setColor $ headerColorID . colorStyle $ st moveCursor row (colPadAsInteger st) - drawCroppedString st $ ("From: " ++) $ ppNameAddr . getFrom $ fs + drawCroppedString st $ ("From: " ++) . ppField $ lookupField "from" hs moveCursor (row + 1) (colPadAsInteger st) - drawCroppedString st $ ("To: " ++) $ ppNameAddr . getTo $ fs + drawCroppedString st $ ("To: " ++) . ppField $ lookupField "to" hs moveCursor (row + 2) (colPadAsInteger st) - drawCroppedString st $ ("Subject: " ++) $ ppSubject . getSubject $ fs + drawCroppedString st $ ("Subject: " ++) . ppField $ lookupField "subject" hs setColor $ baseColorID . colorStyle $ st put $ st { currentRow = (4 + currentRow st) } @@ -8,6 +8,7 @@ module State where +import Codec.MIME.Type(MIMEValue, nullMIMEValue) import Text.ParserCombinators.Parsec.Rfc2822(Message, GenericMessage(..)) import UI.NCurses(ColorID(..), defaultColorID) import Network.Email.Mailbox(Flag(..), Flags) @@ -56,7 +57,7 @@ data EmailState = EmailState { scrollRowEm :: Int , bodyStartRow :: Int , emailLines :: [String] - , currentEmail :: Message + , currentEmail :: MIMEValue } data ColorStyle = ColorStyle { @@ -103,7 +104,7 @@ initialEmailState = EmailState { scrollRowEm = 0 , bodyStartRow = 0 , emailLines = [] - , currentEmail = Message [] "Dummy email" + , currentEmail = nullMIMEValue } initialComposeState = ComposeState { |