module Test.Main where import GenericParser.Parser (Parser(..), parse) import GenericParser.DomainParser.Common (ldh_str, DomainError(..)) import GenericParser.DomainParserRFC1035 as RFC1035 import GenericParser.DomainParser as ModernDomains import GenericParser.IPAddress (IPv4Error(..)) import GenericParser.IPAddress as IP import GenericParser.EmailAddress as E import Prelude (Unit, discard, show, ($), (<>)) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) import Data.String.CodeUnits (fromCharArray) import Effect.Console (log) import Effect (Effect, foreachE) 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 Right { suffix, result } -> (r result) <> " '" <> suffix.string <> "'" 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" test_series :: forall e v . String -> Parser e v -> (v -> String) -> (e -> String) -> Array String -> Effect Unit 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 <> "'" showerror_ipv4 :: IP.IPv4Error -> String showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255" 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.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 <> "'" main :: Effect Unit main = do let domains = [ "", "-", ".", "a", "a.", "a-", "a.x", "a2.org", "a33.org", "xblah.a.x", "xblah.a2.org", "xblah.a33.org", "_dmarc.example.com" ] test_series "ldh_str" ldh_str fromCharArray showerror domains log "" test_series "RFC1035.label" RFC1035.label id showerror domains log "" test_series "RFC1035.subdomain" RFC1035.subdomain id showerror domains log "" test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror domains log "" test_series "RFC1035.domain" RFC1035.domain id showerror domains log "" test_series "ModernDomains.domain" ModernDomains.domain id showerror domains log "" test_ipv4 "10..1." test_ipv4 "10..1" test_ipv4 "1..2" test_ipv4 "1.2.3.4" test_ipv4 "192.168..1" test_ipv4 "1..2.3.4" test_ipv4 "1.5.10.255" test_ipv4 "100.200.300.400" log "" test_ipv6 "2001:0" test_ipv6 "2001::x:0" test_ipv6 "2001:x::0" test_ipv6 "2001::0" test_ipv6 "2001::1:" test_ipv6 "::" test_ipv6 "2001::" test_ipv6 "::1" 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" test_email "guy-@example.com"