From ff455bce7125ee5f2d8125857f804c2794ae868b Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 30 Jan 2024 02:22:43 +0100 Subject: [PATCH] WIP: RFC5322 (first testable version almost there). --- src/GenericParser.purs | 2 +- src/GenericParser/BaseFunctions.purs | 3 +++ src/GenericParser/EmailAddress.purs | 28 ++++++++++++++-------------- src/GenericParser/Parser.purs | 5 ++--- 4 files changed, 20 insertions(+), 18 deletions(-) diff --git a/src/GenericParser.purs b/src/GenericParser.purs index 7e65e70..4754c66 100644 --- a/src/GenericParser.purs +++ b/src/GenericParser.purs @@ -8,5 +8,5 @@ module GenericParser import GenericParser.DomainParser.Common (DomainError(..), ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size) import GenericParser.DomainParser (domain, label, subdomain, sub_eof) import GenericParser.Parser (char, current_input, current_position, Error, failure, failureError, Input, item, lookahead, many1, parse, parse_last_char, Parser(..), Position, PositionString, Result, rollback, sat, string, success, try, tryMaybe, until, Value) -import GenericParser.SomeParsers (alphanum, eof, ident, identifier, int, integer, letter, lower, nat, natural, space, symbol, token, upper) +-- import GenericParser.SomeParsers (alphanum, eof, ident, identifier, int, integer, letter, lower, nat, natural, space, symbol, token, upper) -- import GenericParser.RFC5234 () diff --git a/src/GenericParser/BaseFunctions.purs b/src/GenericParser/BaseFunctions.purs index ab58dea..05b1224 100644 --- a/src/GenericParser/BaseFunctions.purs +++ b/src/GenericParser/BaseFunctions.purs @@ -8,6 +8,9 @@ import Data.String.CodeUnits (singleton) concat :: Char -> String -> String concat c rest = singleton c <> rest +id :: forall a. a -> a +id x = x + isDigit :: Char -> Boolean isDigit = between '0' '9' diff --git a/src/GenericParser/EmailAddress.purs b/src/GenericParser/EmailAddress.purs index 76b32e6..f4b6ec6 100644 --- a/src/GenericParser/EmailAddress.purs +++ b/src/GenericParser/EmailAddress.purs @@ -11,6 +11,7 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) import Data.String.CodeUnits as CU +import GenericParser.BaseFunctions (id) import GenericParser.Parser (Parser(..) , sat, char, char_num, char_range, string, item, many1, tryMaybe , current_input, failureError, parse, rollback, until) @@ -24,9 +25,6 @@ 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,26 +93,26 @@ cfws = do void $ many1 $ do _ <- tryMaybe fws comment <|> fws --- | TODO: `address`: email address. +-- | `address`: email address. -- | -- | address = mailbox / group address :: forall e. Parser e String address = mailbox <|> group --- | TODO: `mailbox`: mail address. +-- | `mailbox`: mail address. -- | -- | mailbox = name-addr / addr-spec mailbox :: forall e. Parser e String mailbox = name_addr <|> addr_spec --- | TODO: `name_addr`: address name. +-- | `name_addr`: address name. -- | -- | name-addr = [display-name] angle-addr name_addr :: forall e. Parser e String name_addr = do _ <- tryMaybe display_name angle_addr --- | TODO: `angle_addr` address specification between '<' and '>' characters. +-- | `angle_addr` address specification between '<' and '>' characters. -- | -- | angle-addr = [CFWS] "<" addr-spec ">" [CFWS] / obs-angle-addr angle_addr :: forall e. Parser e String @@ -123,10 +121,10 @@ angle_addr = do _ <- tryMaybe cfws a <- addr_spec _ <- char '>' _ <- tryMaybe cfws - pure a + pure $ "<" <> a <> ">" <|> obs_angle_addr --- | TODO: `group`: a list of email addresses. +-- | `group`: a list of email addresses. -- | -- | group = display-name ":" [group-list] ";" [CFWS] group :: forall e. Parser e String @@ -204,7 +202,10 @@ atext = alphanum -- | -- | atom = [CFWS] 1*atext [CFWS] atom :: forall e. Parser e String -atom = CU.fromCharArray <$> do A.many atext +atom = CU.fromCharArray <$> do _ <- tryMaybe cfws + a <- many1 atext + _ <- tryMaybe cfws + pure a -- | `dot_atom_text` -- | @@ -442,7 +443,7 @@ obs_qp = do _ <- char '\\' -- Errata v1 --obs_body :: forall e. Parser e String --obs_body = CU.fromCharArray <$> A.many item --- + -- Errata v2 obs_body :: forall e. Parser e String obs_body = CU.fromCharArray <$> do A.many (char_num 0 <|> vchar <|> lf <|> cr) @@ -459,7 +460,7 @@ obs_body = CU.fromCharArray <$> do A.many (char_num 0 <|> vchar <|> lf <|> cr) -- <|> _ <- crlf -- pure "" --- | TODO: `obs_unstruct` +-- | `obs_unstruct` -- | -- | Note: implement the version found in the Errata page. -- | @@ -535,8 +536,7 @@ qcontent :: forall e. Parser e String qcontent = CU.singleton <$> qtext <|> quoted_pair -- | `quoted_string` --- DQUOTE *([FWS] qcontent) [FWS] DQUOTE --- [CFWS] +-- | -- | quoted-string = [CFWS] DQUOTE *([FWS] qcontent) [FWS] DQUOTE [CFWS] quoted_string :: forall e. Parser e String quoted_string = do _ <- tryMaybe cfws diff --git a/src/GenericParser/Parser.purs b/src/GenericParser/Parser.purs index 8a99ac2..20444d0 100644 --- a/src/GenericParser/Parser.purs +++ b/src/GenericParser/Parser.purs @@ -1,15 +1,14 @@ module GenericParser.Parser where import Prelude (between, (<<<), bind, (==), ($), pure, class Bind, unit, (+), (<>), class Applicative, class Functor, Unit, class Apply) -import Control.Alt (class Alt, (<|>)) +import Control.Alt (class Alt) import Control.Alternative (class Alternative) import Control.Lazy (class Lazy, defer) -import Control.Plus (class Plus, empty) +import Control.Plus (class Plus) import Data.Array as A import Data.Char as C import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) -import Data.String as S import Data.String.CodeUnits as CU import GenericParser.BaseFunctions (concat)