token stuff

tests/src/Tests/Lexer.idr

@@ -6,32 +6,36 @@ import TAP
 
 export
 ToInfo Error where
-  toInfo (Err line col char) =
-    [("line", show line), ("col", show col), ("char", show char)]
+  toInfo (Err reason line col char) =
+    [("reason", show reason),
+     ("line",   show line),
+     ("col",    show col),
+     ("char",   show char)]
 
 data ExtraError
-= WrongAnswer (List Kind) (List Kind)
-| TestFailed  (List Kind)
+= WrongAnswer (List Token) (List Token)
+| TestFailed  (List Token)
 
 ToInfo ExtraError where
   toInfo (WrongAnswer exp got) =
     [("expected", show exp), ("received", show got)]
-  toInfo (TestFailed got) = [("failed", show got)]
+  toInfo (TestFailed got) =
+    [("failed", show got)]
 
 
 parameters (label : String) (input : String)
-  acceptsSuchThat' : (List Kind -> Maybe ExtraError) -> Test
+  acceptsSuchThat' : (List Token -> Maybe ExtraError) -> Test
   acceptsSuchThat' p = test {es = [Lexer.Error, ExtraError]} label $ do
-    res <- map (kind . val) <$> lex input
+    res <- map val <$> lex input
     case p res of
          Just err => throw err
          Nothing  => pure ()
 
-  acceptsSuchThat : (List Kind -> Bool) -> Test
+  acceptsSuchThat : (List Token -> Bool) -> Test
   acceptsSuchThat p = acceptsSuchThat' $ \res =>
     if p res then Nothing else Just $ TestFailed res
 
-  acceptsWith : List Kind -> Test
+  acceptsWith : List Token -> Test
   acceptsWith expect = acceptsSuchThat' $ \res =>
     if res == expect then Nothing else Just $ WrongAnswer expect res
 
@@ -40,13 +44,13 @@ parameters (label : String) (input : String)
 
   rejects : Test
   rejects = testThrows {es = [Lexer.Error]} label $ delay $
-    map (kind . val) <$> lex input
+    map val <$> lex input
 
 parameters (input : String) {default False esc : Bool}
   show' : String -> String
   show' s = if esc then show s else "\"\{s}\""
 
-  acceptsWith' : List Kind -> Test
+  acceptsWith' : List Token -> Test
   acceptsWith' = acceptsWith (show' input) input
 
   accepts' : Test
@@ -87,19 +91,19 @@ tests = "lexer" :- [
   ],
 
   "names & symbols" :- [
-    acceptsWith' "a"        [Name],
-    acceptsWith' "abc"      [Name],
-    acceptsWith' "_a"       [Name],
-    acceptsWith' "a_"       [Name],
-    acceptsWith' "a_b"      [Name],
-    acceptsWith' "abc'"     [Name],
-    acceptsWith' "a'b'c''"  [Name],
-    acceptsWith' "abc123"   [Name],
-    acceptsWith' "ab cd"    [Name, Name],
-    acceptsWith' "ab{--}cd" [Name, Name],
-    acceptsWith' "'a"       [Symbol],
-    acceptsWith' "'ab"      [Symbol],
-    acceptsWith' "'_b"      [Symbol],
+    acceptsWith' "a"        [Name "a"],
+    acceptsWith' "abc"      [Name "abc"],
+    acceptsWith' "_a"       [Name "_a"],
+    acceptsWith' "a_"       [Name "a_"],
+    acceptsWith' "a_b"      [Name "a_b"],
+    acceptsWith' "abc'"     [Name "abc'"],
+    acceptsWith' "a'b'c''"  [Name "a'b'c''"],
+    acceptsWith' "abc123"   [Name "abc123"],
+    acceptsWith' "ab cd"    [Name "ab", Name "cd"],
+    acceptsWith' "ab{--}cd" [Name "ab", Name "cd"],
+    acceptsWith' "'a"       [Symbol "a"],
+    acceptsWith' "'ab"      [Symbol "ab"],
+    acceptsWith' "'_b"      [Symbol "_b"],
     rejects'     "'"
   ]
 ]