Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 1 commit into from
Jan 16, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 16 additions & 13 deletions unison-cli/src/Unison/Cli/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,9 +50,6 @@ module Unison.Cli.Monad
runTransactionWithRollback,
runTransactionWithRollback2,

-- * Internal
setMostRecentProjectPath,

-- * Misc types
LoadSourceResult (..),
)
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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.
--
Expand All @@ -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
Expand Down
15 changes: 11 additions & 4 deletions unison-cli/src/Unison/Cli/MonadUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand Down
1 change: 1 addition & 0 deletions unison-cli/src/Unison/Codebase/Transcript/Runner.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
4 changes: 1 addition & 3 deletions unison-cli/src/Unison/CommandLine/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion unison-cli/src/Unison/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading