From 497f51bc3affe5b372097810093405c3518a5919 Mon Sep 17 00:00:00 2001
From: Ian Grant Jeffries <ian@housejeffries.com>
Date: Sun, 10 Nov 2019 14:26:20 -0500
Subject: [PATCH] Flatten TypeError

---
 bowtie/src/Bowtie/Infer/Unify.hs                     |  8 ++++----
 bowtie/src/Bowtie/Surface/Infer.hs                   | 12 +++++++++---
 .../case-binding-used-incorrectly.bowtie             |  2 +-
 .../ill-typed-examples/case-mismatched-bodies.bowtie |  2 +-
 .../let-recursion-mistyped-realistic.bowtie          |  2 +-
 .../let-recursion-mistyped-simple.bowtie             |  2 +-
 6 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/bowtie/src/Bowtie/Infer/Unify.hs b/bowtie/src/Bowtie/Infer/Unify.hs
index 8dc6c4b..cba50cf 100644
--- a/bowtie/src/Bowtie/Infer/Unify.hs
+++ b/bowtie/src/Bowtie/Infer/Unify.hs
@@ -8,8 +8,8 @@ import Bowtie.Surface.AST
 import qualified Data.Set as Set
 
 data UnifyError
-  = UnifyError Type Type
-  | OccursCheckFailed Id Type
+  = TypeMismatch Type Type
+  | IdOccursInType Id Type
   deriving (Eq, Show)
 
 -- | Implementation based on <doc.md#AlgorithmWStepByStep>.
@@ -67,13 +67,13 @@ unify t1 t2 =
           Right (s1 <> s2)
 
         _ ->
-          Left (UnifyError t1 t2)
+          Left (TypeMismatch t1 t2)
   where
     unifyVariable :: Id -> Type -> Either UnifyError Substitution
     unifyVariable id typ =
       if Set.member id (freeVars typ)
         then
-          Left (OccursCheckFailed id typ)
+          Left (IdOccursInType id typ)
 
         else
           Right (singleSub id typ)
diff --git a/bowtie/src/Bowtie/Surface/Infer.hs b/bowtie/src/Bowtie/Surface/Infer.hs
index 903d3d4..55960e0 100644
--- a/bowtie/src/Bowtie/Surface/Infer.hs
+++ b/bowtie/src/Bowtie/Surface/Infer.hs
@@ -21,7 +21,8 @@ import qualified Data.Set as Set
 
 data TypeError
   = SolveStuck
-  | SolveUnifyError UnifyError
+  | UnifyError Type Type
+  | OccursCheckFailed Id Type
   | AssumptionsRemain Assumptions
   deriving (Eq, Show)
 
@@ -96,8 +97,13 @@ instance CanSolveStuck Infer where
 
 instance CanUnifyError Infer where
   failUnifyError :: UnifyError -> Infer a
-  failUnifyError =
-    throwError . SolveUnifyError
+  failUnifyError e =
+    throwError (case e of
+                 TypeMismatch t1 t2 ->
+                   UnifyError t1 t2
+
+                 IdOccursInType id t ->
+                   OccursCheckFailed id t)
 
 instance CanAssumptionsRemain Infer where
   failAssumptionsRemain :: Assumptions -> Infer a
diff --git a/bowtie/test/ill-typed-examples/case-binding-used-incorrectly.bowtie b/bowtie/test/ill-typed-examples/case-binding-used-incorrectly.bowtie
index b1f2f18..b267937 100644
--- a/bowtie/test/ill-typed-examples/case-binding-used-incorrectly.bowtie
+++ b/bowtie/test/ill-typed-examples/case-binding-used-incorrectly.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
\ No newline at end of file
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
\ No newline at end of file
diff --git a/bowtie/test/ill-typed-examples/case-mismatched-bodies.bowtie b/bowtie/test/ill-typed-examples/case-mismatched-bodies.bowtie
index b1f2f18..b267937 100644
--- a/bowtie/test/ill-typed-examples/case-mismatched-bodies.bowtie
+++ b/bowtie/test/ill-typed-examples/case-mismatched-bodies.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
\ No newline at end of file
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
\ No newline at end of file
diff --git a/bowtie/test/ill-typed-examples/let-recursion-mistyped-realistic.bowtie b/bowtie/test/ill-typed-examples/let-recursion-mistyped-realistic.bowtie
index b1f2f18..b267937 100644
--- a/bowtie/test/ill-typed-examples/let-recursion-mistyped-realistic.bowtie
+++ b/bowtie/test/ill-typed-examples/let-recursion-mistyped-realistic.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
\ No newline at end of file
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
\ No newline at end of file
diff --git a/bowtie/test/ill-typed-examples/let-recursion-mistyped-simple.bowtie b/bowtie/test/ill-typed-examples/let-recursion-mistyped-simple.bowtie
index b1f2f18..b267937 100644
--- a/bowtie/test/ill-typed-examples/let-recursion-mistyped-simple.bowtie
+++ b/bowtie/test/ill-typed-examples/let-recursion-mistyped-simple.bowtie
@@ -1 +1 @@
-SolveUnifyError (UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool")))
\ No newline at end of file
+UnifyError (TConstructor (Id "Int")) (TConstructor (Id "Bool"))
\ No newline at end of file