EmailAddress: WIP.

master
Philippe Pittoli 2024-01-27 08:37:58 +01:00
parent 140c7e128c
commit 29eddd715b
1 changed files with 28 additions and 32 deletions

View File

@ -2,7 +2,7 @@
-- | This module is experimental and doesn't follow every rule for an email address, yet.
module GenericParser.EmailAddress where
import Prelude (Unit, unit, bind, pure, ($), (<>), (==), (||), between, void)
import Prelude (Unit, bind, pure, ($), (<>), (==), (||), between, void)
import Control.Alt ((<|>))
import Data.Array as A
@ -24,33 +24,31 @@ data EmailError
= InvalidCharacter
| InvalidDomain (Maybe DomainError)
-- | obs-FWS = 1*WSP *(CRLF 1*WSP)
-- | obs-FWS: obsolete folding white space.
-- |
-- | Obsolete FWS.
-- | obs-FWS = 1*WSP *(CRLF 1*WSP)
obs_fws :: forall e. Parser e Unit
obs_fws = do _ <- A.many wsp
_ <- A.many $ do _ <- crlf
_ <- many1 wsp
pure unit
pure unit
void $ A.many $ do _ <- crlf
void $ many1 wsp
-- FWS = ([*WSP CRLF] 1*WSP) / obs-FWS
-- ; Folding white space
-- In english: FWS is described as:
-- 1. an OPTIONAL line with potential white spaces followed by at least one white space
-- 2. or, by the obs-FWS rule (meaning: many empty lines)
-- | FWS: folding white space. This can be described in plain english as:
-- | 1. an OPTIONAL line with potential white spaces followed by at least one white space
-- | 2. or, by the obs-FWS rule (meaning: many empty lines)
-- |
-- | FWS = ([*WSP CRLF] 1*WSP) / obs-FWS
fws :: forall e. Parser e Unit
fws = do _ <- tryMaybe do _ <- A.many wsp
_ <- crlf
pure unit
_ <- many1 wsp
pure unit
crlf
void $ many1 wsp
<|> obs_fws
-- ctext = %d33-39 / ; Printable US-ASCII
-- %d42-91 / ; characters not including
-- %d93-126 / ; "(", ")", or "\"
-- obs-ctext
-- | ctext: printable US-ASCII characters.
-- |
-- | ctext = %d33-39 / ; Printable US-ASCII
-- | %d42-91 / ; characters not including
-- | %d93-126 / ; "(", ")", or "\"
-- | obs-ctext
ctext :: forall e. Parser e Char
ctext = sat cond <|> obs_ctext
where cond x = let charcode = C.toCharCode x
@ -58,30 +56,28 @@ ctext = sat cond <|> obs_ctext
|| between 42 91 charcode
|| between 93 126 charcode
-- | TODO
-- | TODO: `quoted_pair`
quoted_pair :: forall e. Parser e Char
quoted_pair = char ' '
-- | ccontent = ctext / quoted-pair / comment
-- |
-- | Comment content. TODO
-- | Comment content.
ccontent :: forall e. Parser e Unit
ccontent = many_ctext <|> a_quoted_pair <|> comment
where many_ctext :: Parser e Unit
many_ctext = do void $ A.many ctext
ccontent = a_ctext <|> a_quoted_pair <|> comment
where a_ctext :: Parser e Unit
a_ctext = void ctext
a_quoted_pair :: Parser e Unit
a_quoted_pair = do void quoted_pair
a_quoted_pair = void quoted_pair
-- | comment = "(" *([FWS] ccontent) [FWS] ")"
-- | Comment. Nothing to return since comments aren't to be processed.
-- |
-- | Comment. Nothing to return.
-- | comment = "(" *([FWS] ccontent) [FWS] ")"
comment :: forall e. Parser e Unit
comment = do _ <- char '('
_ <- A.many (do _ <- A.many fws
_ <- ccontent
pure unit)
_ <- char ')'
pure unit
void ccontent)
void $ char ')'
-- CFWS = (1*([FWS] comment) [FWS]) / FWS
--cfws :: forall e. Parser e String