add enums, which also need whnf to be fallible :(

tests/TermImpls.idr

@@ -37,6 +37,12 @@ mutual
     Pair fst1 snd1 == Pair fst2 snd2 = fst1 == fst2 && snd1 == snd2
     Pair {} == _ = False
 
+    Enum ts1 == Enum ts2 = ts1 == ts2
+    Enum _ == _ = False
+
+    Tag t1 == Tag t2 = t1 == t2
+    Tag _ == _ = False
+
     Eq ty1 l1 r1 == Eq ty2 l2 r2 =
       ty1 == ty2 && l1 == l2 && r1 == r2
     Eq {} == _ = False
@@ -74,6 +80,10 @@ mutual
       q1 == q2 && p1 == p2 && r1 == r2 && b1 == b2
     CasePair {} == _ = False
 
+    CaseEnum q1 t1 r1 a1 == CaseEnum q2 t2 r2 a2 =
+      q1 == q2 && t1 == t2 && r1 == r2 && a1 == a2
+    CaseEnum {} == _ = False
+
     (fun1 :% dim1) == (fun2 :% dim2) = fun1 == fun2 && dim1 == dim2
     (_ :% _) == _ = False
 

tests/Tests/Reduce.idr

@@ -36,7 +36,6 @@ tests = "whnf" :- [
       E $ F "f" :@ FT "a"
   ],
 
-
   "neutrals" :- [
     testNoStep "x" {n = 1} $ BV 0,
     testNoStep "a"         $ F "a",

tests/TypingImpls.idr

@@ -4,6 +4,14 @@ import TAP
 import public Quox.Typing
 import public Quox.Pretty
 
+
+export
+ToInfo WhnfErr where
+  toInfo (MissingEnumArm t ts) =
+    [("type", "MissingEnumArm"),
+     ("tag", show t),
+     ("list", show ts)]
+
 export
 PrettyHL q => ToInfo (Error q) where
   toInfo (NotInScope x) =
@@ -18,6 +26,9 @@ PrettyHL q => ToInfo (Error q) where
   toInfo (ExpectedSig t) =
     [("type", "ExpectedSig"),
      ("got",  prettyStr True t)]
+  toInfo (ExpectedEnum t) =
+    [("type", "ExpectedEnum"),
+     ("got",  prettyStr True t)]
   toInfo (ExpectedEq t) =
     [("type", "ExpectedEq"),
      ("got",  prettyStr True t)]
@@ -25,6 +36,14 @@ PrettyHL q => ToInfo (Error q) where
     [("type", "BadUniverse"),
      ("low",  show k),
      ("high", show l)]
+  toInfo (TagNotIn t ts) =
+    [("type", "TagNotIn"),
+     ("tag", show t),
+     ("set", show $ SortedSet.toList ts)]
+  toInfo (BadCaseQtys qouts) =
+    ("type", "BadCaseQtys") ::
+    [(show i, prettyStr True q) | (i, q) <- zip [0 .. length qouts] qouts]
+
   toInfo (ClashT mode ty s t) =
     [("type",  "ClashT"),
      ("mode",  show mode),
@@ -63,3 +82,5 @@ PrettyHL q => ToInfo (Error q) where
   toInfo (WhileInferring  _ _ _     err) = toInfo err
   toInfo (WhileComparingT _ _ _ _ _ err) = toInfo err
   toInfo (WhileComparingE _ _ _ _   err) = toInfo err
+
+  toInfo (WhnfError err) = toInfo err