WIP: RFC5322.

src/GenericParser/EmailAddress.purs

@@ -8,7 +8,7 @@ import Control.Alt ((<|>))
 import Data.Array as A
 import Data.Char as C
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), maybe)
 import Data.String.CodeUnits as CU
 
 import GenericParser.Parser (Parser(..)
@@ -24,6 +24,9 @@ data EmailError
   = InvalidCharacter
   | InvalidDomain (Maybe DomainError)
 
+id :: forall a. a -> a
+id x = x
+
 -- | obs-FWS: obsolete folding white space.
 -- |
 -- | obs-FWS         =   1*WSP *(CRLF 1*WSP)
@@ -95,44 +98,45 @@ cfws = do void $ many1 $ do _ <- tryMaybe fws
 -- | TODO: `address`: email address.
 -- |
 -- | address         =   mailbox / group
---address :: forall e. Parser e String
+address :: forall e. Parser e String
---address = mailbox <|> group
+address = mailbox <|> group
 
 -- | TODO: `mailbox`: mail address.
 -- |
 -- | mailbox         =   name-addr / addr-spec
---mailbox :: forall e. Parser e String
+mailbox :: forall e. Parser e String
---mailbox = name_addr <|> addr_spec
+mailbox = name_addr <|> addr_spec
 
 -- | TODO: `name_addr`: address name.
 -- |
 -- | name-addr       =   [display-name] angle-addr
---name_addr :: forall e. Parser e String
+name_addr :: forall e. Parser e String
---name_addr = do _ <- tryMaybe display_name
+name_addr = do _ <- tryMaybe display_name
---               angle_addr
+               angle_addr
 
 -- | TODO: `angle_addr` address specification between '<' and '>' characters.
 -- |
 -- | angle-addr      =   [CFWS] "<" addr-spec ">" [CFWS] / obs-angle-addr
---angle_addr :: forall e. Parser e String
+angle_addr :: forall e. Parser e String
---angle_addr = do _ <- tryMaybe cfws
+angle_addr = do _ <- tryMaybe cfws
---                _ <- char '<'
+                _ <- char '<'
---                a <- addr_spec
+                a <- addr_spec
---                _ <- char '>'
+                _ <- char '>'
---                _ <- tryMaybe cfws
+                _ <- tryMaybe cfws
---                pure a
+                pure a
---              <|> obs_angle_addr
+              <|> obs_angle_addr
 
 -- | TODO: `group`: a list of email addresses.
 -- |
 -- | group           =   display-name ":" [group-list] ";" [CFWS]
---group :: forall e. Parser e (Array String)
+group :: forall e. Parser e String
---group = do _ <- display_name
+group = do _ <- display_name
---           _ <- char ':'
+           _ <- char ':'
---           mg <- tryMaybe group_list
+           xs <- tryMaybe group_list
---           _ <- char ';'
+           _ <- char ';'
---           _ <- tryMaybe cfws
+           _ <- tryMaybe cfws
---           pure $ maybe [] xs
+           let res = ":" <> maybe "" id xs <> ";"
+           pure res
 
 -- | `display_name`: displayed name, not the actual email address.
 -- |
@@ -140,11 +144,25 @@ cfws = do void $ many1 $ do _ <- tryMaybe fws
 display_name :: forall e. Parser e String
 display_name = phrase
 
---mailbox-list    =   (mailbox *("," mailbox)) / obs-mbox-list
+-- | `mailbox_list`
---
+-- |
+-- | mailbox-list    =   (mailbox *("," mailbox)) / obs-mbox-list
+mailbox_list :: forall e. Parser e String
+mailbox_list = do mb <- mailbox
+                  xs <- A.many $ do _ <- char ','
+                                    mx <- mailbox
+                                    pure $ "," <> mx
+                  pure $ mb <> A.fold xs
+                <|> obs_mbox_list
+
 --address-list    =   (address *("," address)) / obs-addr-list
---
+
---group-list      =   mailbox-list / CFWS / obs-group-list
+-- | `group_list`
+-- |
+-- | group-list      =   mailbox-list / CFWS / obs-group-list
+group_list :: forall e. Parser e String
+group_list = mailbox_list <|> do _ <- cfws <|> obs_group_list
+                                 pure ""
 
 
 -- | `atext`: atom accepted characters.
@@ -221,9 +239,21 @@ specials = char '('
            <|> char '"'
 
 
--- addr-spec       =   local-part "@" domain
+-- | `addr_spec`
---
+-- |
--- local-part      =   dot-atom / quoted-string / obs-local-part
+-- | addr-spec       =   local-part "@" domain
+addr_spec :: forall e. Parser e String
+addr_spec = do lpart <- local_part
+               _ <- char '@'
+               dom <- domain
+               pure $ lpart <> "@" <> dom
+
+-- | `local_part`
+-- |
+-- | local-part      =   dot-atom / quoted-string / obs-local-part
+local_part :: forall e. Parser e String
+local_part = dot_atom <|> quoted_string <|> obs_local_part
+
 
 -- | `domain`
 -- |
@@ -258,14 +288,14 @@ dtext = CU.singleton <$> sat cond <|> obs_dtext
 -- | TODO: `obs_angle_addr`: obsolete address specification between '<' and '>' characters.
 -- |
 -- | obs-angle-addr  =   [CFWS] "<" obs-route addr-spec ">" [CFWS]
---obs_angle_addr :: forall e. Parser e String
+obs_angle_addr :: forall e. Parser e String
---obs_angle_addr = do _ <- tryMaybe cfws
+obs_angle_addr = do _ <- tryMaybe cfws
---                    _ <- char '<'
+                    _ <- char '<'
---                    r <- obs_route
+                    r <- obs_route
---                    a <- addr_spec
+                    a <- addr_spec
---                    _ <- char '>'
+                    _ <- char '>'
---                    _ <- tryMaybe cfws
+                    _ <- tryMaybe cfws
---                    pure $ r <> a
+                    pure $ r <> a
 
 -- | `obs_route`
 -- |
@@ -285,14 +315,41 @@ obs_domain_list = do _ <- A.many $ cfws <|> do _ <- char ','
                      _ <- char '@'
                      domain
 
---obs-mbox-list   =   *([CFWS] ",") mailbox *("," [mailbox / CFWS])
+-- | `obs_mbox_list`
---
+-- |
+-- | obs-mbox-list   =   *([CFWS] ",") mailbox *("," [mailbox / CFWS])
+obs_mbox_list :: forall e. Parser e String
+obs_mbox_list = do _ <- A.many $ do _ <- cfws
+                                    _ <- char ','
+                                    pure unit
+                   mb <- mailbox
+                   xs <- A.many $ do _ <- char ','
+                                     x <- mailbox <|> do _ <- cfws
+                                                         pure ""
+                                     pure x
+                   pure $ mb <> A.fold xs
+
 --obs-addr-list   =   *([CFWS] ",") address *("," [address / CFWS])
---
+
---obs-group-list  =   1*([CFWS] ",") [CFWS]
+-- | `obs_group_list`
---
+-- |
---obs-local-part  =   word *("." word)
+-- | obs-group-list  =   1*([CFWS] ",") [CFWS]
---
+obs_group_list :: forall e. Parser e Unit
+obs_group_list = do _ <- many1 $ do _ <- tryMaybe cfws
+                                    char ','
+                    _ <- tryMaybe cfws
+                    pure unit
+
+-- | `obs_local_part`
+-- |
+-- | obs-local-part  =   word *("." word)
+obs_local_part :: forall e. Parser e String
+obs_local_part = do w <- word
+                    ws <- A.many $ do _ <- char '.'
+                                      w1 <- word
+                                      pure $ "." <> w1
+                    pure $ w <> A.fold ws
+
 -- | `obs_domain`
 -- |
 -- | obs-domain      =   atom *("." atom)
@@ -476,8 +533,8 @@ quoted_string = do _ <- tryMaybe cfws
 -- | (a) the first character is a letter,
 -- | (b) the last character is either a letter or a digit.
 -- | The rest can be any letter, digit, '-' or '.'.
-local_part :: Parser EmailError String
+local_part' :: Parser EmailError String
-local_part = do firstchar <- letter
+local_part' = do firstchar <- letter
                  rest <- until end (letter <|> digit <|> char '-' <|> char '.')
                  lastchar <- letter <|> digit
                  pure $ CU.fromCharArray $ [firstchar] <> rest <> [lastchar]
@@ -489,7 +546,7 @@ local_part = do firstchar <- letter
 
 -- | `email` is the parser for email addresses.
 email :: Parser EmailError String
-email = do login <- local_part
+email = do login <- local_part'
            _ <- char '@'
            input <- current_input
            case parse sub_eof input of