| | |
| 1 | 1 | {- | |
| 2 | 2 | Module : Text.ParserCombinators.Parsec.Rfc2822 |
| Copyright : (c) 2007 by Peter Simons |
| Copyright : (c) 2008 Peter Simons |
| 4 | 4 | License : BSD3 |
| 5 | 5 | |
| 6 | 6 | Maintainer : simons@cryp.to |
| … | … | |
| 11 | 11 | RFC2822, \"Internet Message Format\", |
| 12 | 12 | <http://www.faqs.org/rfcs/rfc2822.html>. |
| 13 | 13 | |
| /Please note:/ The module is a mess. I keep it around as |
| a reminder that it needs to be rewritten, mostly. |
| Nevertheless, some parsers -- like 'date_time', for |
| example -- are genuinely useful. |
| /Please note:/ The module is not particularly well tested. |
| 18 | 15 | -} |
| 19 | 16 | |
| 20 | 17 | module Text.ParserCombinators.Parsec.Rfc2822 where |
| 21 | 18 | |
| import Text.ParserCombinators.Parsec |
| import System.Time |
| 23 | 20 | import Data.Char ( ord ) |
| 24 | 21 | import Data.List ( intersperse ) |
| import System.Time |
| import Text.ParserCombinators.Parsec.Rfc2234 |
| hiding ( quoted_pair, quoted_string ) |
| import Control.Monad ( liftM ) |
| import Text.ParserCombinators.Parsec |
| import Text.ParserCombinators.Parsec.Rfc2234 hiding ( quoted_pair, quoted_string ) |
| 28 | 25 | |
| data NameAddr = NameAddr { nameAddr_name :: Maybe String |
| , nameAddr_addr :: String } |
| deriving (Show,Eq) |
|
| 33 | 26 | -- * Useful parser combinators |
| 34 | 27 | |
| -- |Return @Nothing@ if the given parser doesn't match. This |
| -- combinator is included in the latest parsec distribution as |
| -- @optionMaybe@, but ghc-6.6.1 apparently doesn't have it. |
|
| maybeOption :: GenParser tok st a -> GenParser tok st (Maybe a) |
| maybeOption p = option Nothing (liftM Just p) |
|
| 35 | 35 | -- |@unfold@ @=@ @between (optional cfws) (optional cfws)@ |
| 36 | 36 | |
| 37 | 37 | unfold :: CharParser a b -> CharParser a b |
| … | … | |
| 399 | 399 | |
| 400 | 400 | -- * Address Specification (section 3.4) |
| 401 | 401 | |
| -- |A NameAddr is composed of an optional realname a mandatory |
| -- e-mail 'address'. |
|
| data NameAddr = NameAddr { nameAddr_name :: Maybe String |
| , nameAddr_addr :: String |
| } |
| deriving (Show,Eq) |
|
| 402 | 410 | -- |Parse a single 'mailbox' or an address 'group' and return the |
| 403 | 411 | -- address(es). |
| 404 | 412 | |
| … | … | |
| 425 | 425 | -- and return the address. |
| 426 | 426 | |
| 427 | 427 | name_addr :: CharParser a NameAddr |
| name_addr = do name <- optionMaybe display_name |
| name_addr = do name <- maybeOption display_name |
| 429 | 429 | addr <- angle_addr |
| 430 | 430 | return (NameAddr name addr) |
| 431 | 431 | <?> "name address" |
| … | … | |
| 1169 | 1169 | -- Strange, isn't it? |
| 1170 | 1170 | |
| 1171 | 1171 | obs_mbox_list :: CharParser a [NameAddr] |
| obs_mbox_list = do r1 <- many1 (try (do r <- optionMaybe mailbox |
| obs_mbox_list = do r1 <- many1 (try (do r <- maybeOption mailbox |
| 1173 | 1173 | unfold $ char ',' |
| 1174 | 1174 | return r)) |
| r2 <- optionMaybe mailbox |
| r2 <- maybeOption mailbox |
| 1176 | 1176 | return [x | Just x <- r1 ++ [r2]] |
| 1177 | 1177 | <?> "obsolete syntax for a list of mailboxes" |
| 1178 | 1178 | |
| … | … | |
| 1183 | 1183 | -- information is lost. |
| 1184 | 1184 | |
| 1185 | 1185 | obs_addr_list :: CharParser a [NameAddr] |
| obs_addr_list = do r1 <- many1 (try (do r <- optionMaybe address |
| obs_addr_list = do r1 <- many1 (try (do r <- maybeOption address |
| 1187 | 1187 | optional cfws |
| 1188 | 1188 | char ',' |
| 1189 | 1189 | optional cfws |
| 1190 | 1190 | return r)) |
| r2 <- optionMaybe address |
| r2 <- maybeOption address |
| 1192 | 1192 | return (concat [x | Just x <- r1 ++ [r2]]) |
| 1193 | 1193 | <?> "obsolete syntax for a list of addresses" |
| 1194 | 1194 | |
