More consistent function naming.
parent
4d88340381
commit
d4aa63730e
2
makefile
2
makefile
|
@ -6,5 +6,5 @@ build:
|
||||||
run:
|
run:
|
||||||
spago run
|
spago run
|
||||||
|
|
||||||
test:
|
t:
|
||||||
spago test
|
spago test
|
||||||
|
|
|
@ -3,5 +3,5 @@ module GenericParser
|
||||||
, module GenericParser.DomainParser
|
, module GenericParser.DomainParser
|
||||||
) where
|
) 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.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, label_maxsize, max_domain_length, last_char, parse_last_char, tryMaybe, try, label, subdomain, eof, sub_eof, domain)
|
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 Prelude (bind, not, pure, ($), (&&), (*>), (<<<), (<>), (>), (-))
|
||||||
|
|
||||||
|
import Control.Alt ((<|>))
|
||||||
import Control.Lazy (defer)
|
import Control.Lazy (defer)
|
||||||
import Data.Maybe (Maybe(..), maybe)
|
|
||||||
import Data.Either (Either(..))
|
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
|
import Data.Either (Either(..))
|
||||||
|
import Data.Maybe (Maybe(..), maybe)
|
||||||
import Data.String as S
|
import Data.String as S
|
||||||
import Data.String.CodeUnits as CU
|
import Data.String.CodeUnits as CU
|
||||||
import Control.Alt ((<|>))
|
|
||||||
-- import Control.Plus (empty)
|
|
||||||
|
|
||||||
import GenericParser.Parser (Parser(..)
|
import GenericParser.Parser (Parser(..)
|
||||||
, success, failError
|
, success, failureError
|
||||||
, current_position
|
, current_position
|
||||||
, alphanum, char, letter, many1, parse, string)
|
, 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 :: forall e. Parser e (Array Char)
|
||||||
ldh_str = many1 let_dig_hyp
|
ldh_str = many1 let_dig_hyp
|
||||||
|
|
||||||
-- TODO: 63
|
-- | WARNING: Verify the actual maximum length for a label.
|
||||||
label_maxsize :: Int
|
-- | Current maximum accepted length for a label is 63.
|
||||||
label_maxsize = 7
|
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 :: Int
|
||||||
max_domain_length = 15
|
max_domain_length = 255
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
-- | `tryMaybe` provides a way to accept a faulty parser and
|
-- | `tryMaybe` provides a way to accept a faulty parser and
|
||||||
-- | just rewinds back to previous input state if an error occurs.
|
-- | just rewinds back to previous input state if an error occurs.
|
||||||
tryMaybe :: forall e a. Parser e a -> Parser e (Maybe a)
|
tryMaybe :: forall e a. Parser e a -> Parser e (Maybe a)
|
||||||
tryMaybe p = Parser p'
|
tryMaybe p = Parser p'
|
||||||
where p' input = case parse p input of
|
where p' input = case parse p input of
|
||||||
Left _ -> Right { suffix: input, result: Nothing }
|
Left _ -> success input Nothing
|
||||||
Right { suffix, result } -> Right { suffix, result: Just result }
|
Right { suffix, result } -> success suffix (Just result)
|
||||||
|
|
||||||
-- | `try` provides a way to accept a faulty parser and
|
-- | `try` provides a way to accept a faulty parser and
|
||||||
-- | just rewinds back to previous input state if a non-specific error occurs.
|
-- | 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 :: forall e a. Parser e a -> Parser e (Maybe a)
|
||||||
try p = Parser p'
|
try p = Parser p'
|
||||||
where p' input = case parse p input of
|
where p' input = case parse p input of
|
||||||
|
Right { suffix, result } -> success suffix (Just result)
|
||||||
Left { position, error } -> case error of
|
Left { position, error } -> case error of
|
||||||
Nothing -> Right { suffix: input, result: Nothing }
|
Nothing -> success input Nothing
|
||||||
_ -> Left { position, error }
|
_ -> failureError position error
|
||||||
Right { suffix, result } -> Right { suffix, result: Just result }
|
|
||||||
|
|
||||||
-- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
|
-- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
|
||||||
label :: Parser DomainError String
|
label :: Parser DomainError String
|
||||||
|
@ -79,16 +72,28 @@ label = do
|
||||||
pos <- current_position
|
pos <- current_position
|
||||||
maybel <- tryMaybe letter
|
maybel <- tryMaybe letter
|
||||||
case maybel of
|
case maybel of
|
||||||
Nothing -> Parser \_ -> failError pos (Just InvalidCharacter)
|
Nothing -> Parser \_ -> failureError pos (Just InvalidCharacter)
|
||||||
Just l -> do
|
Just l -> do
|
||||||
s <- tryMaybe ldh_str
|
s <- tryMaybe ldh_str
|
||||||
lastpos <- current_position
|
lastpos <- current_position
|
||||||
let labelstr = CU.singleton l <> maybe "" CU.fromCharArray s
|
let labelstr = CU.singleton l <> maybe "" CU.fromCharArray s
|
||||||
if (S.length labelstr > label_maxsize)
|
if (S.length labelstr > max_label_length)
|
||||||
then Parser \_ -> failError pos (Just <<< SubdomainTooLarge $ S.length labelstr)
|
then Parser \_ -> failureError pos (Just <<< SubdomainTooLarge $ S.length labelstr)
|
||||||
else if (S.length labelstr > 1 && not (parse_last_char labelstr let_dig))
|
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
|
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>
|
-- | From RFC 1035: <subdomain> ::= <label> | <subdomain> "." <label>
|
||||||
subdomain :: Parser DomainError String
|
subdomain :: Parser DomainError String
|
||||||
|
@ -108,7 +113,7 @@ subdomain = do
|
||||||
eof :: Parser DomainError String
|
eof :: Parser DomainError String
|
||||||
eof = Parser \input -> case S.length input.string of
|
eof = Parser \input -> case S.length input.string of
|
||||||
0 -> success input ""
|
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.
|
-- | 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 '.').
|
-- | 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
|
pos <- current_position
|
||||||
let parsed_domain = did_we_parse_the_final_point maybe_final_point sub
|
let parsed_domain = did_we_parse_the_final_point maybe_final_point sub
|
||||||
if S.length parsed_domain > max_domain_length
|
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
|
else pure parsed_domain
|
||||||
where
|
where
|
||||||
did_we_parse_the_final_point Nothing sub = sub
|
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.Alternative (class Alternative)
|
||||||
import Control.Lazy (class Lazy)
|
import Control.Lazy (class Lazy)
|
||||||
import Control.Plus (class Plus, empty)
|
import Control.Plus (class Plus, empty)
|
||||||
|
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
import Data.Int as Int
|
|
||||||
import Data.Either (Either(..))
|
import Data.Either (Either(..))
|
||||||
|
import Data.Int as Int
|
||||||
import Data.Maybe (Maybe(..))
|
import Data.Maybe (Maybe(..))
|
||||||
import Data.String.CodeUnits (toCharArray, fromCharArray)
|
import Data.String.CodeUnits (toCharArray, fromCharArray)
|
||||||
|
|
||||||
|
@ -32,16 +31,16 @@ current_position = Parser \input -> success input input.position
|
||||||
|
|
||||||
-- | Fail with a specified error.
|
-- | Fail with a specified error.
|
||||||
-- | When a parsing has a specified error, no alternative will be tried and the error is reported.
|
-- | 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
|
failureError :: forall e v. Position -> Maybe e -> Result e v
|
||||||
failError position error = Left { position, error }
|
failureError position error = Left { position, error }
|
||||||
|
|
||||||
-- | Fail without a specified error.
|
-- | Fail without a specified error.
|
||||||
-- | This is used in generic parsers not attached to a specified context,
|
-- | This is used in generic parsers not attached to a specified context,
|
||||||
-- | such as `digit` or `letter`.
|
-- | such as `digit` or `letter`.
|
||||||
-- | Also, this can be used to express a possibly expected invalid parsing that should not
|
-- | 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.
|
-- | halt the parsing, but rather let an alternative path to be tried.
|
||||||
fail :: forall e v. Position -> Result e v
|
failure :: forall e v. Position -> Result e v
|
||||||
fail position = failError position Nothing
|
failure position = failureError position Nothing
|
||||||
|
|
||||||
-- | `success` constructs a result value for a successful parsing.
|
-- | `success` constructs a result value for a successful parsing.
|
||||||
-- | It requires the input (a string with its current position) and the result.
|
-- | 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
|
item = Parser p
|
||||||
where
|
where
|
||||||
p input = case A.uncons (toCharArray input.string) of
|
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
|
Just { head: x, tail: xs } -> success { string: (fromCharArray xs), position: input.position+1 } x
|
||||||
|
|
||||||
instance functorParser :: Functor (Parser e) where
|
instance functorParser :: Functor (Parser e) where
|
||||||
|
@ -87,12 +86,12 @@ instance altParser :: Alt (Parser e) where
|
||||||
p stream = case p1 stream of
|
p stream = case p1 stream of
|
||||||
Left { position, error } -> case error of
|
Left { position, error } -> case error of
|
||||||
Nothing -> p2 stream
|
Nothing -> p2 stream
|
||||||
_ -> failError position error
|
_ -> failureError position error
|
||||||
Right right -> Right right
|
Right right -> Right right
|
||||||
|
|
||||||
instance plusParser :: Plus (Parser e) where
|
instance plusParser :: Plus (Parser e) where
|
||||||
empty :: forall v. Parser e v
|
empty :: forall v. Parser e v
|
||||||
empty = Parser \input -> fail input.position
|
empty = Parser \input -> failure input.position
|
||||||
|
|
||||||
instance alternativeParser :: Alternative (Parser e)
|
instance alternativeParser :: Alternative (Parser e)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue