From 97b769133d4caa2530f33f9cd2ba9851707a52b7 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Mon, 29 Jan 2024 20:30:36 +0100
Subject: [PATCH] WIP: RFC5322

---
 src/GenericParser/EmailAddress.purs | 98 +++++++++++++++++++++++++----
 1 file changed, 86 insertions(+), 12 deletions(-)

diff --git a/src/GenericParser/EmailAddress.purs b/src/GenericParser/EmailAddress.purs
index 5cda2ac..5aa7ace 100644
--- a/src/GenericParser/EmailAddress.purs
+++ b/src/GenericParser/EmailAddress.purs
@@ -180,9 +180,26 @@ atext = alphanum
 atom :: forall e. Parser e String
 atom = CU.fromCharArray <$> do A.many atext
 
+-- | `dot_atom_text`
+-- |
 -- | dot-atom-text   =   1*atext *("." 1*atext)
+dot_atom_text :: forall e. Parser e String
+dot_atom_text = do xs0 <- many1 atext
+                   xs1 <- A.many $ do _ <- char '.'
+                                      xs <- many1 atext
+                                      pure $ "." <> CU.fromCharArray xs
+                   let str0 = CU.fromCharArray xs0
+                       str1 = A.fold xs1
+                   pure $ str0 <> str1
 
 -- | dot-atom        =   [CFWS] dot-atom-text [CFWS]
+-- |
+-- | dot-atom        =   [CFWS] dot-atom-text [CFWS]
+dot_atom :: forall e. Parser e String
+dot_atom = do _ <- tryMaybe cfws
+              x <- dot_atom_text
+              _ <- tryMaybe cfws
+              pure x
 
 -- | `specials`: special characters that do not appear in `atext`.
 -- |
@@ -207,10 +224,25 @@ specials = char '('
 -- addr-spec       =   local-part "@" domain
 --
 -- local-part      =   dot-atom / quoted-string / obs-local-part
---
--- domain          =   dot-atom / domain-literal / obs-domain
---
--- domain-literal  =   [CFWS] "[" *([FWS] dtext) [FWS] "]" [CFWS]
+
+-- | `domain`
+-- |
+-- | domain          =   dot-atom / domain-literal / obs-domain
+domain :: forall e. Parser e String
+domain = dot_atom <|> domain_literal <|> obs_domain
+
+-- | `domain_literal`
+-- |
+-- | domain-literal  =   [CFWS] "[" *([FWS] dtext) [FWS] "]" [CFWS]
+domain_literal :: forall e. Parser e String
+domain_literal = do _ <- tryMaybe cfws
+                    _ <- char '['
+                    xs <- A.many do _ <- tryMaybe fws
+                                    dtext
+                    _ <- tryMaybe fws
+                    _ <- char ']'
+                    _ <- tryMaybe cfws
+                    pure $ A.fold xs
 
 -- | dtext: characters in domains.
 -- |
@@ -235,11 +267,24 @@ dtext = CU.singleton <$> sat cond <|> obs_dtext
 --                    _ <- tryMaybe cfws
 --                    pure $ r <> a
 
---obs-route       =   obs-domain-list ":"
---
---obs-domain-list =   *(CFWS / ",") "@" domain
---                    *("," [CFWS] ["@" domain])
---
+-- | `obs_route`
+-- |
+-- | obs-route       =   obs-domain-list ":"
+obs_route :: forall e. Parser e String
+obs_route = do l <- obs_domain_list
+               _ <- char ':'
+               pure $ l <> ":"
+
+-- | `obs_domain_list`
+-- |
+-- | obs-domain-list =   *(CFWS / ",") "@" domain
+-- |                     *("," [CFWS] ["@" domain])
+obs_domain_list :: forall e. Parser e String
+obs_domain_list = do _ <- A.many $ cfws <|> do _ <- char ','
+                                               pure unit
+                     _ <- char '@'
+                     domain
+
 --obs-mbox-list   =   *([CFWS] ",") mailbox *("," [mailbox / CFWS])
 --
 --obs-addr-list   =   *([CFWS] ",") address *("," [address / CFWS])
@@ -248,7 +293,15 @@ dtext = CU.singleton <$> sat cond <|> obs_dtext
 --
 --obs-local-part  =   word *("." word)
 --
---obs-domain      =   atom *("." atom)
+-- | `obs_domain`
+-- |
+-- | obs-domain      =   atom *("." atom)
+obs_domain :: forall e. Parser e String
+obs_domain = do a <- atom
+                xs <- A.many $ do _ <- char '.'
+                                  x <- atom
+                                  pure $ "." <> x
+                pure $ a <> A.fold xs
 
 -- | `obs_dtext`: obsolete domain text.
 -- |
@@ -368,9 +421,30 @@ phrase = do ws <- many1 word
             pure $ A.fold ws
           <|> obs_phrase
 
---unstructured    =   (*([FWS] VCHAR) *WSP) / obs-unstruct
+-- | `unstructured`
+-- |
+-- | unstructured    =   (*([FWS] VCHAR) *WSP) / obs-unstruct
+unstructured :: forall e. Parser e String
+unstructured = do v <- A.many $ do _ <- fws
+                                   vchar
+                  _ <- A.many wsp
+                  pure $ CU.fromCharArray v
+                <|> obs_unstruct
 
---obs-phrase-list =   [phrase / CFWS] *("," [phrase / CFWS])
+
+-- | `obs_phrase_list`: obsolete list of phrases.
+-- |
+-- | obs-phrase-list =   [phrase / CFWS] *("," [phrase / CFWS])
+obs_phrase_list :: forall e. Parser e String
+obs_phrase_list = do first_phrase <- phrase_or_cfws
+                     xs <- A.many $ do _ <- char ','
+                                       phrase_or_cfws
+                     pure $ A.fold $ [first_phrase] <> xs
+  where phrase_or_cfws = do first_phrase <- tryMaybe phrase
+                            case first_phrase of
+                              Nothing -> do _ <- cfws
+                                            pure ""
+                              Just x -> pure x
 
 -- | `qtext`: printable US-ASCII characters not including "\" or the quote character.
 --