diff --git a/Text/ParserCombinators/Parsec/Rfc2234.hs b/Text/ParserCombinators/Parsec/Rfc2234.hs --- a/Text/ParserCombinators/Parsec/Rfc2234.hs +++ b/Text/ParserCombinators/Parsec/Rfc2234.hs @@ -1,6 +1,6 @@ {- | Module : Text.ParserCombinators.Parsec.Rfc2234 - Copyright : (c) 2012 Peter Simons + Copyright : (c) 2013 Peter Simons License : BSD3 Maintainer : simons@cryp.to diff --git a/Text/ParserCombinators/Parsec/Rfc2821.hs b/Text/ParserCombinators/Parsec/Rfc2821.hs --- a/Text/ParserCombinators/Parsec/Rfc2821.hs +++ b/Text/ParserCombinators/Parsec/Rfc2821.hs @@ -1,6 +1,6 @@ {- | Module : Text.ParserCombinators.Parsec.Rfc2821 - Copyright : (c) 2012 Peter Simons + Copyright : (c) 2013 Peter Simons License : BSD3 Maintainer : simons@cryp.to diff --git a/Text/ParserCombinators/Parsec/Rfc2822.hs b/Text/ParserCombinators/Parsec/Rfc2822.hs --- a/Text/ParserCombinators/Parsec/Rfc2822.hs +++ b/Text/ParserCombinators/Parsec/Rfc2822.hs @@ -1,6 +1,6 @@ {- | Module : Text.ParserCombinators.Parsec.Rfc2822 - Copyright : (c) 2012 Peter Simons + Copyright : (c) 2013 Peter Simons License : BSD3 Maintainer : simons@cryp.to @@ -262,8 +262,8 @@ return (CalendarTime y m d (tdHour td) (tdMin td) (tdSec td) 0 wd 0 "" z False) "date/time specification" --- |This parser will match a 'day_name', optionally wrapped in folding --- whitespace, or an 'obs_day_of_week' and return it's 'Day' value. +-- |This parser matches a 'day_name' or an 'obs_day_of_week' (optionally +-- wrapped in folding whitespace) and return its 'Day' value. day_of_week :: CharParser a Day day_of_week = try (between (optional fws) (optional fws) day_name "name of a day-of-the-week") @@ -293,7 +293,7 @@ return (y,m,d) "date specification" --- |This parser will match a four digit number and return it's integer +-- |This parser will match a four digit number and return its integer -- value. No range checking is performed. year :: CharParser a Int @@ -302,7 +302,7 @@ "year" -- |This parser will match a 'month_name', optionally wrapped in --- folding whitespace, or an 'obs_month' and return it's 'Month' +-- folding whitespace, or an 'obs_month' and return its 'Month' -- value. month :: CharParser a Month @@ -361,7 +361,7 @@ return (TimeDiff 0 0 0 h m s 0) "time specification" --- |This parser will match a two-digit number and return it's integer +-- |This parser will match a two-digit number and return its integer -- value. No range checking is performed. hour :: CharParser a Int @@ -369,7 +369,7 @@ return (read r :: Int) "hour" --- |This parser will match a two-digit number and return it's integer +-- |This parser will match a two-digit number and return its integer -- value. No range checking is performed. minute :: CharParser a Int @@ -377,7 +377,7 @@ return (read r :: Int) "minute" --- |This parser will match a two-digit number and return it's integer +-- |This parser will match a two-digit number and return its integer -- value. No range checking takes place. second :: CharParser a Int @@ -781,12 +781,16 @@ -- ** Informational fields (section 3.6.5) --- |Parse a \"@Subject:@\" header line and return it's contents verbatim. +-- |Parse a \"@Subject:@\" header line and return its contents verbatim. +-- Please note that all whitespace and/or comments are preserved, i.e. +-- the result of parsing @\"Subject: foo\"@ is @\" foo\"@, not @\"foo\"@. subject :: CharParser a String subject = header "Subject" unstructured --- |Parse a \"@Comments:@\" header line and return it's contents verbatim. +-- |Parse a \"@Comments:@\" header line and return its contents verbatim. +-- Please note that all whitespace and/or comments are preserved, i.e. +-- the result of parsing @\"Comments: foo\"@ is @\" foo\"@, not @\"foo\"@. comments :: CharParser a String comments = header "Comments" unstructured @@ -855,13 +859,14 @@ -- ** Trace fields (section 3.6.7) return_path :: CharParser a String -return_path = header "Return-Path:" path +return_path = header "Return-Path" path path :: CharParser a String -path = unfold ( do _ <- char '<' - r <- choice [ try addr_spec, do { _ <- cfws; return [] } ] - _ <- char '>' - return ("<" ++ r ++ ">") +path = unfold ( try (do _ <- char '<' + r <- option "" addr_spec + _ <- char '>' + return ("<" ++ r ++ ">") + ) <|> obs_path ) "return path spec" @@ -1100,7 +1105,8 @@ _ <- option [] obs_route addr <- addr_spec _ <- char '>' - return addr) -- TODO: route is lost here. + return ("<" ++ addr ++ ">") -- TODO: route is lost here. + ) "obsolete angle address" -- |This parser parses the \"route\" part of 'obs_angle_addr' and @@ -1163,7 +1169,7 @@ -- -- But this one is - contrary to all intuition - not: -- --- > "simons@example.org" +-- > "joe@example.org" -- -- Strange, isn't it? diff --git a/hsemail.cabal b/hsemail.cabal --- a/hsemail.cabal +++ b/hsemail.cabal @@ -1,6 +1,6 @@ Name: hsemail -Version: 1.7.3 -Copyright: (c) 2012 Peter Simons +Version: 1.7.4 +Copyright: (c) 2013 Peter Simons License: BSD3 License-File: LICENSE Author: Peter Simons , Gero Kriependorf , Marty Pauley diff --git a/self-test.hs b/self-test.hs --- a/self-test.hs +++ b/self-test.hs @@ -1,3 +1,15 @@ +{- + Module : Main + Copyright : (c) 2013 Peter Simons + License : BSD3 + + Maintainer : simons@cryp.to + Stability : provisional + Portability : portable + + HsEmail regression test suite. +-} + module Main ( main ) where import Test.Hspec @@ -18,32 +30,54 @@ main :: IO () main = hspec $ do - describe "Rfc822.date_time" $ + describe "Rfc2822.date_time" $ it "parses hand-picked times correctly" $ parseTest date_time "Fri, 21 Dec 2012 00:07:43 +0300" `shouldReturn` CalendarTime 2012 December 21 0 7 43 0 Friday 0 "" 10800 False - describe "Rfc822.day" $ + describe "Rfc2822.day" $ do it "parses a hand-picked day-of-months correctly" $ do parseTest day "00" `shouldReturn` 0 parseTest day "09" `shouldReturn` 9 parseTest day "15" `shouldReturn` 15 - describe "Rfc822.day" $ it "does not perform range checking" $ parseTest day "99" `shouldReturn` 99 - describe "Rfc822.day" $ it "fails properly on incomplete input" $ do parseFailure day "Mon" parseFailure day "Thu" - describe "Rfc822.obs_mbox_list" $ + describe "Rfc2822.obs_mbox_list" $ do it "parses hand-picked inputs correctly" $ do parseTest obs_mbox_list "," `shouldReturn` [] parseTest obs_mbox_list "Joe Doe ,( \r\n bla),,jane@\r\n example.net \r\n (Jane Doe)," `shouldReturn` [NameAddr (Just "Joe Doe") "joe@example.org",NameAddr Nothing "jane@example.net"] - describe "Rfc822.obs_mbox_list" $ it "fails properly on incomplete input" $ parseFailure obs_mbox_list "foo@example.org" + + describe "Rfc2822.subject" $ + it "doesn't consume leading whitespace" $ + parseTest subject "Subject: foo\r\n" `shouldReturn` " foo" + + describe "Rfc2822.comment" $ + it "doesn't consume leading whitespace" $ + parseTest comments "Comments: foo\r\n" `shouldReturn` " foo" + + describe "Rfc2822.addr_spec" $ + it "parses hand-picked inputs correctly" $ + parseTest addr_spec "joe@example.de" `shouldReturn` "joe@example.de" + + describe "Rfc2822.path" $ do + it "parses hand-picked inputs correctly" $ + parseTest path " " `shouldReturn` "" + it "loses the route-part of an obsolete routing address" $ + parseTest path "<@example1.org,@example2.org:joe@example.org>" `shouldReturn` "" + + describe "Rfc2822.return_path" $ do + it "parses hand-picked inputs correctly" $ do + parseTest return_path "Return-Path: \r\n" `shouldReturn` "" + parseTest return_path "Return-Path: <>\r\n" `shouldReturn` "<>" + it "loses the route-part of an obsolete routing address" $ + parseTest return_path "Return-Path: <@example1.org,@example2.org:joe@example.org>\r\n" `shouldReturn` ""