127 lines
5.5 KiB
Plaintext
127 lines
5.5 KiB
Plaintext
module Main where
|
|
|
|
import GenericParser.Parser (Parser(..))
|
|
import GenericParser.DomainParser (domain, label, ldh_str, sub_eof, subdomain, DomainError(..))
|
|
|
|
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)
|
|
|
|
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 (SubdomainTooLarge size) = "SubdomainTooLarge (size: " <> show size <> ")"
|
|
showerror (DomainTooLarge size) = "DomainTooLarge (size: " <> show size <> ")"
|
|
showerror (InvalidCharacter) = "InvalidCharacter"
|
|
showerror (EOFExpected) = "EOFExpected"
|
|
|
|
main :: Effect Unit
|
|
main = do
|
|
logtest "ldh_str" ldh_str "a12B.fl" fromCharArray showerror
|
|
logtest "ldh_str" ldh_str "1efg.x1" fromCharArray showerror
|
|
logtest "ldh_str" ldh_str ".qjzleb" fromCharArray showerror
|
|
logtest "ldh_str" ldh_str "a-b.b-a" fromCharArray showerror
|
|
logtest "ldh_str" ldh_str "" fromCharArray showerror
|
|
|
|
log ""
|
|
|
|
logtest "label" label "example.org" id showerror
|
|
logtest "label" label "" id showerror
|
|
logtest "label" label "a.x" id showerror
|
|
logtest "label" label "a2.org" id showerror
|
|
logtest "label" label "a33.org" id showerror
|
|
logtest "label" label "a444.org" id showerror
|
|
logtest "label" label "a5555.org" id showerror
|
|
logtest "label" label "a66666.org" id showerror
|
|
logtest "label" label "a777777.org" id showerror
|
|
logtest "label" label "a8888888.org" id showerror
|
|
log ""
|
|
logtest "label" label "-" id showerror
|
|
logtest "label" label "a-" id showerror
|
|
|
|
log ""
|
|
|
|
logtest "subdomain" subdomain "example.org" id showerror
|
|
logtest "subdomain" subdomain "" id showerror
|
|
logtest "subdomain" subdomain "a.x" id showerror
|
|
logtest "subdomain" subdomain "a2.org" id showerror
|
|
logtest "subdomain" subdomain "a33.org" id showerror
|
|
logtest "subdomain" subdomain "a444.org" id showerror
|
|
logtest "subdomain" subdomain "a5555.org" id showerror
|
|
logtest "subdomain" subdomain "a66666.org" id showerror
|
|
logtest "subdomain" subdomain "a777777.org" id showerror
|
|
logtest "subdomain" subdomain "a8888888.org" id showerror
|
|
logtest "subdomain" subdomain "xblah.a.x" id showerror
|
|
logtest "subdomain" subdomain "xblah.a2.org" id showerror
|
|
logtest "subdomain" subdomain "xblah.a33.org" id showerror
|
|
logtest "subdomain" subdomain "xblah.a444.org" id showerror
|
|
logtest "subdomain" subdomain "xblah.a5555.org" id showerror
|
|
logtest "subdomain" subdomain "xblah.a66666.org" id showerror
|
|
logtest "subdomain" subdomain "xblah.a777777.org" id showerror
|
|
logtest "subdomain" subdomain "xblah.a8888888.org" id showerror
|
|
logtest "subdomain" subdomain "-" id showerror
|
|
logtest "subdomain" subdomain "a-" id showerror
|
|
|
|
log ""
|
|
|
|
logtest "sub_eof" sub_eof " " id showerror
|
|
logtest "sub_eof" sub_eof " " id showerror
|
|
logtest "sub_eof" sub_eof "example.org" id showerror
|
|
logtest "sub_eof" sub_eof "" id showerror
|
|
logtest "sub_eof" sub_eof "a.x" id showerror
|
|
logtest "sub_eof" sub_eof "a2.org" id showerror
|
|
logtest "sub_eof" sub_eof "a33.org" id showerror
|
|
logtest "sub_eof" sub_eof "a444.org" id showerror
|
|
logtest "sub_eof" sub_eof "a5555.org" id showerror
|
|
logtest "sub_eof" sub_eof "a66666.org" id showerror
|
|
logtest "sub_eof" sub_eof "a777777.org" id showerror
|
|
logtest "sub_eof" sub_eof "a8888888.org" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a.x" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a2.org" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a33.org" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a444.org" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a5555.org" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a66666.org" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a777777.org" id showerror
|
|
logtest "sub_eof" sub_eof "xblah.a8888888.org" id showerror
|
|
logtest "sub_eof" sub_eof "-" id showerror
|
|
logtest "sub_eof" sub_eof "a-" id showerror
|
|
|
|
log ""
|
|
|
|
logtest "domain" domain " " id showerror
|
|
logtest "domain" domain " " id showerror
|
|
logtest "domain" domain "example.org" id showerror
|
|
logtest "domain" domain "" id showerror
|
|
logtest "domain" domain "a.x" id showerror
|
|
logtest "domain" domain "a2.org" id showerror
|
|
logtest "domain" domain "a33.org" id showerror
|
|
logtest "domain" domain "a444.org" id showerror
|
|
logtest "domain" domain "a5555.org" id showerror
|
|
logtest "domain" domain "a66666.org" id showerror
|
|
logtest "domain" domain "a777777.org" id showerror
|
|
logtest "domain" domain "a8888888.org" id showerror
|
|
logtest "domain" domain "xblah.a.x" id showerror
|
|
logtest "domain" domain "xblah.a2.org" id showerror
|
|
logtest "domain" domain "xblah.a33.org" id showerror
|
|
logtest "domain" domain "xblah.a444.org" id showerror
|
|
logtest "domain" domain "xblah.a5555.org" id showerror
|
|
logtest "domain" domain "xblah.a66666.org" id showerror
|
|
logtest "domain" domain "xblah.a777777.org" id showerror
|
|
logtest "domain" domain "xblah.a8888888.org" id showerror
|
|
logtest "domain" domain "-" id showerror
|
|
logtest "domain" domain "a-" id showerror
|