DomainParserRFC1035, documentation, code structure (try fn -> Parser module).
parent
d4aa63730e
commit
22d6386c32
10
makefile
10
makefile
|
@ -8,3 +8,13 @@ run:
|
|||
|
||||
t:
|
||||
spago test
|
||||
|
||||
docs:
|
||||
spago docs
|
||||
|
||||
DOCS_HTTPD_ACCESS_LOGS ?= /tmp/parser-docs-access.log
|
||||
DOCS_HTTPD_ADDR ?= 127.0.0.1
|
||||
DOCS_HTTPD_PORT ?= 30000
|
||||
DOCS_DIR ?= generated-docs/html
|
||||
serve-docs: docs
|
||||
darkhttpd $(DOCS_DIR) --addr $(DOCS_HTTPD_ADDR) --port $(DOCS_HTTPD_PORT) --log $(DOCS_HTTPD_ACCESS_LOGS)
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
module GenericParser
|
||||
( module GenericParser.Parser
|
||||
, module GenericParser.DomainParser
|
||||
, module GenericParser.DomainParserRFC1035
|
||||
) where
|
||||
|
||||
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)
|
||||
import GenericParser.Parser (alphanum, char, current_position, digit, Error, failure, failureError, ident, identifier, Input, int, integer, item, letter, lower, many1, nat, natural, parse, Parser(..), Position, PositionString, Result, sat, space, string, success, symbol, token, try, tryMaybe, upper, Value)
|
||||
import GenericParser.DomainParserRFC1035 (domain, DomainError(..), eof, label, ldh_str, let_dig, let_dig_hyp, max_domain_length, max_label_length, Size, subdomain, sub_eof)
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
-- | `DomainParser` is a simple parser for domain names as described in RFC 1035.
|
||||
module GenericParser.DomainParser where
|
||||
-- | `DomainParserRFC1035` is a simple parser for domain names as described in RFC 1035.
|
||||
-- | See `DomainParser` for a more modern domain parser, accepting underscores in labels for example.
|
||||
module GenericParser.DomainParserRFC1035 where
|
||||
|
||||
import Prelude (bind, not, pure, ($), (&&), (*>), (<<<), (<>), (>), (-))
|
||||
|
||||
|
@ -14,11 +15,14 @@ import Data.String.CodeUnits as CU
|
|||
import GenericParser.Parser (Parser(..)
|
||||
, success, failureError
|
||||
, current_position
|
||||
, alphanum, char, letter, many1, parse, string)
|
||||
, alphanum, char, letter, many1, parse, string
|
||||
, try, tryMaybe)
|
||||
|
||||
type Size = Int
|
||||
-- | `DomainError` expresses all possible errors that can occur while parsing a domain.
|
||||
-- | When an error occurs, the position is given by the Parser along the related `DomainError`.
|
||||
data DomainError
|
||||
= SubdomainTooLarge Size
|
||||
= LabelTooLarge Size
|
||||
| DomainTooLarge Size
|
||||
| InvalidCharacter
|
||||
| EOFExpected
|
||||
|
@ -46,26 +50,6 @@ max_label_length = 63
|
|||
max_domain_length :: Int
|
||||
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 _ -> 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 -> success input Nothing
|
||||
_ -> failureError position error
|
||||
|
||||
-- | From RFC 1035: <label> ::= <letter> [ [ <ldh-str> ] <let-dig> ]
|
||||
label :: Parser DomainError String
|
||||
label = do
|
||||
|
@ -78,7 +62,7 @@ label = do
|
|||
lastpos <- current_position
|
||||
let labelstr = CU.singleton l <> maybe "" CU.fromCharArray s
|
||||
if (S.length labelstr > max_label_length)
|
||||
then Parser \_ -> failureError pos (Just <<< SubdomainTooLarge $ S.length labelstr)
|
||||
then Parser \_ -> failureError pos (Just <<< LabelTooLarge $ S.length labelstr)
|
||||
else if (S.length labelstr > 1 && not (parse_last_char labelstr let_dig))
|
||||
then Parser \_ -> failureError (lastpos - 1) (Just InvalidCharacter)
|
||||
else pure labelstr
|
|
@ -100,6 +100,26 @@ instance lazyParser :: Lazy (Parser e v) where
|
|||
|
||||
-- Generic parsing functions.
|
||||
|
||||
-- | `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 _ -> 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, meaning 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 -> success input Nothing
|
||||
_ -> failureError position error
|
||||
|
||||
sat :: forall e. (Char -> Boolean) -> Parser e Char
|
||||
sat p = do x <- item
|
||||
if p x then pure x else empty
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
module Test.Main where
|
||||
|
||||
import GenericParser.Parser (Parser(..))
|
||||
import GenericParser.DomainParser (domain, label, ldh_str, sub_eof, subdomain, DomainError(..))
|
||||
import GenericParser.DomainParserRFC1035 (domain, label, ldh_str, sub_eof, subdomain, DomainError(..))
|
||||
|
||||
import Prelude (Unit, discard, show, ($), (<>))
|
||||
import Data.Either (Either(..))
|
||||
|
@ -23,10 +23,10 @@ id :: forall a. a -> a
|
|||
id a = a
|
||||
|
||||
showerror :: DomainError -> String
|
||||
showerror (SubdomainTooLarge size) = "SubdomainTooLarge (size: " <> show size <> ")"
|
||||
showerror (DomainTooLarge size) = "DomainTooLarge (size: " <> show size <> ")"
|
||||
showerror (InvalidCharacter) = "InvalidCharacter"
|
||||
showerror (EOFExpected) = "EOFExpected"
|
||||
showerror (LabelTooLarge size) = "LabelTooLarge (size: " <> show size <> ")"
|
||||
showerror (DomainTooLarge size) = "DomainTooLarge (size: " <> show size <> ")"
|
||||
showerror (InvalidCharacter) = "InvalidCharacter"
|
||||
showerror (EOFExpected) = "EOFExpected"
|
||||
|
||||
main :: Effect Unit
|
||||
main = do
|
||||
|
|
Loading…
Reference in New Issue