new: add error handling

Author: cstml

lambda-buffers-compiler/src/LambdaBuffers/Compiler/KindCheck.hs

@@ -140,7 +140,41 @@ runKindCheck = interpret $ \case
     either (handleErrClassDef modName classDef) pure $ I.runClassDefCheck ctx modName classDef
   where
     handleErrClassDef :: forall {b}. PC.ModuleName -> PC.ClassDef -> I.InferErr -> Eff effs b
-    handleErrClassDef _ _ _err = error "Throw an error"
+    handleErrClassDef modName classDef = \case
+      I.InferUnboundTermErr ut ->
+        case ut of
+          QualifiedTyRef qtr -> do
+            if qtr ^. qTyRef'moduleName == modName
+              then do
+                -- We're looking at the local module.
+                let localRef = PC.LocalI . fst . withIso ltrISOqtr (\_ f -> f) $ qtr
+                let err = PC.UnboundTyRefError classDef localRef modName
+                throwError . PC.CKC'ClassDefError $ err
+              else do
+                -- We're looking at a foreign module.
+                let foreignRef = PC.ForeignI . withIso ftrISOqtr (\_ f -> f) $ qtr
+                throwError . PC.CKC'ClassDefError $ PC.UnboundTyRefError classDef foreignRef modName
+          TyVar tv ->
+            throwError . PC.CKC'ClassDefError $ PC.UnboundTyVarError classDef (PC.TyVar tv) modName
+          QualifiedTyClassRef qcr ->
+            if qcr ^. qTyClass'moduleName == modName
+              then do
+                -- We're looking at the local module.
+                let localClassRef = PC.LocalCI . fst . withIso lcrISOqtcr (\_ f -> f) $ qcr
+                let err = PC.UnboundTyClassRefError classDef localClassRef modName
+                throwError . PC.CKC'ClassDefError $ err
+              else do
+                -- We're looking at a foreign module.
+                let foreignRef = PC.ForeignCI . withIso fcrISOqtcr (\_ f -> f) $ qcr
+                let err = PC.UnboundTyClassRefError classDef foreignRef modName
+                throwError . PC.CKC'ClassDefError $ err
+      I.InferUnifyTermErr (I.Constraint (k1, k2)) -> do
+        err <- PC.IncorrectApplicationError classDef <$> kind2ProtoKind k1 <*> kind2ProtoKind k2 <*> pure modName
+        throwError $ PC.CKC'ClassDefError err
+      I.InferRecursiveSubstitutionErr _ ->
+        throwError . PC.CKC'ClassDefError $ PC.RecursiveKindError classDef modName
+      I.InferImpossibleErr t ->
+        throwError $ PC.C'InternalError t
 
     handleErrTyDef :: forall {b}. PC.ModuleName -> PC.TyDef -> I.InferErr -> Eff effs b
     handleErrTyDef modName td = \case

lambda-buffers-compiler/src/LambdaBuffers/Compiler/ProtoCompat/Types.hs

@@ -361,8 +361,10 @@ instance (Typeable loc, Show loc) => Exception (KindCheckError loc)
 
 -- | All the compiler errors.
 data CompilerError
-  = CKC'TyDefError (KindCheckError TyDef)
-  | CKC'ClassDefError (KindCheckError ClassDef)
+  = -- | Compiler KindChecker Error - within a Type Definition.
+    CKC'TyDefError (KindCheckError TyDef)
+  | -- | Compiler KindChecker Error - within a Class Definition.
+    CKC'ClassDefError (KindCheckError ClassDef)
   | C'InternalError Text
   deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (SOP.Generic)

lambda-buffers-compiler/test/Test/KindCheck/Errors.hs

@@ -2,7 +2,7 @@ module Test.KindCheck.Errors (testGKindCheckErrors) where
 
 import LambdaBuffers.Compiler.KindCheck (check_)
 import LambdaBuffers.Compiler.ProtoCompat qualified as PC
-import LambdaBuffers.Compiler.ProtoCompat.Types (CompilerError (CompKindCheckError), KindCheckError (UnboundTyRefError, UnboundTyVarError))
+import LambdaBuffers.Compiler.ProtoCompat.Types (CompilerError (CKC'TyDefError), KindCheckError (UnboundTyRefError, UnboundTyVarError))
 
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
@@ -17,19 +17,19 @@ undefinedVariable :: TestTree
 undefinedVariable =
   testCase "Catch undefined(free) variable in Type Definition." $
     check_ compilerInput'undefinedVariable
-      @?= (Left . CompKindCheckError . withDefModule) (UnboundTyVarError tyDef'undefinedVar tyDef'undefinedVar'var)
+      @?= (Left . CKC'TyDefError . withDefModule) (UnboundTyVarError tyDef'undefinedVar tyDef'undefinedVar'var)
 
 undefinedLocalTyRef :: TestTree
 undefinedLocalTyRef =
   testCase "Catch undefined Local TyRef in Type Definition." $
     check_ compilerInput'undefinedLocalTyRef
-      @?= (Left . CompKindCheckError . withDefModule) (UnboundTyRefError tyDef'undefinedLocalTyRef tyDef'undefinedLocalTyRef'TyRef)
+      @?= (Left . CKC'TyDefError . withDefModule) (UnboundTyRefError tyDef'undefinedLocalTyRef tyDef'undefinedLocalTyRef'TyRef)
 
 undefinedForeignTyRef :: TestTree
 undefinedForeignTyRef =
   testCase "Catch undefined Foreign TyRef in Type Definition." $
     check_ compilerInput'undefinedForeignTyRef
-      @?= (Left . CompKindCheckError . withDefModule) (UnboundTyRefError tyDef'undefinedForeignTyRef tyDef'undefinedForeignTyRef'TyRef)
+      @?= (Left . CKC'TyDefError . withDefModule) (UnboundTyRefError tyDef'undefinedForeignTyRef tyDef'undefinedForeignTyRef'TyRef)
 
 withDefModule :: forall a. (PC.ModuleName -> a) -> a
 withDefModule f = f (_ModuleName ["Module"])