Merge pull request #4454 from unisonweb/23-11-30-fix-watch-update-bug

lib/unison-util-nametree/src/Unison/Util/Nametree.hs

@@ -156,7 +156,7 @@ data Defns terms types = Defns
     types :: !types
   }
   deriving stock (Generic, Show)
-  deriving (Semigroup) via GenericSemigroupMonoid (Defns terms types)
+  deriving (Monoid, Semigroup) via GenericSemigroupMonoid (Defns terms types)
 
 mapDefns :: (a -> b) -> Defns a a -> Defns b b
 mapDefns f (Defns terms types) =

parser-typechecker/src/Unison/Codebase.hs

@@ -328,9 +328,7 @@ addDefsToCodebase c uf = do
   traverse_ goTerm (UF.hashTermsId uf)
   where
     goTerm t | debug && trace ("Codebase.addDefsToCodebase.goTerm " ++ show t) False = undefined
-    goTerm (_, r, Nothing, tm, tp) = putTerm c r tm tp
-    goTerm (_, r, Just WK.TestWatch, tm, tp) = putTerm c r tm tp
-    goTerm _ = pure ()
+    goTerm (_, r, wk, tm, tp) = when (WK.watchKindShouldBeStoredInDatabase wk) (putTerm c r tm tp)
     goType :: (Show t) => (t -> Decl v a) -> (Reference.Id, t) -> Sqlite.Transaction ()
     goType _f pair | debug && trace ("Codebase.addDefsToCodebase.goType " ++ show pair) False = undefined
     goType f (ref, decl) = putTypeDeclaration c ref (f decl)

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

@@ -99,10 +99,7 @@ handleUpdate2 :: Cli ()
 handleUpdate2 = do
   Cli.Env {codebase} <- ask
   tuf <- Cli.expectLatestTypecheckedFile
-
-  -- - get add/updates from TUF
-  let termAndDeclNames :: Defns (Set Name) (Set Name) = getTermAndDeclNames tuf
-
+  let termAndDeclNames = getTermAndDeclNames tuf
   currentPath <- Cli.getCurrentPath
   currentBranch0 <- Cli.getBranch0At currentPath
   let namesIncludingLibdeps = Branch.toNames currentBranch0
@@ -197,9 +194,10 @@ saveTuf :: (Name -> Either Output [Name]) -> TypecheckedUnisonFile Symbol Ann ->
 saveTuf getConstructors tuf = do
   Cli.Env {codebase} <- ask
   currentPath <- Cli.getCurrentPath
