module Tests.Lexer import Quox.Name import Quox.Lexer import TAP private data Failure = LexError Lexer.Error | WrongLex (List Token) (List Token) | ExpectedFail (List Token) private ToInfo Failure where toInfo (LexError err) = [("type", "LexError"), ("info", show err)] toInfo (WrongLex want got) = [("type", "WrongLex"), ("want", show want), ("got", show got)] toInfo (ExpectedFail got) = [("type", "ExpectedFail"), ("got", show got)] private denewline : String -> String denewline = pack . map (\case '\n' => '␤'; c => c) . unpack private lexes : String -> List Token -> Test lexes str toks = test "「\{denewline str}」" $ do res <- bimap LexError (map val) $ lex str unless (toks == res) $ throwError $ WrongLex toks res private lexFail : String -> Test lexFail str = test "「\{denewline str}」 # fails" $ either (const $ Right ()) (Left . ExpectedFail . map val) $ lex str export tests : Test tests = "lexer" :- [ "comments" :- [ lexes "" [], lexes " " [], lexes "-- line comment" [], lexes "name -- line comment" [I "name"], lexes "-- line comment\nnameBetween -- and another" [I "nameBetween"], lexes "{- block comment -}" [], lexes "{- {- nested -} block comment -}" [] ], "identifiers & keywords" :- [ lexes "abc" [I "abc"], lexes "abc def" [I "abc", I "def"], lexes "abc{-comment-}def" [I "abc", I "def"], lexes "λ" [R "λ"], lexes "fun" [R "λ"], lexes "δ" [R "δ"], lexes "dfun" [R "δ"], lexes "funky" [I "funky"], lexes "δελτα" [I "δελτα"], lexes "★★" [I "★★"], lexes "Types" [I "Types"], lexes "a.b.c.d.e" [I $ MakeName [< "a","b","c","d"] "e"], lexes "normalïse" [I "normalïse"], lexes "map#" [I "map#"], lexes "write!" [I "write!"], lexes "uhh??!?!?!?" [I "uhh??!?!?!?"], -- ↑ replace i + combining ¨ with precomposed ï todo "check for reserved words in a qname", -- lexes "abc.fun.def" [I "abc", R ".", R "λ", R ".", I "def"], lexes "+" [I "+"], lexes "*" [I "*"], lexes "**" [R "×"], lexes "***" [I "***"], lexes "+**" [I "+**"], lexes "+#" [I "+#"], lexes "+.+.+" [I $ MakeName [< "+", "+"] "+"], lexes "a.+" [I $ MakeName [< "a"] "+"], lexes "+.a" [I $ MakeName [< "+"] "a"], lexes "+a" [I "+", I "a"], lexes "x." [I "x", R "·"], lexes "&." [I "&", R "·"], lexes ".x" [R "·", I "x"], lexes "a.b.c." [I $ MakeName [< "a", "b"] "c", R "·"], lexes "case" [R "case"], lexes "caseω" [R "caseω"], lexes "case#" [R "caseω"], lexes "case1" [R "case1"], lexes "case0" [I "case0"], lexes "case##" [I "case##"], lexes "_" [R "_"], lexes "_a" [I "_a"], lexes "a_" [I "a_"], lexes "a'" [I "a'"], lexes "+'" [I "+'"] ], "syntax characters" :- [ lexes "()" [R "(", R ")"], lexes "(a)" [R "(", I "a", R ")"], lexes "(^)" [R "(", I "^", R ")"], lexes "{a,b}" [R "{", I "a", R ",", I "b", R "}"], lexes "{+,-}" [R "{", I "+", R ",", I "-", R "}"] ], "tags" :- [ lexes #" 'a "# [T "a"], lexes #" 'abc "# [T "abc"], lexes #" '+ "# [T "+"], lexes #" '$$$ "# [T "$$$"], lexes #" 'tag.with.dots "# [T "tag.with.dots"], lexes #" '"multi word tag" "# [T "multi word tag"], lexes #" '"" "# [T ""], lexFail #" ' "#, lexFail #" '' "# ], "strings" :- [ lexes #" "" "# [S ""], lexes #" "abc" "# [S "abc"], lexes #" "\"" "# [S "\""], lexes #" "\\" "# [S "\\"], lexes #" "\\\"" "# [S "\\\""], todo "other escapes" ], "universes" :- [ lexes "Type0" [TYPE 0], lexes "Type₀" [TYPE 0], lexes "Type9999999" [TYPE 9999999], lexes "★₀" [TYPE 0], lexes "★₆₉" [TYPE 69], lexes "★4" [TYPE 4], lexes "Type" [R "★"], lexes "★" [R "★"] ] ]