64 lines
2.1 KiB
Plaintext
64 lines
2.1 KiB
Plaintext
module Test.Main where
|
|
|
|
import GenericParser.Parser (Parser(..))
|
|
import GenericParser.DomainParser.Common (ldh_str, DomainError(..))
|
|
import GenericParser.DomainParserRFC1035 as RFC1035
|
|
import GenericParser.DomainParser as ModernDomains
|
|
|
|
import Prelude (Unit, discard, show, ($), (<>))
|
|
import Data.Either (Either(..))
|
|
import Data.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 } -> show (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)
|
|
|
|
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
|