From 2c6b71c7edb851963ca19c4d430a76a6379fff47 Mon Sep 17 00:00:00 2001
From: Ben Price <ben@hackworthltd.com>
Date: Thu, 17 Mar 2022 14:28:35 +0000
Subject: [PATCH] fix: allTypes should look in imports, per comment

Also adds some tests that would have caught this oversight.
Note that the Eval one is only for consistency -- it would not have
caught the bug since Eval does not ever look at type definitions.
---
 primer/src/Primer/App.hs      |  2 +-
 primer/test/Tests/Eval.hs     | 25 +++++++++++++++++++++++++
 primer/test/Tests/EvalFull.hs | 26 ++++++++++++++++++++++++++
 3 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/primer/src/Primer/App.hs b/primer/src/Primer/App.hs
index ffc2123eb..6da49b9b0 100644
--- a/primer/src/Primer/App.hs
+++ b/primer/src/Primer/App.hs
@@ -208,7 +208,7 @@ importModules ms = do
 
 -- | Get all type definitions from all modules (including imports)
 allTypes :: Prog -> [TypeDef]
-allTypes = moduleTypes . progModule
+allTypes p = foldMap moduleTypes $ progModule p : progImports p
 
 -- | Get all definitions from all modules (including imports)
 allDefs :: Prog -> Map ID Def
diff --git a/primer/test/Tests/Eval.hs b/primer/test/Tests/Eval.hs
index 0fe70841f..df4309526 100644
--- a/primer/test/Tests/Eval.hs
+++ b/primer/test/Tests/Eval.hs
@@ -13,6 +13,7 @@ import Primer.App (
   EvalReq (EvalReq, evalReqExpr, evalReqRedex),
   EvalResp (EvalResp, evalRespExpr),
   Prog (progModule),
+  boolDef,
   handleEvalRequest,
   importModules,
   newEmptyApp,
@@ -25,6 +26,7 @@ import Primer.Core (
   ID (ID),
   Type,
   Type',
+  TypeDef (TypeDefAST),
   defID,
   getID,
   _exprMeta,
@@ -50,6 +52,7 @@ import Primer.Eval (
   tryReduceExpr,
   tryReduceType,
  )
+import Primer.Module (Module (Module, moduleDefs, moduleTypes))
 import Primer.Name (Name)
 import Primer.Zipper (target)
 import Protolude.Partial (fromJust)
@@ -833,6 +836,28 @@ unit_eval_modules =
         Left err -> assertFailure $ show err
         Right assertion -> assertion
 
+-- Test that handleEvalRequest will reduce case analysis on imported types
+unit_eval_modules_scrutinize_imported_type :: Assertion
+unit_eval_modules_scrutinize_imported_type =
+  let test = do
+        importModules [m]
+        foo <- case_ (con "True") [branch "True" [] $ con "False", branch "False" [] $ con "True"]
+        EvalResp{evalRespExpr = e} <-
+          handleEvalRequest
+            EvalReq{evalReqExpr = foo, evalReqRedex = getID foo}
+        expect <- con "False"
+        pure $ e ~= expect
+      a = newEmptyApp
+   in case fst $ runAppTestM (ID $ appIdCounter a) a test of
+        Left err -> assertFailure $ show err
+        Right assertion -> assertion
+  where
+    m =
+      Module
+        { moduleTypes = [TypeDefAST boolDef]
+        , moduleDefs = mempty
+        }
+
 -- * Misc helpers
 
 -- | Like '@?=' but specifically for expressions.
diff --git a/primer/test/Tests/EvalFull.hs b/primer/test/Tests/EvalFull.hs
index 0637141bf..42e334353 100644
--- a/primer/test/Tests/EvalFull.hs
+++ b/primer/test/Tests/EvalFull.hs
@@ -19,6 +19,7 @@ import Primer.App (
   EvalFullReq (EvalFullReq, evalFullCxtDir, evalFullMaxSteps, evalFullReqExpr),
   EvalFullResp (EvalFullRespNormal, EvalFullRespTimedOut),
   Prog (progModule),
+  boolDef,
   defaultTypeDefs,
   handleEvalFullRequest,
   importModules,
@@ -28,6 +29,7 @@ import Primer.Core
 import Primer.Core.DSL
 import Primer.Core.Utils (forgetIDs, forgetTypeIDs, generateIDs, generateTypeIDs)
 import Primer.EvalFull
+import Primer.Module (Module (Module, moduleDefs, moduleTypes))
 import Primer.Name
 import Primer.Primitives (allPrimDefs)
 import Primer.Typecheck (
@@ -936,6 +938,30 @@ unit_eval_full_modules =
         Left err -> assertFailure $ show err
         Right assertion -> assertion
 
+-- Test that handleEvalFullRequest will reduce case analysis of imported types
+unit_eval_full_modules_scrutinize_imported_type :: Assertion
+unit_eval_full_modules_scrutinize_imported_type =
+  let test = do
+        importModules [m]
+        foo <- case_ (con "True") [branch "True" [] $ con "False", branch "False" [] $ con "True"]
+        resp <-
+          handleEvalFullRequest
+            EvalFullReq{evalFullReqExpr = foo, evalFullCxtDir = Chk, evalFullMaxSteps = 2}
+        expect <- con "False"
+        pure $ case resp of
+          EvalFullRespTimedOut _ -> assertFailure "EvalFull timed out"
+          EvalFullRespNormal e -> e ~= expect
+      a = newEmptyApp
+   in case fst $ runAppTestM (ID $ appIdCounter a) a test of
+        Left err -> assertFailure $ show err
+        Right assertion -> assertion
+  where
+    m =
+      Module
+        { moduleTypes = [TypeDefAST boolDef]
+        , moduleDefs = mempty
+        }
+
 -- * Utilities
 
 evalFullTest :: ID -> M.Map Name TypeDef -> M.Map ID Def -> TerminationBound -> Dir -> Expr -> Either EvalFullError Expr