Commit bd0445163715196e6b53fd6d56b129b3ebfa6a47

Patch received from David Leuschner <david@loisch.de> in
<E1JJcdb-000671-7A@umidev.de>.
Text/ParserCombinators/Parsec/Rfc2822.hs
(61 / 55)
  
2626import Text.ParserCombinators.Parsec.Rfc2234
2727 hiding ( quoted_pair, quoted_string )
2828
29data NameAddr = NameAddr { nameAddr_name :: Maybe String
30 , nameAddr_addr :: String }
31 deriving (Show,Eq)
32
2933-- * Useful parser combinators
3034
3135-- |@unfold@ @=@ @between (optional cfws) (optional cfws)@
……
402402-- |Parse a single 'mailbox' or an address 'group' and return the
403403-- address(es).
404404
405address :: CharParser a [String]
405address :: CharParser a [NameAddr]
406406address = try (do { r <- mailbox; return [r] }) <|> group
407407 <?> "address"
408408
409409-- |Parse a 'name_addr' or an 'addr_spec' and return the
410410-- address.
411411
412mailbox :: CharParser a String
413mailbox = try name_addr <|> addr_spec
412mailbox :: CharParser a NameAddr
413mailbox = try name_addr <|> (addr_spec >>= return . NameAddr Nothing)
414414 <?> "mailbox"
415415
416416-- |Parse an 'angle_addr', optionally prefaced with a 'display_name',
417417-- and return the address.
418418
419name_addr :: CharParser a String
420name_addr = do optional display_name
421 angle_addr
419name_addr :: CharParser a NameAddr
420name_addr = do name <- optionMaybe display_name
421 addr <- angle_addr
422 return (NameAddr name addr)
422423 <?> "name address"
423424
424425-- |Parse an 'angle_addr' or an 'obs_angle_addr' and return the address.
……
444444--
445445-- > Right ["user1@example.org","user2@example.org"]
446446
447group :: CharParser a [String]
447group :: CharParser a [NameAddr]
448448group = do display_name
449449 char ':'
450450 r <- option [] mailbox_list
……
454454
455455-- |Parse and return a 'phrase'.
456456
457display_name :: CharParser a [String]
458display_name = phrase <?> "display name"
457display_name :: CharParser a String
458display_name = phrase >>= return . concat . intersperse " "
459 <?> "display name"
459460
460461-- |Parse a list of 'mailbox' addresses, every two addresses being
461462-- separated by a comma, and return the list of found address(es).
462463
463mailbox_list :: CharParser a [String]
464mailbox_list :: CharParser a [NameAddr]
464465mailbox_list = sepBy mailbox (char ',') <?> "mailbox list"
465466
466467-- |Parse a list of 'address' addresses, every two addresses being
467468-- separated by a comma, and return the list of found address(es).
468469
469address_list :: CharParser a [String]
470address_list :: CharParser a [NameAddr]
470471address_list = do { r <-sepBy address (char ','); return (concat r) }
471472 <?> "address list"
472473
……
580580-- of the corresponding parser.
581581
582582data Field = OptionalField String String
583 | From [String]
584 | Sender String
583 | From [NameAddr]
584 | Sender NameAddr
585585 | ReturnPath String
586 | ReplyTo [String]
587 | To [String]
588 | Cc [String]
589 | Bcc [String]
586 | ReplyTo [NameAddr]
587 | To [NameAddr]
588 | Cc [NameAddr]
589 | Bcc [NameAddr]
590590 | MessageID String
591591 | InReplyTo [String]
592592 | References [String]
……
595595 | Keywords [[String]]
596596 | Date CalendarTime
597597 | ResentDate CalendarTime
598 | ResentFrom [String]
599 | ResentSender String
600 | ResentTo [String]
601 | ResentCc [String]
602 | ResentBcc [String]
598 | ResentFrom [NameAddr]
599 | ResentSender NameAddr
600 | ResentTo [NameAddr]
601 | ResentCc [NameAddr]
602 | ResentBcc [NameAddr]
603603 | ResentMessageID String
604 | ResentReplyTo [String]
604 | ResentReplyTo [NameAddr]
605605 | Received ([(String,String)], CalendarTime)
606606 | ObsReceived [(String,String)]
607607 deriving (Show)
……
660660-- |Parse a \"@From:@\" header line and return the 'mailbox_list'
661661-- address(es) contained in it.
662662
663from :: CharParser a [String]
663from :: CharParser a [NameAddr]
664664from = header "From" mailbox_list
665665
666666-- |Parse a \"@Sender:@\" header line and return the 'mailbox' address
667667-- contained in it.
668668
669sender :: CharParser a String
669sender :: CharParser a NameAddr
670670sender = header "Sender" mailbox
671671
672672-- |Parse a \"@Reply-To:@\" header line and return the 'address_list'
673673-- address(es) contained in it.
674674
675reply_to :: CharParser a [String]
675reply_to :: CharParser a [NameAddr]
676676reply_to = header "Reply-To" address_list
677677
678678
……
681681-- |Parse a \"@To:@\" header line and return the 'address_list'
682682-- address(es) contained in it.
683683
684to :: CharParser a [String]
684to :: CharParser a [NameAddr]
685685to = header "To" address_list
686686
687687-- |Parse a \"@Cc:@\" header line and return the 'address_list'
688688-- address(es) contained in it.
689689
690cc :: CharParser a [String]
690cc :: CharParser a [NameAddr]
691691cc = header "Cc" address_list
692692
693693-- |Parse a \"@Bcc:@\" header line and return the 'address_list'
694694-- address(es) contained in it.
695695
696bcc :: CharParser a [String]
696bcc :: CharParser a [NameAddr]
697697bcc = header "Bcc" (try address_list <|> do { optional cfws; return [] })
698698
699699-- ** Identification fields (section 3.6.4)
……
804804-- |Parse a \"@Resent-From:@\" header line and return the 'mailbox_list'
805805-- address(es) contained in it.
806806
807resent_from :: CharParser a [String]
807resent_from :: CharParser a [NameAddr]
808808resent_from = header "Resent-From" mailbox_list
809809
810810
811811-- |Parse a \"@Resent-Sender:@\" header line and return the 'mailbox_list'
812812-- address(es) contained in it.
813813
814resent_sender :: CharParser a String
814resent_sender :: CharParser a NameAddr
815815resent_sender = header "Resent-Sender" mailbox
816816
817817
818818-- |Parse a \"@Resent-To:@\" header line and return the 'mailbox'
819819-- address contained in it.
820820
821resent_to :: CharParser a [String]
821resent_to :: CharParser a [NameAddr]
822822resent_to = header "Resent-To" address_list
823823
824824-- |Parse a \"@Resent-Cc:@\" header line and return the 'address_list'
825825-- address(es) contained in it.
826826
827resent_cc :: CharParser a [String]
827resent_cc :: CharParser a [NameAddr]
828828resent_cc = header "Resent-Cc" address_list
829829
830830-- |Parse a \"@Resent-Bcc:@\" header line and return the 'address_list'
831831-- address(es) contained in it. (This list may be empty.)
832832
833resent_bcc :: CharParser a [String]
833resent_bcc :: CharParser a [NameAddr]
834834resent_bcc = header "Resent-Bcc" ( try address_list
835835 <|> do optional cfws
836836 return []
……
11601160--
11611161-- Strange, isn't it?
11621162
1163obs_mbox_list :: CharParser a [String]
1164obs_mbox_list = do r1 <- many1 (try (do r <- option [] mailbox
1163obs_mbox_list :: CharParser a [NameAddr]
1164obs_mbox_list = do r1 <- many1 (try (do r <- optionMaybe mailbox
11651165 unfold $ char ','
11661166 return r))
1167 r2 <- option [] mailbox
1168 return (filter (/=[]) (r1 ++ [r2]))
1167 r2 <- optionMaybe mailbox
1168 return [x | Just x <- r1 ++ [r2]]
11691169 <?> "obsolete syntax for a list of mailboxes"
11701170
11711171-- |This parser is identical to 'obs_mbox_list' but parses a list of
……
11741174-- parser will return a simple list of addresses; the grouping
11751175-- information is lost.
11761176
1177obs_addr_list :: CharParser a [String]
1178obs_addr_list = do r1 <- many1 (try (do r <- option [] address
1177obs_addr_list :: CharParser a [NameAddr]
1178obs_addr_list = do r1 <- many1 (try (do r <- optionMaybe address
11791179 optional cfws
11801180 char ','
11811181 optional cfws
1182 return (concat r)))
1183 r2 <- option [] address
1184 return (filter (/=[]) (r1 ++ r2))
1182 return r))
1183 r2 <- optionMaybe address
1184 return (concat [x | Just x <- r1 ++ [r2]])
11851185 <?> "obsolete syntax for a list of addresses"
11861186
11871187
……
12301230-- |Parse a 'from' header line but allow for the obsolete
12311231-- folding syntax.
12321232
1233obs_from :: CharParser a [String]
1233obs_from :: CharParser a [NameAddr]
12341234obs_from = obs_header "From" mailbox_list
12351235
12361236-- |Parse a 'sender' header line but allow for the obsolete
12371237-- folding syntax.
12381238
1239obs_sender :: CharParser a String
1239obs_sender :: CharParser a NameAddr
12401240obs_sender = obs_header "Sender" mailbox
12411241
12421242-- |Parse a 'reply_to' header line but allow for the obsolete
12431243-- folding syntax.
12441244
1245obs_reply_to :: CharParser a [String]
1245obs_reply_to :: CharParser a [NameAddr]
12461246obs_reply_to = obs_header "Reply-To" mailbox_list
12471247
12481248
……
12511251-- |Parse a 'to' header line but allow for the obsolete
12521252-- folding syntax.
12531253
1254obs_to :: CharParser a [String]
1254obs_to :: CharParser a [NameAddr]
12551255obs_to = obs_header "To" address_list
12561256
12571257-- |Parse a 'cc' header line but allow for the obsolete
12581258-- folding syntax.
12591259
1260obs_cc :: CharParser a [String]
1260obs_cc :: CharParser a [NameAddr]
12611261obs_cc = obs_header "Cc" address_list
12621262
12631263-- |Parse a 'bcc' header line but allow for the obsolete
12641264-- folding syntax.
12651265
1266obs_bcc :: CharParser a [String]
1266obs_bcc :: CharParser a [NameAddr]
12671267obs_bcc = header "Bcc" ( try address_list
12681268 <|> do { optional cfws; return [] }
12691269 )
……
13351335-- |Parse a 'resent_from' header line but allow for the obsolete
13361336-- folding syntax.
13371337
1338obs_resent_from :: CharParser a [String]
1338obs_resent_from :: CharParser a [NameAddr]
13391339obs_resent_from = obs_header "Resent-From" mailbox_list
13401340
13411341-- |Parse a 'resent_sender' header line but allow for the obsolete
13421342-- folding syntax.
13431343
1344obs_resent_send :: CharParser a String
1344obs_resent_send :: CharParser a NameAddr
13451345obs_resent_send = obs_header "Resent-Sender" mailbox
13461346
13471347-- |Parse a 'resent_date' header line but allow for the obsolete
……
13531353-- |Parse a 'resent_to' header line but allow for the obsolete
13541354-- folding syntax.
13551355
1356obs_resent_to :: CharParser a [String]
1356obs_resent_to :: CharParser a [NameAddr]
13571357obs_resent_to = obs_header "Resent-To" mailbox_list
13581358
13591359-- |Parse a 'resent_cc' header line but allow for the obsolete
13601360-- folding syntax.
13611361
1362obs_resent_cc :: CharParser a [String]
1362obs_resent_cc :: CharParser a [NameAddr]
13631363obs_resent_cc = obs_header "Resent-Cc" mailbox_list
13641364
13651365-- |Parse a 'resent_bcc' header line but allow for the obsolete
13661366-- folding syntax.
13671367
1368obs_resent_bcc :: CharParser a [String]
1368obs_resent_bcc :: CharParser a [NameAddr]
13691369obs_resent_bcc = obs_header "Bcc" ( try address_list
13701370 <|> do { optional cfws; return [] }
13711371 )
……
13791379-- |Parse a @Resent-Reply-To@ header line but allow for the
13801380-- obsolete folding syntax.
13811381
1382obs_resent_reply :: CharParser a [String]
1382obs_resent_reply :: CharParser a [NameAddr]
13831383obs_resent_reply = obs_header "Resent-Reply-To" address_list
13841384
13851385