-  branchUpdates <- Cli.runTransactionWithRollback \abort -> do
-    Codebase.addDefsToCodebase codebase tuf
-    typecheckedUnisonFileToBranchUpdates abort getConstructors tuf
+  branchUpdates <-
+    Cli.runTransactionWithRollback \abort -> do
+      Codebase.addDefsToCodebase codebase tuf
+      typecheckedUnisonFileToBranchUpdates abort getConstructors tuf
   Cli.stepAt "update" (Path.unabsolute currentPath, Branch.batchUpdates branchUpdates)
 
 -- @typecheckedUnisonFileToBranchUpdates getConstructors file@ returns a list of branch updates (suitable for passing
@@ -257,11 +255,14 @@ typecheckedUnisonFileToBranchUpdates abort getConstructors tuf = do
       tuf
         & UF.hashTermsId
         & Map.toList
-        & foldMap \(var, (_, ref, _, _, _)) ->
-          let split = splitVar var
-           in [ BranchUtil.makeAnnihilateTermName split,
-                BranchUtil.makeAddTermName split (Referent.fromTermReferenceId ref) Map.empty
-              ]
+        & foldMap \(var, (_, ref, wk, _, _)) ->
+          if WK.watchKindShouldBeStoredInDatabase wk
+            then
+              let split = splitVar var
+               in [ BranchUtil.makeAnnihilateTermName split,
+                    BranchUtil.makeAddTermName split (Referent.fromTermReferenceId ref) Map.empty
+                  ]
+            else []
 
     splitVar :: Symbol -> Path.Split
     splitVar = Path.splitFromName . Name.unsafeFromVar
@@ -425,10 +426,17 @@ incrementLastSegmentChar (ForwardName segments) =
               else Text.init text `Text.append` Text.singleton (succ $ Text.last text)
        in NameSegment incrementedText
 
+-- @getTermAndDeclNames file@ returns the names of the terms and decls defined in a typechecked Unison file.
 getTermAndDeclNames :: (Var v) => TypecheckedUnisonFile v a -> Defns (Set Name) (Set Name)
-getTermAndDeclNames tuf = Defns (terms <> effectCtors <> dataCtors) (effects <> datas)
+getTermAndDeclNames tuf =
+  Defns (terms <> effectCtors <> dataCtors) (effects <> datas)
   where
-    terms = keysToNames $ UF.hashTermsId tuf
+    terms =
+      UF.hashTermsId tuf
+        & Map.foldMapWithKey \var (_, _, wk, _, _) ->
+          if WK.watchKindShouldBeStoredInDatabase wk
+            then Set.singleton (Name.unsafeFromVar var)
+            else Set.empty
     effects = keysToNames $ UF.effectDeclarationsId' tuf
     datas = keysToNames $ UF.dataDeclarationsId' tuf
     effectCtors = foldMap ctorsToNames $ fmap (Decl.toDataDecl . snd) $ UF.effectDeclarationsId' tuf

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

@@ -31,7 +31,7 @@ import Unison.Util.Relation qualified as Rel
 import Unison.Util.Set qualified as Set
 import Unison.Var (Var)
 import Unison.Var qualified as Var
-import Unison.WatchKind (pattern TestWatch)
+import Unison.WatchKind (watchKindShouldBeStoredInDatabase)
 
 -- | The operation which is being performed or checked.
 data SlurpOp
@@ -278,12 +278,7 @@ buildVarReferences uf =
     terms =
       UF.hashTermsId uf
         -- Filter out non-test watch expressions
-        & Map.filter
-          ( \case
-              (_, _, w, _, _)
-                | w == Just TestWatch || w == Nothing -> True
-                | otherwise -> False
-          )
+        & Map.filter (\(_, _, w, _, _) -> watchKindShouldBeStoredInDatabase w)
         & Map.bimap
           TermVar
           (\(_, refId, _, _, _) -> LD.derivedTerm refId)

unison-core/src/Unison/WatchKind.hs

@@ -1,10 +1,22 @@
-{-# LANGUAGE RecordWildCards #-}
-
-module Unison.WatchKind where
+-- | A "watch kind" is the slug that comes before a ">" in a Unison file:
+--
+-- >
+-- > foo> bar = baz
+-- >
+--
+-- In this example, the watch kind is "foo".
+module Unison.WatchKind
+  ( WatchKind,
+    pattern RegularWatch,
+    pattern TestWatch,
+    watchKindShouldBeStoredInDatabase,
+  )
+where
 
 import Data.String (IsString)
 
-type WatchKind = String
+type WatchKind =
+  String
 
 -- | A non-test watch, such as
 -- @
@@ -22,3 +34,11 @@ pattern RegularWatch = ""
 -- Note: currently test watches don't need to be named by the user, but that "feature" will be removed soon.
 pattern TestWatch :: (Eq a, IsString a) => a
 pattern TestWatch = "test"
+
+-- Haha terrible name. Regular terms (no ">" in sight) and test watches ("test>") should be stored in the database
+-- (the latter, if nameless, get a random name), but other watches (like regular ">" or even weird "oink>") shouldn't.
+watchKindShouldBeStoredInDatabase :: Maybe WatchKind -> Bool
+watchKindShouldBeStoredInDatabase = \case
+  Nothing -> True
+  Just TestWatch -> True
+  _ -> False

unison-src/transcripts/update-watch.md

@@ -0,0 +1,7 @@
+```unison
+> 1
+```
+
+```ucm
+.> update
+```

unison-src/transcripts/update-watch.output.md

@@ -0,0 +1,27 @@
+```unison
+> 1
+```
+
+```ucm
+
+  ✅
+  
+  scratch.u changed.
+  
+  Now evaluating any watch expressions (lines starting with
+  `>`)... Ctrl+C cancels.
+
+    1 | > 1
+          ⧩
+          1
+
+```
+```ucm
+.> update
+
+  Okay, I'm searching the branch for code that needs to be
+  updated...
+
+  Done.
+
+```