Merge pull request #5545 from unisonweb/25-01-15-lsp-merge-bug

bugfix: call lspCheckForChanges in more places, such as after a failed merge

unison-cli/src/Unison/Cli/Monad.hs

@@ -50,9 +50,6 @@ module Unison.Cli.Monad
     runTransactionWithRollback,
     runTransactionWithRollback2,
 
-    -- * Internal
-    setMostRecentProjectPath,
-
     -- * Misc types
     LoadSourceResult (..),
   )
@@ -169,6 +166,8 @@ data Env = Env
     generateUniqueName :: IO Parser.UniqueName,
     -- | How to load source code.
     loadSource :: SourceName -> IO LoadSourceResult,
+    -- | Notify the LSP that this ProjectPathIds might be different from the last (e.g. on branch update, switch, etc).
+    lspCheckForChanges :: PP.ProjectPathIds -> IO (),
     -- | How to write source code. Bool = make new fold?
     writeSource :: SourceName -> Text -> Bool -> IO (),
     -- | What to do with output for the user.
@@ -388,19 +387,24 @@ getProjectPathIds = do
 
 cd :: Path.Absolute -> Cli ()
 cd path = do
+  env <- ask
   pp <- getProjectPathIds
   let newPP = pp & PP.absPath_ .~ path
-  setMostRecentProjectPath newPP
+  runTransaction (Codebase.setCurrentProjectPath newPP)
   #projectPathStack %= NonEmpty.cons newPP
+  liftIO (env.lspCheckForChanges newPP)
 
 switchProject :: ProjectAndBranch ProjectId ProjectBranchId -> Cli ()
 switchProject pab@(ProjectAndBranch projectId branchId) = do
-  Env {codebase} <- ask
+  env <- ask
   let newPP = PP.ProjectPath projectId branchId Path.absoluteEmpty
   #projectPathStack %= NonEmpty.cons newPP
-  runTransaction $ do Q.setMostRecentBranch projectId branchId
-  setMostRecentProjectPath newPP
-  liftIO $ Codebase.preloadProjectBranch codebase pab
+  runTransaction do
+    Q.setMostRecentBranch projectId branchId
+    Codebase.setCurrentProjectPath newPP
+  liftIO do
+    Codebase.preloadProjectBranch env.codebase pab
+    env.lspCheckForChanges newPP
 
 -- | Pop the latest path off the stack, if it's not the only path in the stack.
 --
@@ -411,14 +415,13 @@ popd = do
   case List.NonEmpty.uncons (projectPathStack state) of
     (_, Nothing) -> pure False
     (_, Just paths) -> do
-      setMostRecentProjectPath (List.NonEmpty.head paths)
+      let path = List.NonEmpty.head paths
+      runTransaction (Codebase.setCurrentProjectPath path)
       State.put state {projectPathStack = paths}
+      env <- ask
+      liftIO (env.lspCheckForChanges path)
       pure True
 
-setMostRecentProjectPath :: PP.ProjectPathIds -> Cli ()
-setMostRecentProjectPath loc =
-  runTransaction $ Codebase.setCurrentProjectPath loc
-
 respond :: Output -> Cli ()
 respond output = do
   Env {notify} <- ask

unison-cli/src/Unison/Cli/MonadUtils.hs

@@ -433,18 +433,25 @@ updateAndStepAt reason projectBranch updates steps = do
 
 updateProjectBranchRoot :: ProjectBranch -> Text -> (Branch IO -> Cli (Branch IO, r)) -> Cli r
 updateProjectBranchRoot projectBranch reason f = do
-  Cli.Env {codebase} <- ask
+  env <- ask
   Cli.time "updateProjectBranchRoot" do
     old <- getProjectBranchRoot projectBranch
     (new, result) <- f old
     when (old /= new) do
-      liftIO $ Codebase.putBranch codebase new
-      Cli.runTransaction $ do
+      liftIO $ Codebase.putBranch env.codebase new
+      Cli.runTransaction do
         -- TODO: If we transactionally check that the project branch hasn't changed while we were computing the new
         -- branch, and if it has, abort the transaction and return an error, then we can
         -- remove the single UCM per codebase restriction.
         causalHashId <- Q.expectCausalHashIdByCausalHash (Branch.headHash new)
-        Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId
+        Q.setProjectBranchHead reason projectBranch.projectId projectBranch.branchId causalHashId
+      -- The input to this function isn't necessarily the *current* project branch, which is what LSP cares about. But
+      -- it might be! There's no harm in unconditionally notifying the LSP that the current project branch may have
+      -- changed, but it is slightly more efficient for us to just do the == comparison here (since otherwise the LSP
+      -- would have to dig around in the database before confirming whether there's a change).
+      projectPathIds <- Cli.getProjectPathIds
+      when ((projectBranch.projectId, projectBranch.branchId) == (projectPathIds.project, projectPathIds.branch)) do
+        liftIO (env.lspCheckForChanges projectPathIds)
     pure result
 
 updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()

unison-cli/src/Unison/Codebase/Transcript/Runner.hs

@@ -487,6 +487,7 @@ run isTest verbosity dir codebase runtime sbRuntime nRuntime ucmVersion baseURL
               i <- atomicModifyIORef' seedRef \i -> let !i' = i + 1 in (i', i)
               pure (Parser.uniqueBase32Namegen (Random.drgNewSeed (Random.seedFromInteger (fromIntegral i)))),
             loadSource = loadPreviousUnisonBlock,
+            lspCheckForChanges = \_ -> pure (),
             writeSource,
             notify = print,
             notifyNumbered = printNumbered,

unison-cli/src/Unison/CommandLine/Main.hs

@@ -232,6 +232,7 @@ main dir welcome ppIds initialInputs runtime sbRuntime nRuntime codebase serverB
             codebase,
             credentialManager,
             loadSource = loadSourceFile,
+            lspCheckForChanges,
             writeSource,
             generateUniqueName = Parser.uniqueBase32Namegen <$> Random.getSystemDRG,
             notify,
@@ -252,9 +253,6 @@ main dir welcome ppIds initialInputs runtime sbRuntime nRuntime codebase serverB
     -- Handle inputs until @HaltRepl@, staying in the loop on Ctrl+C or synchronous exception.
     let loop0 :: Cli.LoopState -> IO ()
         loop0 s0 = do
-          -- It's always possible the previous command changed the branch head, so tell the LSP to check if the current
-          -- path or project has changed.
-          lspCheckForChanges (NEL.head $ Cli.projectPathStack s0)
           let step = do
                 input <- awaitInput s0
                 (!result, resultState) <- Cli.runCli env s0 (HandleInput.loop input)

unison-cli/src/Unison/Main.hs

@@ -306,7 +306,7 @@ main version = do
               currentPP <- Codebase.runTransaction theCodebase do
                 PP.toIds <$> Codebase.expectCurrentProjectPath
               changeSignal <- Signal.newSignalIO (Just currentPP)
-              let lspCheckForChanges pp = Signal.writeSignalIO changeSignal pp
+              let lspCheckForChanges = Signal.writeSignalIO changeSignal
               -- Unfortunately, the windows IO manager on GHC 8.* is prone to just hanging forever
               -- when waiting for input on handles, so if we listen for LSP connections it will
               -- prevent UCM from shutting down properly. Hopefully we can re-enable LSP on