Show renamer issue

app/Main.hs

@@ -163,80 +163,81 @@ displayInferException specialTypes =
 
 displayRenamerException :: SpecialTypes Name -> RenamerException -> [Char]
 displayRenamerException specialTypes =
-  \case
-    IdentifierNotInVarScope scope name ->
-      "Not in variable scope " ++
-      curlyQuotes (printit name) ++
-      "\n" ++
-      "Nearest names in scope:\n\n" ++
-      intercalate
-        ", "
-        (map
-           curlyQuotes
-           (take
-              5
-              (sortBy
-                 (comparing (editDistance (printit name)))
-                 (map printit (M.elems scope)))))
-    IdentifierNotInConScope scope name ->
-      "Not in constructors scope " ++
-      curlyQuotes (printit name) ++
-      "\n" ++
-      "Nearest names in scope:\n\n" ++
-      intercalate
-        ", "
-        (map
-           curlyQuotes
-           (take
-              5
-              (sortBy
-                 (comparing (editDistance (printit name)))
-                 (map printit (M.elems scope)))))
-    KindTooManyArgs ty k ty2 ->
-      "The type " ++
-      curlyQuotes (printType specialTypes ty ++ " :: " ++ printKind k) ++
-      " has an unexpected additional argument, " ++
-      curlyQuotes (printType specialTypes ty2)
-    ConstructorFieldKind cons typ kind ->
-      "The type " ++
-      curlyQuotes (printType specialTypes typ ++ " :: " ++ printKind kind) ++
-      " is used in a field in the " ++
-      curlyQuotes (printit cons) ++
-      " constructor, but all fields \
-      \should have types of kind " ++
-      curlyQuotes (printKind StarKind)
-    KindArgMismatch t1 k1 t2 k2 ->
-      "The type " ++
-      curlyQuotes (printType specialTypes t1 ++ " :: " ++ printKind k1) ++
-      " has been given an argument of the wrong kind " ++
-      curlyQuotes (printType specialTypes t2 ++ " :: " ++ printKind k2)
-    TypeNotInScope types i ->
-      "Unknown type " ++
-      curlyQuotes (printIdentifier i) ++
-      "\n" ++
-      "Closest names in scope are: " ++
-      intercalate
-        ", "
-        (map
-           curlyQuotes
-           (take
-              5
-              (sortBy
-                 (comparing (editDistance (printIdentifier i)))
-                 (map printTypeConstructor types))))
-    UnknownTypeVariable types i ->
-      "Unknown type variable " ++
-      curlyQuotes (printIdentifier i) ++
-      "\n" ++
-      "Type variables in scope are: " ++
-      intercalate
-        ", "
-        (map
-           curlyQuotes
-           (sortBy
-              (comparing (editDistance (printIdentifier i)))
-              (map printTypeVariable types)))
-    e -> show e
+  wrap (\case
+          IdentifierNotInVarScope scope name ->
+            "Not in variable scope " ++
+            curlyQuotes (printit name) ++
+            "\n" ++
+            "Nearest names in scope:\n\n" ++
+            intercalate
+              ", "
+              (map
+                 curlyQuotes
+                 (take
+                    5
+                    (sortBy
+                       (comparing (editDistance (printit name)))
+                       (map printit (M.elems scope)))))
+          IdentifierNotInConScope scope name ->
+            "Not in constructors scope " ++
+            curlyQuotes (printit name) ++
+            "\n" ++
+            "Nearest names in scope:\n\n" ++
+            intercalate
+              ", "
+              (map
+                 curlyQuotes
+                 (take
+                    5
+                    (sortBy
+                       (comparing (editDistance (printit name)))
+                       (map printit (M.elems scope)))))
+          KindTooManyArgs ty k ty2 ->
+            "The type " ++
+            curlyQuotes (printType specialTypes ty ++ " :: " ++ printKind k) ++
+            " has an unexpected additional argument, " ++
+            curlyQuotes (printType specialTypes ty2)
+          ConstructorFieldKind cons typ kind ->
+            "The type " ++
+            curlyQuotes (printType specialTypes typ ++ " :: " ++ printKind kind) ++
+            " is used in a field in the " ++
+            curlyQuotes (printit cons) ++
+            " constructor, but all fields \
+            \should have types of kind " ++
+            curlyQuotes (printKind StarKind)
+          KindArgMismatch t1 k1 t2 k2 ->
+            "The type " ++
+            curlyQuotes (printType specialTypes t1 ++ " :: " ++ printKind k1) ++
+            " has been given an argument of the wrong kind " ++
+            curlyQuotes (printType specialTypes t2 ++ " :: " ++ printKind k2)
+          TypeNotInScope types i ->
+            "Unknown type " ++
+            curlyQuotes (printIdentifier i) ++
+            "\n" ++
+            "Closest names in scope are: " ++
+            intercalate
+              ", "
+              (map
+                 curlyQuotes
+                 (take
+                    5
+                    (sortBy
+                       (comparing (editDistance (printIdentifier i)))
+                       (map printTypeConstructor types))))
+          UnknownTypeVariable types i ->
+            "Unknown type variable " ++
+            curlyQuotes (printIdentifier i) ++
+            "\n" ++
+            "Type variables in scope are: " ++
+            intercalate
+              ", "
+              (map
+                 curlyQuotes
+                 (sortBy
+                    (comparing (editDistance (printIdentifier i)))
+                    (map printTypeVariable types)))
+          e -> show e)
+  where wrap f e = (f e) ++ "\n(" ++ show e ++ ")"
 
 editDistance :: [Char] -> [Char] -> Int
 editDistance = on (levenshteinDistance defaultEditCosts) (map toLower)

examples/Classes.hs

@@ -20,6 +20,9 @@ data Maybe a = Nothing | Just a
 class F (a :: Type -> Type) where
   fm :: a Nat
 
+class Functor f where
+  map :: forall a b. (a -> b) -> f a -> f b
+
 data Ch = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
 class Equal a where
   equal :: a -> a -> Bool