Baguette/parser
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: Baguette:1951d893a9a629f89a90af54d3efe20f4f24623f
Branches Tags
Baguette:master
Baguette:v1
..
compare: Baguette:98680021149f91a241b32bf02b9df3f27160b4b7
Branches Tags
Baguette:master
Baguette:v1

No commits in common. "1951d893a9a629f89a90af54d3efe20f4f24623f" and "98680021149f91a241b32bf02b9df3f27160b4b7" have entirely different histories.
1951d893a9 ... 9868002114

2 changed files with 78 additions and 55 deletions
Show Stats Expand all files Collapse all files

52
src/GenericParser/RFC5234.purs
View File

@ -2,41 +2,37 @@
-- | This module implements core rules found in appendix B.1. -- | This module implements core rules found in appendix B.1.
module GenericParser.RFC5234 where module GenericParser.RFC5234 where
import Prelude (Unit, between, bind, void, ($)) import Prelude (Unit, unit, bind, pure, ($), (<>), (==), (||), between, void)
import Control.Alt ((<|>)) import Control.Alt ((<|>))
import Data.Array as A
import Data.Char as C import Data.Char as C
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.String.CodeUnits as CU
import GenericParser.BaseFunctions (isHexaDecimal) import GenericParser.BaseFunctions (repeat, isHexaDecimal)
import GenericParser.Parser (Parser, char, sat) import GenericParser.Parser (Parser(..)
, sat, char , digit , letter, item, many1, tryMaybe
, current_input, failureError, parse, rollback, until)
-- | RFC 5234: -- | RFC 5234:
--ALPHA = %x41-5A / %x61-7A ; A-Z / a-z --ALPHA = %x41-5A / %x61-7A ; A-Z / a-z
--
--BIT = "0" / "1" --BIT = "0" / "1"
--
-- | CHAR (renamed `asciichar` to fix naming conflict with `GenericParser.char`): --CHAR = %x01-7F
-- | any 7-bit US-ASCII character, excluding NUL. -- ; any 7-bit US-ASCII character,
-- | -- ; excluding NUL
-- | CHAR = %x01-7F --
asciichar :: forall e. Parser e Char --CR = %x0D
asciichar = sat (\x -> between 1 127 $ C.toCharCode x) -- ; carriage return
--
-- | CR: carriage return. --CRLF = CR LF
-- | -- ; Internet standard newline
-- | CR = %x0D --
cr :: forall e. Parser e Unit
cr = void $ char '\r'
-- | CRLF: Internet standard newline.
-- |
-- | CRLF = CR LF
crlf :: forall e. Parser e Unit
crlf = do _ <- char '\r'
void $ char '\n'
--CTL = %x00-1F / %x7F --CTL = %x00-1F / %x7F
-- ; controls -- ; controls
-- --
@ -91,3 +87,9 @@ vchar = sat (\x -> between 33 126 $ C.toCharCode x)
-- | WSP = SP / HTAB -- | WSP = SP / HTAB
wsp :: forall e. Parser e Char wsp :: forall e. Parser e Char
wsp = sp <|> htab wsp = sp <|> htab
crlf :: forall e. Parser e Unit
crlf = do _ <- char '\r'
_ <- char '\n'
pure unit

81
test/Main.purs
View File

