parser/test/Main.purs

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