57 lines
1.6 KiB
Idris
57 lines
1.6 KiB
Idris
|
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']
|
|||
|
|
]
|