diff --git a/src/DomainParser.purs b/src/DomainParser.purs index 4b3a8d2..09c0ecd 100644 --- a/src/DomainParser.purs +++ b/src/DomainParser.purs @@ -1,31 +1,36 @@ -- | `DomainParser` is a simple parser for domain names as described in RFC 1035. module DomainParser where -import Prelude (class Monoid, bind, mempty, not, pure, ($), (&&), (*>), (<<<), (<>), (==), (>)) +import Prelude (bind, not, pure, ($), (&&), (*>), (<<<), (<>), (==), (>)) import Control.Lazy (defer) import Data.Maybe (Maybe(..)) +import Data.Either (Either(..)) import Data.Array as A import Data.String as S -import Data.Tuple (Tuple(..)) --- import Data.Array.NonEmpty as NonEmpty import Data.String.CodeUnits as CU import Control.Alt ((<|>)) import Control.Plus (empty) -import Parser (Parser(..), alphanum, char, letter, many1, parse, string) +data DomainError + = SubdomainTooLarge Position Size + | DomainTooLarge Size + | InvalidCharacter Position + | EOFExpected + +import Parser (Parser(..), success, fail, failError, alphanum, char, letter, many1, parse, string) -- | From RFC 1035: ::= | -let_dig :: Parser Char +let_dig :: forall e. Parser e Char let_dig = alphanum -- | From RFC 1035: ::= | "-" -- | Either a Letter, Digital or an Hyphenation character. -let_dig_hyp :: Parser Char +let_dig_hyp :: forall e. Parser e Char let_dig_hyp = let_dig <|> char '-' -- | From RFC 1035: ::= | -ldh_str :: Parser (Array Char) +ldh_str :: forall e. Parser e (Array Char) ldh_str = many1 let_dig_hyp -- TODO: 63 @@ -39,11 +44,11 @@ max_domain_length = 15 last_char :: String -> Maybe Char last_char = A.last <<< CU.toCharArray -parse_last_char :: String -> Parser Char -> Boolean +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 (CU.singleton c) of - Nothing -> false + Left _ -> false _ -> true -- | FIXME: This is flawed. @@ -51,14 +56,17 @@ parse_last_char s p = case last_char s of -- | the code will "continue to work" but without what's been parsed. -- | This may sound reasonable but it prevents knowing if a problem actually occured! -- | We cannot do a `try parser <|> alternative` since it will always work! -try :: forall a. Monoid a => Parser a -> Parser a +try :: forall e a. Parser e a -> Parser e a try p = Parser p' where p' str = case parse p str of - Nothing -> Just (Tuple mempty str) -- FIXME! Need a better base structure. - Just x -> pure x + Left { pos: _, input: _, error: e } -> case e of + Nothing -> fail 0 str + error -> failError 0 str error + right -> right + -- Right { pos: pos, input: input, result: value } -> success pos input value -- | From RFC 1035: