parser/test/Main.purs

module Test.Main where

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)

import GenericParser.Parser (Parser(..))
import GenericParser.Parser as P
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 Test.TestValues as T

run :: forall e v. Parser e v -> String -> P.Result e v
run (Parser p) str = p { string: str, position: 0 }

data COMPARISON = SAME | DIFFERENT | FAILED
compare_results :: forall e v. Parser e v -> Parser e v -> String -> COMPARISON
compare_results p1 p2 str
  = let e1 = run p1 str
        e2 = run p2 str
    in case e1, e2 of
         Right r1, Right r2 -> if r1.suffix == r2.suffix
                               then SAME
                               else DIFFERENT
         _, _ -> FAILED

compare_parsers :: forall e v. String -> Parser e v -> Parser e v -> String -> Effect Unit
compare_parsers s p1 p2 str
  = log $ s <> " "
          <> case compare_results p1 p2 str of
               SAME -> "SAME"
               DIFFERENT -> "DIFFERENT"
               FAILED -> "FAILED"
          <> " [" <> str <>"] "

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"

showerror_ipv4 :: IP.IPv4Error -> String
showerror_ipv4 (NumberTooBig x) = "value '" <> show x <> "' is > 255"
showerror_ipv4 IPv4UnrelevantShortRepresentation = "useless double dots"

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

main :: Effect Unit
main = do
  test_series "ldh_str" ldh_str fromCharArray showerror T.domains
  log ""
  test_series "RFC1035.label" RFC1035.label id showerror T.domains
  log ""
  test_series "RFC1035.subdomain" RFC1035.subdomain id showerror T.domains
  log ""
  test_series "RFC1035.sub_eof" RFC1035.sub_eof id showerror T.domains
  log ""
  test_series "RFC1035.domain" RFC1035.domain id showerror T.domains
  log ""
  test_series "ModernDomains.domain" ModernDomains.domain id showerror T.domains

  log ""
  test_series "IP.ipv4" IP.ipv4 id showerror_ipv4 T.ipv4_addresses

  log ""
  test_series "IP.ipv6" IP.ipv6 id showerror_ipv6 T.ipv6_addresses

  log ""
  test_series "E.email" E.email id showerror_email T.valid_email_addresses

  log ""
  test_series "E.address (short)" E.address id showerror_email T.valid_email_addresses_short

  log ""
  let spaces   = [ """" """", """ " """" ]
      lreturns = [ """" \r\nx"""", """ "\r\n"""", """ "\r\n """" ]
      characters = [ "\r", "\n", "\"" ]
  test_series "E.quoted_string (short)" E.quoted_string id showerror_email spaces
  test_series "E.qcontent (short)" E.qcontent id showerror_email spaces

  test_series "E.quoted_string (lreturns)" E.quoted_string id showerror_email lreturns
  test_series "E.qcontent (characters)" E.qcontent id showerror_email characters

  log ""
  let quotedstrings = [ """" "spaces?""", """ " " """ ]
  test_series "E.quoted_string---------------" E.quoted_string id showerror_email quotedstrings
  test_series "P.read_input (E.quoted_string)" (P.read_input E.quoted_string) id showerror_email quotedstrings

  log "Does parsers behave correctly (give the exact same input)?"
  foreachE T.valid_email_addresses_short (\s -> compare_parsers "E.address" (P.read_input E.address) E.address s)