typechecking things

src/Core/HindleyMilner.hs

@@ -21,6 +21,7 @@ import Lens.Micro.Mtl
 import Lens.Micro.Platform
 import Data.Maybe               (fromMaybe)
 import Data.Text                qualified as T
+import Data.Pretty              (rpretty)
 import Data.HashMap.Strict      qualified as H
 import Data.Foldable            (traverse_)
 import Data.Functor
@@ -59,26 +60,22 @@ instance IsRlpcError TypeError where
         -- todo: use anti-parser instead of show
         TyErrCouldNotUnify t u -> Text
             [ T.pack $ printf "Could not match type `%s` with `%s`."
-                              (show t) (show u)
-            , "Expected: " <> tshow t
-            , "Got: " <> tshow u
+                              (rpretty @String t) (rpretty @String u)
+            , "Expected: " <> rpretty t
+            , "Got: " <> rpretty u
             ]
         TyErrUntypedVariable n -> Text
             [ "Untyped (likely undefined) variable `" <> n <> "`"
             ]
         TyErrRecursiveType t x -> Text
-            [ T.pack $ printf "recursive type error lol"
+            [ T.pack $ printf "Recursive type: `%s' occurs in `%s'"
+                              (rpretty @String t) (rpretty @String x)
             ]
 
-        where tshow = T.pack . show
-
 -- | Synonym for @Errorful [TypeError]@. This means an @HMError@ action may
 -- throw any number of fatal or nonfatal errors. Run with @runErrorful@.
 type HMError = Errorful TypeError
 
--- TODO: better errors. Errorful-esque, with cummulative errors instead of
--- instantly dying.
-
 -- | Assert that an expression unifies with a given type
 --
 -- >>> let e = [coreProg|3|]
@@ -281,9 +278,3 @@ demoContext =
     , ("False", TyCon "Bool")
     ]
 
-pprintType :: Type -> String
-pprintType (s :-> t) = "(" <> pprintType s <> " -> " <> pprintType t <> ")"
-pprintType TyFun = "(->)"
-pprintType (TyVar x) = x ^. unpacked
-pprintType (TyCon t) = t ^. unpacked
-