More consistent function naming.
parent
4d88340381
commit
d4aa63730e
|
@ -3,5 +3,5 @@ module GenericParser
|
|||
, module GenericParser.DomainParser
|
||||
) where
|
||||
|
||||
import GenericParser.Parser (Position, PositionString, Input, Error, Value, Result, Parser(..), parse, current_position, failError, fail, success, item, sat, digit, lower, upper, letter, alphanum, char, string, ident, nat, int, space, token, identifier, natural, integer, symbol, many1)
|
||||
import GenericParser.DomainParser (Size, DomainError(..), let_dig, let_dig_hyp, ldh_str, label_maxsize, max_domain_length, last_char, parse_last_char, tryMaybe, try, label, subdomain, eof, sub_eof, domain)
|
||||
import GenericParser.Parser (Position, PositionString, Input, Error, Value, Result, Parser(..), parse, current_position, failureError, failure, success, item, sat, digit, lower, upper, letter, alphanum, char, string, ident, nat, int, space, token, identifier, natural, integer, symbol, many1)
|
||||
import GenericParser.DomainParser (Size, DomainError(..), let_dig, let_dig_hyp, ldh_str, max_label_length, max_domain_length, tryMaybe, try, label, subdomain, eof, sub_eof, domain)
|
||||
|
|
|
@ -3,17 +3,16 @@ module GenericParser.DomainParser where
|
|||
|
||||
import Prelude (bind, not, pure, ($), (&&), (*>), (<<<), (<>), (>), (-))
|
||||
|
||||
import Control.Alt ((<|>))
|
||||
import Control.Lazy (defer)
|
||||
import Data.Maybe (Maybe(..), maybe)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Array as A
|
||||
import Data.Either (Either(..))
|
||||
import Data.Maybe (Maybe(..), maybe)
|
||||
import Data.String as S
|
||||
import Data.String.CodeUnits as CU
|
||||
import Control.Alt ((<|>))
|
||||
-- import Control.Plus (empty)
|
||||
|
||||
import GenericParser.Parser (Parser(..)
|
||||
, success, failError
|
||||
, success, failureError
|
||||
, current_position
|
||||
, alphanum, char, letter, many1, parse, string)
|
||||
|
||||
|
@ -37,41 +36,35 @@ let_dig_hyp = let_dig <|> char '-'
|
|||
ldh_str :: forall e. Parser e (Array Char)
|
||||
ldh_str = many1 let_dig_hyp
|
||||
|
||||
-- TODO: 63
|
||||
label_maxsize :: Int
|
||||
label_maxsize = 7
|
||||
-- | WARNING: Verify the actual maximum length for a label.
|
||||
-- | Current maximum accepted length for a label is 63.
|
||||
max_label_length :: Int
|
||||
max_label_length = 63
|
||||
|
||||
-- TODO: 255?
|
||||
-- | WARNING: Verify the actual maximum length for a domain.
|
||||
-- | Current maximum accepted length for a domain is 255.
|
||||
max_domain_length :: Int
|
||||
max_domain_length = 15
|
||||
|
||||
last_char :: String -> Maybe Char
|
||||
last_char = A.last <<< CU.toCharArray
|
||||
|
||||
parse_last_char :: forall e. String -> Parser e Char -> Boolean
|
||||
parse_last_char s p = case last_char s of
|
||||
Nothing -> false
|
||||
Just c -> case parse p { string: CU.singleton c, position: 0 } of
|
||||
Left _ -> false
|
||||
_ -> true
|
||||
max_domain_length = 255
|
||||
|
||||
-- | `tryMaybe` provides a way to accept a faulty parser and
|
||||
-- | just rewinds back to previous input state if an error occurs.
|
||||
tryMaybe :: forall e a. Parser e a -> Parser e (Maybe a)
|
||||
tryMaybe p = Parser p'
|
||||
where p' input = case parse p input of
|
||||
Left _ -> Right { suffix: input, result: Nothing }
|
||||
Right { suffix, result } -> Right { suffix, result: Just result }
|
||||
Left _ -> success input Nothing
|
||||
Right { suffix, result } -> success suffix (Just result)
|
||||
|
||||
-- | `try` provides a way to accept a faulty parser and
|
||||
-- | just rewinds back to previous input state if a non-specific error occurs.
|
||||
-- | The difference with `tryMaybe` is that `try` will forward the error if it is
|
||||
-- | a specific one, meanning that `error` isn't `Nothing`.
|
||||
try :: forall e a. Parser e a -> Parser e (Maybe a)
|
||||
try p = Parser p'
|
||||
where p' input = case parse p input of
|
||||
Right { suffix, result } -> success suffix (Just result)
|
||||
Left { position, error } -> case error of
|
||||
Nothing -> Right { suffix: input, result: Nothing }
|
||||
_ -> Left { position, error }
|
||||
Right { suffix, result } -> Right { suffix, result: Just result }
|
||||
Nothing -> success input Nothing
|
||||
_ -> failureError position error
|
||||
|
||||
-- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
|
||||
label :: Parser DomainError String
|
||||
|
@ -79,16 +72,28 @@ label = do
|
|||
pos <- current_position
|
||||
maybel <- tryMaybe letter
|
||||
case maybel of
|
||||
Nothing -> Parser \_ -> failError pos (Just InvalidCharacter)
|
||||
Nothing -> Parser \_ -> failureError pos (Just InvalidCharacter)
|
||||
Just l -> do
|
||||
s <- tryMaybe ldh_str
|
||||
lastpos <- current_position
|
||||
let labelstr = CU.singleton l <> maybe "" CU.fromCharArray s
|
||||
if (S.length labelstr > label_maxsize)
|
||||
then Parser \_ -> failError pos (Just <<< SubdomainTooLarge $ S.length labelstr)
|
||||
if (S.length labelstr > max_label_length)
|
||||
then Parser \_ -> failureError pos (Just <<< SubdomainTooLarge $ S.length labelstr)
|
||||
else if (S.length labelstr > 1 && not (parse_last_char labelstr let_dig))
|
||||
then Parser \_ -> failError (lastpos - 1) (Just InvalidCharacter)
|
||||
then Parser \_ -> failureError (lastpos - 1) (Just InvalidCharacter)
|
||||
else pure labelstr
|
||||
where
|
||||
-- Get the last character of a String.
|
||||
last_char :: String -> Maybe Char
|
||||
last_char = A.last <<< CU.toCharArray
|
||||
|
||||
-- Parse the last character of a String.
|
||||
parse_last_char :: forall e. String -> Parser e Char -> Boolean
|
||||
parse_last_char s p = case last_char s of
|
||||
Nothing -> false
|
||||
Just c -> case parse p { string: CU.singleton c, position: 0 } of
|
||||
Left _ -> false
|
||||
_ -> true
|
||||
|
||||
-- | From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
|
||||
subdomain :: Parser DomainError String
|
||||
|
@ -108,7 +113,7 @@ subdomain = do
|
|||
eof :: Parser DomainError String
|
||||
eof = Parser \input -> case S.length input.string of
|
||||
0 -> success input ""
|
||||
_ -> failError input.position (Just EOFExpected)
|
||||
_ -> failureError input.position (Just EOFExpected)
|
||||
|
||||
-- | Test for the domain to be a list of subdomains then an end-of-file.
|
||||
-- | Said otherwise, the input must only contain a domain (with or without a final dot '.').
|
||||
|
@ -120,7 +125,7 @@ sub_eof = do
|
|||
pos <- current_position
|
||||
let parsed_domain = did_we_parse_the_final_point maybe_final_point sub
|
||||
if S.length parsed_domain > max_domain_length
|
||||
then Parser \_ -> failError pos (Just <<< DomainTooLarge $ S.length parsed_domain)
|
||||
then Parser \_ -> failureError pos (Just <<< DomainTooLarge $ S.length parsed_domain)
|
||||
else pure parsed_domain
|
||||
where
|
||||
did_we_parse_the_final_point Nothing sub = sub
|
||||
|
|
|
@ -5,10 +5,9 @@ import Control.Alt (class Alt, (<|>))
|
|||
import Control.Alternative (class Alternative)
|
||||
import Control.Lazy (class Lazy)
|
||||
import Control.Plus (class Plus, empty)
|
||||
|
||||
import Data.Array as A
|
||||
import Data.Int as Int
|
||||
import Data.Either (Either(..))
|
||||
import Data.Int as Int
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.String.CodeUnits (toCharArray, fromCharArray)
|
||||
|
||||
|
@ -32,16 +31,16 @@ current_position = Parser \input -> success input input.position
|
|||
|
||||
-- | Fail with a specified error.
|
||||
-- | When a parsing has a specified error, no alternative will be tried and the error is reported.
|
||||
failError :: forall e v. Position -> Maybe e -> Result e v
|
||||
failError position error = Left { position, error }
|
||||
failureError :: forall e v. Position -> Maybe e -> Result e v
|
||||
failureError position error = Left { position, error }
|
||||
|
||||
-- | Fail without a specified error.
|
||||
-- | This is used in generic parsers not attached to a specified context,
|
||||
-- | such as `digit` or `letter`.
|
||||
-- | Also, this can be used to express a possibly expected invalid parsing that should not
|
||||
-- | halt the parsing, but rather let an alternative path to be tried.
|
||||
fail :: forall e v. Position -> Result e v
|
||||
fail position = failError position Nothing
|
||||
failure :: forall e v. Position -> Result e v
|
||||
failure position = failureError position Nothing
|
||||
|
||||
-- | `success` constructs a result value for a successful parsing.
|
||||
-- | It requires the input (a string with its current position) and the result.
|
||||
|
@ -53,7 +52,7 @@ item :: forall e. Parser e Char
|
|||
item = Parser p
|
||||
where
|
||||
p input = case A.uncons (toCharArray input.string) of
|
||||
Nothing -> fail input.position
|
||||
Nothing -> failure input.position
|
||||
Just { head: x, tail: xs } -> success { string: (fromCharArray xs), position: input.position+1 } x
|
||||
|
||||
instance functorParser :: Functor (Parser e) where
|
||||
|
@ -87,12 +86,12 @@ instance altParser :: Alt (Parser e) where
|
|||
p stream = case p1 stream of
|
||||
Left { position, error } -> case error of
|
||||
Nothing -> p2 stream
|
||||
_ -> failError position error
|
||||
_ -> failureError position error
|
||||
Right right -> Right right
|
||||
|
||||
instance plusParser :: Plus (Parser e) where
|
||||
empty :: forall v. Parser e v
|
||||
empty = Parser \input -> fail input.position
|
||||
empty = Parser \input -> failure input.position
|
||||
|
||||
instance alternativeParser :: Alternative (Parser e)
|
||||
|
||||
|
|
Loading…
Reference in New Issue