From 47abc53f369aa209d71bab5db3dc3bcc437336e5 Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Thu, 16 Jan 2025 11:32:30 -0500 Subject: [PATCH] move lspCheckForChanges into the Cli monad environment call it on `cd`/`switch`/`popd` as well as when the contents of the current branch change --- unison-cli/src/Unison/Cli/Monad.hs | 29 ++++++++++--------- unison-cli/src/Unison/Cli/MonadUtils.hs | 15 +++++++--- .../src/Unison/Codebase/Transcript/Runner.hs | 1 + unison-cli/src/Unison/CommandLine/Main.hs | 4 +-- unison-cli/src/Unison/Main.hs | 2 +- 5 files changed, 30 insertions(+), 21 deletions(-) diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index cede3035fb..ff8817d7be 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/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 diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 242ee77635..39e8cfb4e2 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/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 () diff --git a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs index 97082cfab5..bde34ed739 100644 --- a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs +++ b/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, diff --git a/unison-cli/src/Unison/CommandLine/Main.hs b/unison-cli/src/Unison/CommandLine/Main.hs index 3b86508eb0..97af0ba88e 100644 --- a/unison-cli/src/Unison/CommandLine/Main.hs +++ b/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) diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 59845f0608..2e89f7b6f6 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/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