WIP: RFC5322 (first testable version almost there).

This commit is contained in:
Philippe Pittoli 2024-01-30 02:22:43 +01:00
parent 3cd11d3f47
commit ff455bce71
4 changed files with 20 additions and 18 deletions

View File

@ -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.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.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.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 () -- import GenericParser.RFC5234 ()

View File

@ -8,6 +8,9 @@ import Data.String.CodeUnits (singleton)
concat :: Char -> String -> String concat :: Char -> String -> String
concat c rest = singleton c <> rest concat c rest = singleton c <> rest
id :: forall a. a -> a
id x = x
isDigit :: Char -> Boolean isDigit :: Char -> Boolean
isDigit = between '0' '9' isDigit = between '0' '9'

View File

@ -11,6 +11,7 @@ import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.String.CodeUnits as CU import Data.String.CodeUnits as CU
import GenericParser.BaseFunctions (id)
import GenericParser.Parser (Parser(..) import GenericParser.Parser (Parser(..)
, sat, char, char_num, char_range, string, item, many1, tryMaybe , sat, char, char_num, char_range, string, item, many1, tryMaybe
, current_input, failureError, parse, rollback, until) , current_input, failureError, parse, rollback, until)
@ -24,9 +25,6 @@ data EmailError
= InvalidCharacter = InvalidCharacter
| InvalidDomain (Maybe DomainError) | InvalidDomain (Maybe DomainError)
id :: forall a. a -> a
id x = x
-- | obs-FWS: obsolete folding white space. -- | obs-FWS: obsolete folding white space.
-- | -- |
-- | obs-FWS = 1*WSP *(CRLF 1*WSP) -- | obs-FWS = 1*WSP *(CRLF 1*WSP)
@ -95,26 +93,26 @@ cfws = do void $ many1 $ do _ <- tryMaybe fws
comment comment
<|> fws <|> fws
-- | TODO: `address`: email address. -- | `address`: email address.
-- | -- |
-- | address = mailbox / group -- | 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`: mail address.
-- | -- |
-- | mailbox = name-addr / addr-spec -- | 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`: address name.
-- | -- |
-- | name-addr = [display-name] angle-addr -- | 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` address specification between '<' and '>' characters.
-- | -- |
-- | angle-addr = [CFWS] "<" addr-spec ">" [CFWS] / obs-angle-addr -- | angle-addr = [CFWS] "<" addr-spec ">" [CFWS] / obs-angle-addr
angle_addr :: forall e. Parser e String angle_addr :: forall e. Parser e String
@ -123,10 +121,10 @@ angle_addr = do _ <- tryMaybe cfws
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`: a list of email addresses.
-- | -- |
-- | group = display-name ":" [group-list] ";" [CFWS] -- | group = display-name ":" [group-list] ";" [CFWS]
group :: forall e. Parser e String group :: forall e. Parser e String
@ -204,7 +202,10 @@ atext = alphanum
-- | -- |
-- | atom = [CFWS] 1*atext [CFWS] -- | atom = [CFWS] 1*atext [CFWS]
atom :: forall e. Parser e String 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` -- | `dot_atom_text`
-- | -- |
@ -442,7 +443,7 @@ obs_qp = do _ <- char '\\'
-- Errata v1 -- Errata v1
--obs_body :: forall e. Parser e String --obs_body :: forall e. Parser e String
--obs_body = CU.fromCharArray <$> A.many item --obs_body = CU.fromCharArray <$> A.many item
--
-- Errata v2 -- Errata v2
obs_body :: forall e. Parser e String obs_body :: forall e. Parser e String
obs_body = CU.fromCharArray <$> do A.many (char_num 0 <|> vchar <|> lf <|> cr) 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 -- <|> _ <- crlf
-- pure "" -- pure ""
-- | TODO: `obs_unstruct` -- | `obs_unstruct`
-- | -- |
-- | Note: implement the version found in the Errata page. -- | 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 qcontent = CU.singleton <$> qtext <|> quoted_pair
-- | `quoted_string` -- | `quoted_string`
-- DQUOTE *([FWS] qcontent) [FWS] DQUOTE -- |
-- [CFWS]
-- | quoted-string = [CFWS] DQUOTE *([FWS] qcontent) [FWS] DQUOTE [CFWS] -- | quoted-string = [CFWS] DQUOTE *([FWS] qcontent) [FWS] DQUOTE [CFWS]
quoted_string :: forall e. Parser e String quoted_string :: forall e. Parser e String
quoted_string = do _ <- tryMaybe cfws quoted_string = do _ <- tryMaybe cfws

View File

@ -1,15 +1,14 @@
module GenericParser.Parser where module GenericParser.Parser where
import Prelude (between, (<<<), bind, (==), ($), pure, class Bind, unit, (+), (<>), class Applicative, class Functor, Unit, class Apply) 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.Alternative (class Alternative)
import Control.Lazy (class Lazy, defer) import Control.Lazy (class Lazy, defer)
import Control.Plus (class Plus, empty) import Control.Plus (class Plus)
import Data.Array as A import Data.Array as A
import Data.Char as C import Data.Char as C
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.String as S
import Data.String.CodeUnits as CU import Data.String.CodeUnits as CU
import GenericParser.BaseFunctions (concat) import GenericParser.BaseFunctions (concat)