DomainParserRFC1035, documentation, code structure (try fn -> Parser module).
This commit is contained in:
		
							parent
							
								
									d4aa63730e
								
							
						
					
					
						commit
						22d6386c32
					
				
					 5 changed files with 47 additions and 33 deletions
				
			
		
							
								
								
									
										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…
	
	Add table
		
		Reference in a new issue