diff options
author | Raúl Benencia <rul@kalgan.cc> | 2013-09-05 19:36:33 -0300 |
---|---|---|
committer | Raúl Benencia <rul@kalgan.cc> | 2013-09-05 19:36:33 -0300 |
commit | 41b53ca04b6d52457f331930e8fea68416498882 (patch) | |
tree | ee63ce86ab4d9a4fc09637a0d5d4015e9f3c9956 /Email.hs | |
parent | 84fa12fef1736d04ee79e40cebaadadda262f063 (diff) |
New project tree structure
Diffstat (limited to 'Email.hs')
-rw-r--r-- | Email.hs | 132 |
1 files changed, 0 insertions, 132 deletions
diff --git a/Email.hs b/Email.hs deleted file mode 100644 index db6f17b..0000000 --- a/Email.hs +++ /dev/null @@ -1,132 +0,0 @@ -{- Email accessors. - - - - Copyright 2013 Raúl Benencia <rul@kalgan.cc> - - - - Licensed under the GNU GPL version 3 or higher - - - -} -module Email where - -import Codec.MIME.Type(MIMEValue(..), MIMEContent(..), showMIMEType, Type(..), MIMEType(..)) -import Data.Char(toLower) -import Data.List(find) - -getBody :: MIMEValue -> String -getBody msg = - case mime_val_content msg of - Single c -> c - Multi mvs -> case firstTextPart mvs of - Just mv -> unwrapContent . mime_val_content $ mv - Nothing -> "This email has no displayable content." - where - unwrapContent (Single c) = c - --- hackish function for showing the email. In he future the logic of this --- function should be improved. -firstTextPart [] = Nothing -firstTextPart (mv:mvs) = case mime_val_content mv of - Single c -> if isText mv then Just mv else firstTextPart mvs - Multi mvs' -> firstTextPart mvs' - - where - isText = \mv -> case (mimeType $ mime_val_type mv) of - Text text -> True - _ -> False - -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 - -parseEmail :: String -> Message -parseEmail msg = unwrapEmail $ parse message "<stdin>" $ fixEol msg - -unwrapEmail (Right email) = email -getFields (Message fs _) = fs - --- There is obviously a pattern here. Find a way to narrow it down. -getReturnPath fs = do { ReturnPath f <- fs; f } -getFrom fs = do { From f <- fs; f } -getTo fs = do { To f <- fs; f } -getCc fs = do { Cc f <- fs; f } -getBcc fs = do { Bcc f <- fs; f } -getReplyTo fs = do { ReplyTo f <- fs; f } -getSubject fs = do { Subject f <- fs; f } -getMessageID fs = do { MessageID f <- fs; f } -getInReplyTo fs = do { InReplyTo f <- fs; f } -getReferences fs = do { References f <- fs; f } -getComments fs = do { Comments f <- fs; f } -getKeywords fs = do { Keywords f <- fs; f } ---getDate fs = do { Date f <- fs; f } ---getResentDate fs = do { ResentDate f <- fs; f } -getResentFrom fs = do { ResentFrom f <- fs; f } ---getResentSender fs = do { ResentSender f <- fs; f } -getResentTo fs = do { ResentTo f <- fs; f } -getResentCc fs = do { ResentCc f <- fs; f } -getResentBcc fs = do { ResentBcc f <- fs; f } -getResentMessageID fs = do { ResentMessageID f <- fs; f } ---getReceived fs = do { Received f <- fs; f } - -getBody (Message _ []) = "Empty body" -getBody (Message _ body) = body - --- 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 [] = []-} |