DomainParserRFC1035, documentation, code structure (try fn -> Parser module).

master
Philippe Pittoli 2024-01-19 15:08:52 +01:00
parent d4aa63730e
commit 22d6386c32
5 changed files with 47 additions and 33 deletions

View File

@ -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)

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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