diff --git a/makefile b/makefile index da5de78..59d6916 100644 --- a/makefile +++ b/makefile @@ -6,5 +6,5 @@ build: run: spago run -test: +t: spago test diff --git a/src/GenericParser.purs b/src/GenericParser.purs index ee00eb4..e186ea3 100644 --- a/src/GenericParser.purs +++ b/src/GenericParser.purs @@ -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) diff --git a/src/GenericParser/DomainParser.purs b/src/GenericParser/DomainParser.purs index cae437e..edbcaf3 100644 --- a/src/GenericParser/DomainParser.purs +++ b/src/GenericParser/DomainParser.purs @@ -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: