Merge pull request #5493 from unisonweb/24-12-05-add-todo-watch

bugfix: allow add/update in presence of crashing watch expression

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -1469,7 +1469,9 @@ displayI outputLoc hq = do
       let filePPED = PPED.makePPED (PPE.hqNamer 10 namesWithDefinitionsFromFile) (suffixify namesWithDefinitionsFromFile)
 
       let suffixifiedFilePPE = PPE.biasTo bias $ PPE.suffixifiedPPE filePPED
-      (_, watches) <- evalUnisonFile Sandboxed suffixifiedFilePPE unisonFile []
+      (_, watches) <-
+        evalUnisonFile Sandboxed suffixifiedFilePPE unisonFile [] & onLeftM \err ->
+          Cli.returnEarly (Output.EvaluationFailure err)
       (_, _, _, _, tm, _) <-
         Map.lookup toDisplay watches & onNothing (error $ "Evaluation dropped a watch expression: " <> Text.unpack (HQ.toText hq))
       let ns = UF.addNamesFromTypeCheckedUnisonFile unisonFile names

unison-cli/src/Unison/Codebase/Editor/HandleInput/Load.hs

@@ -77,11 +77,13 @@ loadUnisonFile sourceName text = do
 
   when (not . null $ UF.watchComponents unisonFile) do
     Timing.time "evaluating watches" do
-      (bindings, e) <- evalUnisonFile Permissive ppe unisonFile []
-      let e' = Map.map go e
-          go (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit)
-      when (not (null e')) do
-        Cli.respond $ Output.Evaluated text ppe bindings e'
+      evalUnisonFile Permissive ppe unisonFile [] >>= \case
+        Right (bindings, e) -> do
+          when (not (null e)) do
+            let f (ann, kind, _hash, _uneval, eval, isHit) = (ann, kind, eval, isHit)
+            Cli.respond $ Output.Evaluated text ppe bindings (Map.map f e)
+        Left err -> Cli.respond (Output.EvaluationFailure err)
+
   #latestTypecheckedFile .= Just (Right unisonFile)
   where
     withFile ::
@@ -174,29 +176,34 @@ evalUnisonFile ::
   TypecheckedUnisonFile Symbol Ann ->
   [String] ->
   Cli
-    ( [(Symbol, Term Symbol ())],
-      Map Symbol (Ann, WK.WatchKind, Reference.Id, Term Symbol (), Term Symbol (), Bool)
+    ( Either
+        Runtime.Error
+        ( [(Symbol, Term Symbol ())],
+          Map Symbol (Ann, WK.WatchKind, Reference.Id, Term Symbol (), Term Symbol (), Bool)
+        )
     )
 evalUnisonFile mode ppe unisonFile args = do
-  Cli.Env {codebase, runtime, sandboxedRuntime, nativeRuntime} <- ask
+  env <- ask
+
   let theRuntime = case mode of
-        Sandboxed -> sandboxedRuntime
-        Permissive -> runtime
-        Native -> nativeRuntime
+        Sandboxed -> env.sandboxedRuntime
+        Permissive -> env.runtime
+        Native -> env.nativeRuntime
 
   let watchCache :: Reference.Id -> IO (Maybe (Term Symbol ()))
       watchCache ref = do
-        maybeTerm <- Codebase.runTransaction codebase (Codebase.lookupWatchCache codebase ref)
+        maybeTerm <- Codebase.runTransaction env.codebase (Codebase.lookupWatchCache env.codebase ref)
         pure (Term.amap (\(_ :: Ann) -> ()) <$> maybeTerm)
 
   Cli.with_ (withArgs args) do
-    (nts, errs, map) <-
-      Cli.ioE (Runtime.evaluateWatches (Codebase.codebaseToCodeLookup codebase) ppe watchCache theRuntime unisonFile) \err -> do
-        Cli.returnEarly (Output.EvaluationFailure err)
-    when (not $ null errs) (RuntimeUtils.displayDecompileErrors errs)
-    for_ (Map.elems map) \(_loc, kind, hash, _src, value, isHit) -> do
-      -- only update the watch cache when there are no errors
-      when (not isHit && null errs) do
-        let value' = Term.amap (\() -> Ann.External) value
-        Cli.runTransaction (Codebase.putWatch kind hash value')
-    pure (nts, map)
+    let codeLookup = Codebase.codebaseToCodeLookup env.codebase
+    liftIO (Runtime.evaluateWatches codeLookup ppe watchCache theRuntime unisonFile) >>= \case
+      Right (nts, errs, map) -> do
+        when (not $ null errs) (RuntimeUtils.displayDecompileErrors errs)
+        for_ (Map.elems map) \(_loc, kind, hash, _src, value, isHit) -> do
+          -- only update the watch cache when there are no errors
+          when (not isHit && null errs) do
+            let value' = Term.amap (\() -> Ann.External) value
+            Cli.runTransaction (Codebase.putWatch kind hash value')
+        pure (Right (nts, map))
+      Left err -> pure (Left err)

unison-cli/src/Unison/Codebase/Editor/HandleInput/Run.hs

@@ -57,7 +57,9 @@ handleRun native main args = do
   let pped = PPED.makePPED (PPE.hqNamer 10 namesWithFileDefinitions) (PPE.suffixifyByHash namesWithFileDefinitions)
   let suffixifiedPPE = PPED.suffixifiedPPE pped
   let mode | native = Native | otherwise = Permissive
-  (_, xs) <- evalUnisonFile mode suffixifiedPPE unisonFile args
+  (_, xs) <-
+    evalUnisonFile mode suffixifiedPPE unisonFile args & onLeftM \err ->
+      Cli.returnEarly (Output.EvaluationFailure err)
   mainRes :: Term Symbol () <-
     case lookup magicMainWatcherString (map bonk (Map.toList xs)) of
       Nothing ->

unison-src/transcripts/idempotent/fix-5354.md

@@ -0,0 +1,45 @@
+``` ucm
+scratch/main> builtins.mergeio
+
+  Done.
+```
+
+``` unison :error
+> todo ""
+
+foo = 42
+```
+
+``` ucm :added-by-ucm
+  Loading changes detected in scratch.u.
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+
+    ⍟ These new definitions are ok to `add`:
+    
+      foo : Nat
+
+  Now evaluating any watch expressions (lines starting with
+  `>`)... Ctrl+C cancels.
+
+  💔💥
+
+  I've encountered a call to builtin.todo with the following
+  value:
+
+    ""
+
+  Stack trace:
+    todo
+    #0k89ebstt4
+```
+
+``` ucm
+scratch/main> add
+
+  ⍟ I've added these definitions:
+
+    foo : Nat
+```