WIP: RFC5322 (first testable version almost there).
This commit is contained in:
parent
3cd11d3f47
commit
ff455bce71
@ -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 ()
|
||||||
|
@ -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'
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user