blob: 22817038cf4f90497c1c9970de94e05991a72f05 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{- Email accessors.
-
- Copyright 2013 Raúl Benencia <rul@kalgan.cc>
-
- Licensed under the GNU GPL version 3 or higher
-
-}
module Email where
import Network.Email.Mailbox(Flag(..), Flags)
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 $ uglyWorkaround 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
-- | 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
{- This is an ugly, Ugly, UGLY workaround for the encoding problems that I
- have with Rfc2822 module. I've reported the bug. I hope it get fixed any time soon so
- I can kill this function with fire -}
uglyWorkaround :: String -> String
uglyWorkaround = map replace where
replace c =
case c of
'á' -> 'a'
'é' -> 'e'
'í' -> 'i'
'ó' -> 'o'
'ú' -> 'u'
'ñ' -> 'n'
_ -> c
|
