hsemail 1.6 → 1.7
raw patch · 6 files changed
+87/−97 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Text/ParserCombinators/Parsec/Rfc2234.hs +5/−5
- Text/ParserCombinators/Parsec/Rfc2821.hs +12/−15
- Text/ParserCombinators/Parsec/Rfc2822.hs +64/−70
- example/message-test.hs +3/−3
- example/smtp-test.hs +1/−2
- hsemail.cabal +2/−2
Text/ParserCombinators/Parsec/Rfc2234.hs view
@@ -48,7 +48,7 @@ | n < 0 = return [] | n > m = return [] | n == m = count n p- | n == 0 = do foldr (<|>) (return []) (map (\x -> try $ count x p) (reverse [1..m]))+ | n == 0 = foldr (<|>) (return []) (map (\x -> try $ count x p) (reverse [1..m])) | otherwise = liftM2 (++) (count n p) (manyNtoM 0 (m-n) p) -- |Helper function to generate 'Parser'-based instances for@@ -164,7 +164,7 @@ -- LF) may be quoted. quoted_pair :: CharParser st String-quoted_pair = do char '\\'+quoted_pair = do _ <- char '\\' r <- noneOf "\r\n" return ['\\',r] <?> "quoted pair"@@ -174,11 +174,11 @@ -- LF are not allowed at all. quoted_string :: CharParser st String-quoted_string = do dquote+quoted_string = do _ <- dquote r <- many qcont- dquote+ _ <- dquote return ("\"" ++ concat r ++ "\"") <?> "quoted string" where qtext = noneOf "\\\"\r\n"- qcont = (many1 qtext) <|> (quoted_pair)+ qcont = many1 qtext <|> quoted_pair
Text/ParserCombinators/Parsec/Rfc2821.hs view
@@ -17,8 +17,7 @@ import Control.Exception ( assert ) import Control.Monad.State import Text.ParserCombinators.Parsec-import Text.ParserCombinators.Parsec.Error-import Data.List ( intersperse )+import Data.List ( intercalate ) import Data.Char ( toLower ) import Text.ParserCombinators.Parsec.Rfc2234 @@ -83,8 +82,8 @@ handleSmtpCmd cmd = get >>= \st -> match st cmd where match :: SessionState -> SmtpCmd -> SmtpdFSM- match HaveQuit _ = assert (False) (event Shutdown)- match HaveData _ = assert (False) (trans (HaveData, StartData))+ match HaveQuit _ = assert False (event Shutdown)+ match HaveData _ = assert False (trans (HaveData, StartData)) match _ (WrongArg c _) = event (SyntaxErrorIn c) match _ Quit = trans (HaveQuit, Shutdown) match _ Noop = event SayOK@@ -186,7 +185,7 @@ data Mailbox = Mailbox [String] String String instance Eq Mailbox where- lhs == rhs = (norm lhs) == (norm rhs)+ lhs == rhs = norm lhs == norm rhs where norm (Mailbox rt lp hp) = (rt, lp, map toLower hp) @@ -194,7 +193,7 @@ show (Mailbox [] [] []) = "<>" show (Mailbox [] "postmaster" []) = "<postmaster>" show (Mailbox p u d) = let- route = concat . (intersperse ",") . (map ((:) '@')) $ p+ route = intercalate "," . map ((:) '@') $ p mbox = u ++ "@" ++ d in if null route then "<" ++ mbox ++ ">" else "<" ++ route ++ ":" ++ mbox ++ ">"@@ -395,7 +394,7 @@ where p = do r1 <- local_part- char '@'+ _ <- char '@' r2 <- domain return (Mailbox [] r1 r2) @@ -438,7 +437,7 @@ where p = do r <- many1 (alpha <|> digit <|> char '-')- if (last r == '-')+ if last r == '-' then fail "subdomain must not end with hyphen" else return r @@ -464,7 +463,7 @@ -- or a 'quoted_string'. word :: CharParser st String-word = (atom <|> (quoted_string >>= return . show))+word = (atom <|> fmap show quoted_string) <?> "word or quoted-string" @@ -491,7 +490,7 @@ mkCmd0 :: String -> a -> CharParser st a mkCmd0 str cons = (do try (caseString str)- skipMany wsp >> crlf+ _ <- skipMany wsp >> crlf return cons) <?> str -- |Construct a parser for a command with an argument, which@@ -503,11 +502,11 @@ -> CharParser st SmtpCmd mkCmd1 str cons p = do try (caseString str)- wsp+ _ <- wsp input <- getInput st <- getState let eol = skipMany wsp >> crlf- p' = (between (many wsp) eol p) <?> str+ p' = between (many wsp) eol p <?> str r = runParser p' st "" input case r of Left e -> return (WrongArg str e)@@ -519,6 +518,4 @@ tokenList :: CharParser st String -> Char -> CharParser st String-tokenList p c = do- xs <- sepBy1 p (char c)- return (concat (intersperse [c] xs))+tokenList p c = fmap (intercalate [c]) (sepBy1 p (char c))
Text/ParserCombinators/Parsec/Rfc2822.hs view
@@ -18,7 +18,7 @@ import System.Time import Data.Char ( ord )-import Data.List ( intersperse )+import Data.List ( intercalate ) import Control.Monad ( liftM ) import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Rfc2234 hiding ( quoted_pair, quoted_string )@@ -80,7 +80,7 @@ -- backslash and the actual content. quoted_pair :: CharParser a String-quoted_pair = do { char '\\'; r <- text; return ['\\',r] }+quoted_pair = do { _ <- char '\\'; r <- text; return ['\\',r] } <?> "quoted pair" @@ -113,10 +113,10 @@ -- 'quoted_pair's, and 'fws' between brackets. Comments may nest. comment :: CharParser a String-comment = do char '('+comment = do _ <- char '(' r1 <- many ccontent r2 <- option [] fws- char ')'+ _ <- char ')' return ("(" ++ concat r1 ++ r2 ++ ")") <?> "comment" where@@ -153,8 +153,7 @@ -- |Match two or more 'atext's interspersed by dots. dot_atom_text :: CharParser a String-dot_atom_text = do r <- sepBy1 (many1 atext) (char '.')- return (concat (intersperse "." r))+dot_atom_text = fmap (intercalate ".") (sepBy1 (many1 atext) (char '.')) <?> "dot atom content" @@ -177,12 +176,12 @@ -- preceeding or following the \"atom\" is skipped automatically. quoted_string :: CharParser a String-quoted_string = unfold (do dquote+quoted_string = unfold (do _ <- dquote r1 <- many (do r1 <- option [] fws r2 <- qcontent return (r1 ++ r2)) r2 <- option [] fws- dquote+ _ <- dquote return ("\"" ++ concat r1 ++ r2 ++ "\"")) <?> "quoted string" @@ -214,9 +213,9 @@ unstructured :: CharParser a String unstructured = do r1 <- option [] fws- r2 <- many (do r1 <- utext- r2 <- option [] fws- return (r1 : r2))+ r2 <- many (do r3 <- utext+ r4 <- option [] fws+ return (r3 : r4)) return (r1 ++ concat r2) <?> "unstructured text" @@ -252,10 +251,10 @@ date_time :: CharParser a CalendarTime date_time = do wd <- option Monday (try (do wd <- day_of_week- char ','+ _ <- char ',' return wd)) (y,m,d) <- date- fws+ _ <- fws (td,z) <- time optional cfws return (CalendarTime y m d (tdHour td) (tdMin td) (tdSec td) 0 wd 0 "" z False)@@ -339,7 +338,7 @@ time :: CharParser a (TimeDiff,Int) time = do t <- time_of_day- fws+ _ <- fws z <- zone return (t,z) <?> "time and zone specification"@@ -349,9 +348,9 @@ time_of_day :: CharParser a TimeDiff time_of_day = do h <- hour- char ':'+ _ <- char ':' m <- minute- s <- option 0 (do { char ':'; second } )+ s <- option 0 (do { _ <- char ':'; second } ) return (TimeDiff 0 0 0 h m s 0) <?> "time specification" @@ -384,11 +383,11 @@ -- seconds as an integer. 'obs_zone' is matched as well. zone :: CharParser a Int-zone = ( do char '+'+zone = ( do _ <- char '+' h <- hour m <- minute return (((h*60)+m)*60)- <|> do char '-'+ <|> do _ <- char '-' h <- hour m <- minute return (-((h*60)+m)*60)@@ -418,7 +417,7 @@ -- address. mailbox :: CharParser a NameAddr-mailbox = try name_addr <|> (addr_spec >>= return . NameAddr Nothing)+mailbox = try name_addr <|> fmap (NameAddr Nothing) addr_spec <?> "mailbox" -- |Parse an 'angle_addr', optionally prefaced with a 'display_name',@@ -433,9 +432,9 @@ -- |Parse an 'angle_addr' or an 'obs_angle_addr' and return the address. angle_addr :: CharParser a String-angle_addr = try (unfold (do char '<'+angle_addr = try (unfold (do _ <- char '<' r <- addr_spec- char '>'+ _ <- char '>' return r) <?> "angle address" )@@ -453,17 +452,17 @@ -- > Right ["user1@example.org","user2@example.org"] group :: CharParser a [NameAddr]-group = do display_name- char ':'+group = do _ <- display_name+ _ <- char ':' r <- option [] mailbox_list- unfold $ char ';'+ _ <- unfold $ char ';' return r <?> "address group" -- |Parse and return a 'phrase'. display_name :: CharParser a String-display_name = phrase >>= return . concat . intersperse " "+display_name = fmap unwords phrase <?> "display name" -- |Parse a list of 'mailbox' addresses, every two addresses being@@ -488,7 +487,7 @@ addr_spec :: CharParser a String addr_spec = do r1 <- local_part- char '@'+ _ <- char '@' r2 <- domain return (r1 ++ "@" ++ r2) <?> "address specification"@@ -512,10 +511,10 @@ -- character. The complete string is returned verbatim. domain_literal :: CharParser a String-domain_literal = unfold (do char '['+domain_literal = unfold (do _ <- char '[' r <- many $ do { optional fws; dcontent } optional fws- char ']'+ _ <- char ']' return ("[" ++ concat r ++ "]")) <?> "domain literal" @@ -563,9 +562,7 @@ message :: CharParser a Message message = do f <- fields- b <- option [] (do crlf- b <- body- return b)+ b <- option [] (do _ <- crlf; body) return (Message f b) -- |This parser will return a message body as specified by this RFC;@@ -728,11 +725,11 @@ -- and whitespace. msg_id :: CharParser a String-msg_id = unfold (do char '<'+msg_id = unfold (do _ <- char '<' idl <- id_left- char '@'+ _ <- char '@' idr <- id_right- char '>'+ _ <- char '>' return ("<" ++ idl ++ "@" ++ idr ++ ">")) <?> "message ID" @@ -757,9 +754,9 @@ -- 'msg_id'. no_fold_quote :: CharParser a String-no_fold_quote = do dquote+no_fold_quote = do _ <- dquote r <- many (many1 qtext <|> quoted_pair)- dquote+ _ <- dquote return ("\"" ++ concat r ++ "\"") <?> "non-folding quoted string" @@ -768,10 +765,9 @@ -- 'msg_id'. no_fold_literal :: CharParser a String-no_fold_literal = do char '['+no_fold_literal = do _ <- char '[' r <- many (many1 dtext <|> quoted_pair)- char ']'- return ("\"" ++ concat r ++ "\"")+ _ <- char ']' return ("[" ++ concat r ++ "]") <?> "non-folding domain literal" @@ -794,9 +790,7 @@ keywords :: CharParser a [[String]] keywords = header "Keywords" (do r1 <- phrase- r2 <- many (do char ','- r <- phrase- return r)+ r2 <- many (do _ <- char ','; phrase) return (r1:r2)) @@ -857,9 +851,9 @@ return_path = header "Return-Path:" path path :: CharParser a String-path = unfold ( do char '<'- r <- choice [ try addr_spec, do { cfws; return [] } ]- char '>'+path = unfold ( do _ <- char '<'+ r <- choice [ try addr_spec, do { _ <- cfws; return [] } ]+ _ <- char '>' return ("<" ++ r ++ ">") <|> obs_path )@@ -867,7 +861,7 @@ received :: CharParser a ([(String,String)], CalendarTime) received = header "Received" (do r1 <- name_val_list- char ';'+ _ <- char ';' r2 <- date_time return (r1,r2)) @@ -878,7 +872,7 @@ name_val_pair :: CharParser a (String,String) name_val_pair = do r1 <- item_name- cfws+ _ <- cfws r2 <- item_value return (r1,r2) <?> "a name/value pair"@@ -906,9 +900,9 @@ optional_field :: CharParser a (String,String) optional_field = do n <- field_name- char ':'+ _ <- char ':' b <- unstructured- crlf+ _ <- crlf return (n,b) <?> "optional (unspecified) header line" @@ -934,7 +928,7 @@ -- character. obs_qp :: CharParser a String-obs_qp = do char '\\'+obs_qp = do _ <- char '\\' c <- satisfy (\c -> ord c `elem` [0..127]) return ['\\',c] <?> "any quoted US-ASCII character"@@ -973,9 +967,9 @@ obs_phrase = do r1 <- word r2 <- many $ choice [ word , string "."- , do { cfws; return [] }+ , do { _ <- cfws; return [] } ]- return (r1 : (filter (/=[]) r2))+ return (r1 : filter (/=[]) r2) -- |Match a \"phrase list\" syntax and return the list of 'String's -- that make up the phrase. In contrast to a 'phrase', the@@ -984,7 +978,7 @@ obs_phrase_list :: CharParser a [String] obs_phrase_list = do r1 <- many1 (do r <- option [] phrase- unfold $ char ','+ _ <- unfold $ char ',' return (filter (/=[]) r)) r2 <- option [] phrase return (concat r1 ++ r2)@@ -1066,9 +1060,9 @@ , do { r <- oneOf ['A'..'I']; return $ (ord r - 64) * 60*60 } <?> "military zone spec" , do { r <- oneOf ['K'..'M']; return $ (ord r - 65) * 60*60 } <?> "military zone spec" , do { r <- oneOf ['N'..'Y']; return $ -(ord r - 77) * 60*60 } <?> "military zone spec"- , do { char 'Z'; return 0 } <?> "military zone spec"+ , do { _ <- char 'Z'; return 0 } <?> "military zone spec" ]- where mkZone n o = try $ do { string n; return (o*60*60) }+ where mkZone n o = try $ do { _ <- string n; return (o*60*60) } -- * Obsolete Addressing (section 4.4)@@ -1095,10 +1089,10 @@ -- actual 'addr_spec' address. obs_angle_addr :: CharParser a String-obs_angle_addr = unfold (do char '<'+obs_angle_addr = unfold (do _ <- char '<' _ <- option [] obs_route addr <- addr_spec- char '>'+ _ <- char '>' return addr) -- TODO: route is lost here. <?> "obsolete angle address" @@ -1107,7 +1101,7 @@ -- 'obs_domain_list' for the actual parsing. obs_route :: CharParser a [String]-obs_route = unfold (do { r <- obs_domain_list; char ':'; return r })+obs_route = unfold (do { r <- obs_domain_list; _ <- char ':'; return r }) <?> "route of an obsolete angle address" -- |This parser parses a list of domain names, each of them prefaced@@ -1115,11 +1109,11 @@ -- 'domain's is returned - and may be empty. obs_domain_list :: CharParser a [String]-obs_domain_list = do char '@'+obs_domain_list = do _ <- char '@' r1 <- domain- r2 <- many (do cfws <|> string ","+ r2 <- many (do _ <- cfws <|> string "," optional cfws- char '@'+ _ <- char '@' r <- domain return r) return (r1 : r2)@@ -1131,7 +1125,7 @@ obs_local_part :: CharParser a String obs_local_part = do r1 <- word- r2 <- many (do string "."+ r2 <- many (do _ <- string "." r <- word return ('.' : r)) return (r1 ++ concat r2)@@ -1143,7 +1137,7 @@ obs_domain :: CharParser a String obs_domain = do r1 <- atom- r2 <- many (do string "."+ r2 <- many (do _ <- string "." r <- atom return ('.' : r)) return (r1 ++ concat r2)@@ -1169,7 +1163,7 @@ obs_mbox_list :: CharParser a [NameAddr] obs_mbox_list = do r1 <- many1 (try (do r <- maybeOption mailbox- unfold $ char ','+ _ <- unfold $ char ',' return r)) r2 <- maybeOption mailbox return [x | Just x <- r1 ++ [r2]]@@ -1184,7 +1178,7 @@ obs_addr_list :: CharParser a [NameAddr] obs_addr_list = do r1 <- many1 (try (do r <- maybeOption address optional cfws- char ','+ _ <- char ',' optional cfws return r)) r2 <- maybeOption address@@ -1288,7 +1282,7 @@ -- folding and the obsolete phrase syntax. obs_in_reply_to :: CharParser a [String]-obs_in_reply_to = obs_header "In-Reply-To" (do r <- many ( do {phrase; return [] }+obs_in_reply_to = obs_header "In-Reply-To" (do r <- many ( do {_ <- phrase; return [] } <|> msg_id ) return (filter (/=[]) r))@@ -1297,7 +1291,7 @@ -- folding and the obsolete phrase syntax. obs_references :: CharParser a [String]-obs_references = obs_header "References" (do r <- many ( do { phrase; return [] }+obs_references = obs_header "References" (do r <- many ( do { _ <- phrase; return [] } <|> msg_id ) return (filter (/=[]) r))@@ -1409,9 +1403,9 @@ obs_optional :: CharParser a (String,String) obs_optional = do n <- field_name- many wsp- char ':'+ _ <- many wsp+ _ <- char ':' b <- unstructured- crlf+ _ <- crlf return (n,b) <?> "optional (unspecified) header line"
example/message-test.hs view
@@ -15,7 +15,7 @@ -- 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 ('\r':'\n':xs) = '\r' : '\n' : fixEol xs+fixEol ('\n':xs) = '\r' : '\n' : fixEol xs+fixEol (x:xs) = x : fixEol xs fixEol [] = []
example/smtp-test.hs view
@@ -9,5 +9,4 @@ main :: IO () main = do input <- getContents- mapM (print . parse smtpCmd "") [ l ++ "\r\n" | l <- lines input ]- return ()+ mapM_ (print . parse smtpCmd "") [ l ++ "\r\n" | l <- lines input ]
hsemail.cabal view
@@ -1,5 +1,5 @@ Name: hsemail-Version: 1.6+Version: 1.7 Copyright: (c) 2004-2010 Peter Simons License: BSD3 License-File: LICENSE@@ -11,7 +11,7 @@ Description: Parsers for the syntax defined in RFC2821 and 2822 Cabal-Version: >= 1.6 Build-Type: Simple-Tested-With: GHC == 6.12.1+Tested-With: GHC == 6.12.3 Extra-Source-Files: example/message-test.hs example/message-test.input