@ -1,6 +1,6 @@
module Test.Main where module Test.Main where
import GenericParser.Parser (Parser(..)) import GenericParser.Parser (Parser(..), parse)
import GenericParser.DomainParser.Common (ldh_str, DomainError(..)) import GenericParser.DomainParser.Common (ldh_str, DomainError(..))
import GenericParser.DomainParserRFC1035 as RFC1035 import GenericParser.DomainParserRFC1035 as RFC1035
import GenericParser.DomainParser as ModernDomains import GenericParser.DomainParser as ModernDomains
@ -49,14 +49,41 @@ showerror_ipv6 (IP.NotEnoughChunks) = "NotEnoughChunks"
showerror_ipv6 (IP.TooManyChunks) = "TooManyChunks" showerror_ipv6 (IP.TooManyChunks) = "TooManyChunks"
showerror_ipv6 IP.IPv6UnrelevantShortRepresentation = "useless double dots" showerror_ipv6 IP.IPv6UnrelevantShortRepresentation = "useless double dots"
test_ipv6 :: String -> Effect Unit
test_ipv6 ipv6string = do
log $ "(ipv6) parsing '" <> ipv6string <> "': "
<> case parse IP.ipv6 { string: ipv6string, position: 0 } of
Left { position, error } -> "failed at position " <> show position <> case error of
Nothing -> " -> no error reported"
Just err -> " -> error: " <> showerror_ipv6 err
Right { suffix, result } -> "result: " <> result <> " '" <> suffix.string <> "'"
showerror_ipv4 :: IP.IPv4Error -> String showerror_ipv4 :: IP.IPv4Error -> String
showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255" showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255"
showerror_ipv4 IPv4UnrelevantShortRepresentation = "useless double dots" showerror_ipv4 IPv4UnrelevantShortRepresentation = "useless double dots"
test_ipv4 :: String -> Effect Unit
test_ipv4 ipv4string = do
log $ "(ipv4) parsing '" <> ipv4string <> "': "
<> case parse IP.ipv4 { string: ipv4string, position: 0 } of
Left { position, error } -> "failed at position " <> show position <> case error of
Nothing -> " -> no error reported"
Just err -> " -> error: " <> showerror_ipv4 err
Right { suffix, result } -> "result: " <> result <> " '" <> suffix.string <> "'"
showerror_email :: E.EmailError -> String showerror_email :: E.EmailError -> String
showerror_email E.InvalidCharacter = "InvalidCharacter" showerror_email E.InvalidCharacter = "InvalidCharacter"
showerror_email (E.InvalidDomain e) = "invalid domain: " <> maybe "no domain error provided, weird" showerror e showerror_email (E.InvalidDomain e) = "invalid domain: " <> maybe "no domain error provided, weird" showerror e
test_email :: String -> Effect Unit
test_email emailstring = do
log $ "(email) parsing '" <> emailstring <> "': "
<> case parse E.email { string: emailstring, position: 0 } of
Left { position, error } -> "failed at position " <> show position <> case error of
Nothing -> " -> no error reported"
Just err -> " -> error: " <> showerror_email err
Right { suffix, result } -> "result: " <> result <> " '" <> suffix.string <> "'"
main :: Effect Unit main :: Effect Unit
main = do main = do
let domains = [ let domains = [
@ -87,36 +114,30 @@ main = do
test_series "ModernDomains.domain" ModernDomains.domain id showerror domains test_series "ModernDomains.domain" ModernDomains.domain id showerror domains
log "" log ""
let ipv4_addresses = [ "10..1." test_ipv4 "10..1."
, "10..1" test_ipv4 "10..1"
, "1..2" test_ipv4 "1..2"
, "1.2.3.4" test_ipv4 "1.2.3.4"
, "192.168..1" test_ipv4 "192.168..1"
, "1..2.3.4" test_ipv4 "1..2.3.4"
, "1.5.10.255" test_ipv4 "1.5.10.255"
, "100.200.300.400" test_ipv4 "100.200.300.400"
]
test_series "IP.ipv4" IP.ipv4 id showerror_ipv4 ipv4_addresses
log "" log ""
let ipv6_addresses = [ "2001:0" test_ipv6 "2001:0"
, "2001::x:0" test_ipv6 "2001::x:0"
, "2001:x::0" test_ipv6 "2001:x::0"
, "2001::0" test_ipv6 "2001::0"
, "2001::1:" test_ipv6 "2001::1:"
, "::" test_ipv6 "::"
, "2001::" test_ipv6 "2001::"
, "::1" test_ipv6 "::1"
, "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3" test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3"
, "2001:0db8:0000:0000:0000:8a2e:0370:7334" test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334"
, "2001:0db8::8a2e:0370:7334" test_ipv6 "2001:0db8::8a2e:0370:7334"
]
test_series "IP.ipv6" IP.ipv6 id showerror_ipv6 ipv6_addresses
log "" log ""
let email_addresses = [ "guy@example.com" test_email "guy@example.com"
, "guy.name@example.com" test_email "guy.name@example.com"
, "well-look-at-this-domain@.com" test_email "well-look-at-this-domain@.com"
, "guy-@example.com" test_email "guy-@example.com"
]
test_series "E.email" E.email id showerror_email email_addresses