Validation: simplification from new Parser functions (errorParser and <:>).
parent
de758a9e49
commit
554280956b
|
@ -1,6 +1,6 @@
|
||||||
module App.Validation.DNS where
|
module App.Validation.DNS where
|
||||||
|
|
||||||
import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<<<))
|
import Prelude (apply, between, bind, map, pure, ($), (-), (<))
|
||||||
|
|
||||||
import Control.Alt ((<|>))
|
import Control.Alt ((<|>))
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
|
@ -13,11 +13,11 @@ import App.ResourceRecord (ResourceRecord)
|
||||||
import GenericParser.SomeParsers as SomeParsers
|
import GenericParser.SomeParsers as SomeParsers
|
||||||
import GenericParser.Parser as G
|
import GenericParser.Parser as G
|
||||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||||
import GenericParser.DomainParser (label, sub_eof) as DomainParser
|
import GenericParser.DomainParser (sub_eof) as DomainParser
|
||||||
import GenericParser.IPAddress as IPAddress
|
import GenericParser.IPAddress as IPAddress
|
||||||
import GenericParser.RFC5234 as RFC5234
|
import GenericParser.RFC5234 as RFC5234
|
||||||
|
|
||||||
-- | **History**
|
-- | **History:**
|
||||||
-- | The module once used dedicated types for each type of RR.
|
-- | The module once used dedicated types for each type of RR.
|
||||||
-- | That comes with several advantages.
|
-- | That comes with several advantages.
|
||||||
-- | First, type verification was a thing, and function were dedicated to a certain type of record.
|
-- | First, type verification was a thing, and function were dedicated to a certain type of record.
|
||||||
|
@ -152,7 +152,7 @@ txt_parser = do pos <- G.current_position
|
||||||
e <- G.tryMaybe SomeParsers.eof
|
e <- G.tryMaybe SomeParsers.eof
|
||||||
pos2 <- G.current_position
|
pos2 <- G.current_position
|
||||||
case e of
|
case e of
|
||||||
Nothing -> G.Parser \i -> G.failureError i.position (Just TXTInvalidCharacter)
|
Nothing -> G.errorParser $ Just TXTInvalidCharacter
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
let nbchar = pos2 - pos
|
let nbchar = pos2 - pos
|
||||||
if nbchar < max_txt
|
if nbchar < max_txt
|
||||||
|
|
|
@ -2,7 +2,6 @@ module App.Validation.Email where
|
||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Control.Alt ((<|>))
|
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
import Data.Maybe (Maybe(..))
|
import Data.Maybe (Maybe(..))
|
||||||
import Data.Validation.Semigroup (V, invalid, toEither)
|
import Data.Validation.Semigroup (V, invalid, toEither)
|
||||||
|
@ -31,12 +30,12 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of
|
||||||
|
|
||||||
parse_full_email :: G.Parser EmailParsingError String
|
parse_full_email :: G.Parser EmailParsingError String
|
||||||
parse_full_email = do
|
parse_full_email = do
|
||||||
email_address <- RFC5322.address <|> G.Parser \i -> G.failureError i.position (Just CannotParse)
|
email_address <- RFC5322.address G.<:> \_ -> CannotParse
|
||||||
_ <- SomeParsers.eof <|> G.Parser \i -> G.failureError i.position (Just CannotEntirelyParse)
|
_ <- SomeParsers.eof G.<:> \_ -> CannotEntirelyParse
|
||||||
pos <- G.current_position
|
pos <- G.current_position
|
||||||
if pos < min_email_size || pos > max_email_size
|
if between min_email_size max_email_size pos
|
||||||
then G.Parser \i -> G.failureError i.position (Just $ Size min_email_size max_email_size pos)
|
then pure email_address
|
||||||
else pure email_address
|
else G.errorParser $ Just $ Size min_email_size max_email_size pos
|
||||||
|
|
||||||
parserEmail :: String -> V (Array Error) String
|
parserEmail :: String -> V (Array Error) String
|
||||||
parserEmail str = parse parse_full_email str ParsingError
|
parserEmail str = parse parse_full_email str ParsingError
|
||||||
|
|
Loading…
Reference in New Issue