Merge pull request #5483 from unisonweb/fix/5448

`run` should use the `TypeLookup` from the file too
unisonweb · Dec 11, 2024 · ad45e5d · ad45e5d
2 parents b311a29 + 7c0385f
commit ad45e5d
Show file tree

Hide file tree

Showing 3 changed files with 30 additions and 6 deletions.
diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs
@@ -33,6 +33,7 @@ module Unison.UnisonFile
     nonEmpty,
     termSignatureExternalLabeledDependencies,
     topLevelComponents,
+    typecheckedToTypeLookup,
     typecheckedUnisonFile,
     Unison.UnisonFile.rewrite,
     prepareRewrite,
@@ -368,6 +369,15 @@ declsToTypeLookup uf =
   where
     wrangle = Map.fromList . Map.elems
 
+typecheckedToTypeLookup :: TypecheckedUnisonFile v a -> TL.TypeLookup v a
+typecheckedToTypeLookup tuf =
+  TL.TypeLookup
+    mempty
+    (wrangle (dataDeclarations' tuf))
+    (wrangle (effectDeclarations' tuf))
+  where
+    wrangle = Map.fromList . Map.elems
+
 -- Returns true if the file has any definitions or watches
 nonEmpty :: TypecheckedUnisonFile v a -> Bool
 nonEmpty uf =

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs
@@ -42,6 +42,7 @@ import Unison.UnisonFile (TypecheckedUnisonFile)
 import Unison.UnisonFile qualified as UF
 import Unison.UnisonFile.Names qualified as UF
 import Unison.Util.Defns (Defns (..))
+import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Recursion
 import Unison.Var qualified as Var
 
@@ -110,29 +111,30 @@ getTerm' mainName =
           mainToFile (MainTerm.BadType _ ty) = pure $ maybe NoTermWithThatName TermHasBadType ty
           mainToFile (MainTerm.Success hq tm typ) =
             let v = Var.named (HQ.toText hq)
-             in checkType typ \otyp ->
+             in checkType Nothing typ \otyp ->
                   pure (GetTermSuccess (v, tm, typ, otyp))
       getFromFile uf = do
         let components = join $ UF.topLevelComponents uf
         -- __TODO__: We shouldn’t need to serialize mainName` for this check
         let mainComponent = filter ((\v -> Var.name v == HQ.toText mainName) . view _1) components
         case mainComponent of
           [(v, _, tm, ty)] ->
-            checkType ty \otyp ->
+            checkType (Just uf) ty \otyp ->
               let runMain = DD.forceTerm a a (Term.var a v)
                   v2 = Var.freshIn (Set.fromList [v]) v
                   a = ABT.annotation tm
                in pure (GetTermSuccess (v2, runMain, ty, otyp))
           _ -> getFromCodebase
-      checkType :: Type Symbol Ann -> (Type Symbol Ann -> Cli GetTermResult) -> Cli GetTermResult
-      checkType ty f = do
+      checkType :: Maybe (TypecheckedUnisonFile Symbol Ann) -> Type Symbol Ann -> (Type Symbol Ann -> Cli GetTermResult) -> Cli GetTermResult
+      checkType mayTuf ty f = do
         Cli.Env {codebase, runtime} <- ask
         case Typechecker.fitsScheme ty (Runtime.mainType runtime) of
           True -> do
-            typeLookup <-
+            tlCodebase <-
               Cli.runTransaction $
                 Codebase.typeLookupForDependencies codebase Defns {terms = Set.empty, types = Type.dependencies ty}
-            f $! synthesizeForce typeLookup ty
+            let tlTuf = Monoid.fromMaybe (fmap UF.typecheckedToTypeLookup mayTuf)
+            f $! synthesizeForce (tlTuf <> tlCodebase) ty
           False -> pure (TermHasBadType ty)
    in Cli.getLatestTypecheckedFile >>= \case
         Nothing -> getFromCodebase

diff --git a/unison-src/transcripts/idempotent/fix5448.md b/unison-src/transcripts/idempotent/fix5448.md
@@ -0,0 +1,12 @@
+``` unison :hide
+type NewType = NewType
+main = do NewType
+```
+
+You shouldn't have to `add` a type before using it with `run`.
+
+``` ucm
+scratch/main> run main
+
+  NewType
+```