module Tests.CharExtra

import Quox.NatExtra
import Quox.CharExtra
import Data.List
import Data.String
import Data.Maybe
import TAP


escape : Char -> Maybe String
escape '\'' = Nothing
escape c =
  if ord c > 0xFF then Nothing else
  case unpack $ show c of
       '\'' :: '\\' :: cs => pack . ('\\' ::) <$> init' cs
       _                  => Nothing

display : Char -> String
display c =
  let ord = cast c {to = Nat} in
  let c'  = fromMaybe (singleton c) $ escape c in
  if 0x20 <= ord && ord <= 0xFF then
    "｢\{c'}｣"
  else
    let codepoint = padLeft 4 '0' $ showHex ord in
    "｢\{c'}｣ (U+\{codepoint})"

testOne : (Char -> Bool) -> Char -> Test
testOne pred c = test (display c) $ unless (pred c) $ Left ()

testAll : String -> (Char -> Bool) -> List Char -> Test
testAll label pred chars = label :- map (testOne pred) chars


tests = "char extras" :- [
  testAll "id starts" isIdStart
    ['a', 'á', '𝕕', '개', 'ʨ', '𒁙', '𝟙'],
  testAll "not id starts" (not . isIdStart)
    ['0', '_', '-', '‿', ' ', '[', ',', '.', '\1'],
  testAll "id continuations" isIdCont
    ['a', 'á', '𝕕', '개', 'ʨ', '𒁙', '0', '\''],
  testAll "not id continuations" (not . isIdCont)
    ['_', '‿', ' ', '[', ',', '.', '\1'],
  testAll "id connectors" isIdConnector
    ['_', '‿'],
  testAll "not id connectors" (not . isIdConnector)
    ['a', ' ', ',', '-'],
  testAll "white space" isWhitespace
    [' ', '\t', '\r', '\n',
     '\x2028', -- line separator
     '\x2029'  -- paragraph separator
    ],
  testAll "not white space" (not . isWhitespace)
    ['a', '-', '_', '\1']
]