parser/test/Main.purs

136 lines
5.0 KiB
Plaintext
Raw Normal View History

2023-12-17 12:57:26 +01:00
module Test.Main where
2024-01-23 03:55:45 +01:00
import GenericParser.Parser (Parser(..), parse)
import GenericParser.DomainParser.Common (ldh_str, DomainError(..))
2024-01-19 18:24:02 +01:00
import GenericParser.DomainParserRFC1035 as RFC1035
2024-01-19 19:32:43 +01:00
import GenericParser.DomainParser as ModernDomains
2024-01-23 03:55:45 +01:00
import GenericParser.IPAddress (IPv4Error(..))
import GenericParser.IPAddress as IP
import GenericParser.EmailAddress as E
2023-12-17 12:57:26 +01:00
2024-01-20 01:05:11 +01:00
import Prelude (Unit, discard, show, ($), (<>))
2024-01-19 02:03:32 +01:00
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe)
2024-01-19 02:03:32 +01:00
import Data.String.CodeUnits (fromCharArray)
import Effect.Console (log)
2024-01-19 18:24:02 +01:00
import Effect (Effect, foreachE)
2024-01-19 02:03:32 +01:00
logtest :: forall e v. String -> Parser e v -> String -> (v -> String) -> (e -> String) -> Effect Unit
logtest fname (Parser p) str r e = do
log $ "(" <> fname <> ") parsing '" <> str <> "': "
<> case p { string: str, position: 0 } of
Left { position, error } -> "failed at position " <> show position <> case error of
Nothing -> " -> no error reported"
Just err -> " -> error: " <> e err
2024-01-23 03:55:45 +01:00
Right { suffix, result } -> (r result) <> " '" <> suffix.string <> "'"
2024-01-19 02:03:32 +01:00
id :: forall a. a -> a
id a = a
showerror :: DomainError -> String
showerror (LabelTooLarge size) = "LabelTooLarge (size: " <> show size <> ")"
showerror (DomainTooLarge size) = "DomainTooLarge (size: " <> show size <> ")"
showerror (InvalidCharacter) = "InvalidCharacter"
showerror (EOFExpected) = "EOFExpected"
2023-12-17 12:57:26 +01:00
2024-01-23 03:55:45 +01:00
test_series :: forall e v
. String
-> Parser e v
-> (v -> String)
-> (e -> String)
-> Array String
-> Effect Unit
2024-01-19 18:24:02 +01:00
test_series l p v e a = foreachE a (\s -> logtest l p s v e)
showerror_ipv6 :: IP.IPv6Error -> String
showerror_ipv6 (IP.InvalidCharacter) = "InvalidCharacter"
showerror_ipv6 (IP.TooManyHexaDecimalCharacters) = "TooManyHexaDecimalCharacters"
showerror_ipv6 (IP.NotEnoughChunks) = "NotEnoughChunks"
showerror_ipv6 (IP.TooManyChunks) = "TooManyChunks"
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 <> "'"
2024-01-23 03:55:45 +01:00
showerror_ipv4 :: IP.IPv4Error -> String
showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255"
showerror_ipv4 IPv4UnrelevantShortRepresentation = "useless double dots"
2024-01-23 03:55:45 +01:00
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.InvalidCharacter = "InvalidCharacter"
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 <> "'"
2023-12-17 12:57:26 +01:00
main :: Effect Unit
main = do
2024-01-19 18:24:02 +01:00
let domains = [
"",
"-",
".",
"a",
"a.",
"a-",
"a.x",
"a2.org",
"a33.org",
"xblah.a.x",
"xblah.a2.org",
"xblah.a33.org",
2024-01-19 19:32:43 +01:00
"_dmarc.example.com"
2024-01-19 18:24:02 +01:00
]
test_series "ldh_str" ldh_str fromCharArray showerror domains
2024-01-19 02:03:32 +01:00
log ""
2024-01-19 18:24:02 +01:00
test_series "RFC1035.label" RFC1035.label id showerror domains
2024-01-19 02:03:32 +01:00
log ""
2024-01-19 18:24:02 +01:00
test_series "RFC1035.subdomain" RFC1035.subdomain id showerror domains
2024-01-19 02:03:32 +01:00
log ""
2024-01-19 18:24:02 +01:00
test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror domains
2024-01-19 02:03:32 +01:00
log ""
2024-01-19 18:24:02 +01:00
test_series "RFC1035.domain" RFC1035.domain id showerror domains
2024-01-19 19:32:43 +01:00
log ""
test_series "ModernDomains.domain" ModernDomains.domain id showerror domains
2024-01-23 03:55:45 +01:00
log ""
2024-01-24 03:54:16 +01:00
test_ipv4 "10..1"
test_ipv4 "1..2"
2024-01-23 03:55:45 +01:00
test_ipv4 "1.2.3.4"
2024-01-24 03:54:16 +01:00
test_ipv4 "192.168..1"
2024-01-23 03:55:45 +01:00
test_ipv4 "1..2.3.4"
test_ipv4 "1.5.10.255"
test_ipv4 "100.200.300.400"
log ""
test_ipv6 "2001:0"
2024-01-24 03:54:16 +01:00
test_ipv6 "2001::0"
test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334:30:1035:3"
test_ipv6 "2001:0db8:0000:0000:0000:8a2e:0370:7334"
test_ipv6 "2001:0db8::8a2e:0370:7334"
log ""
test_email "guy@example.com"
test_email "guy.name@example.com"
test_email "well-look-at-this-domain@.com"