unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-04 05:37:14 +03:00
Code Issues Projects Releases Wiki Activity

Revive causal hash signal in LSP

Browse Source
This commit is contained in:
Chris Penner 2024-06-12 10:43:53 -07:00
parent 23fd0a005b
commit 7298bbeffe
2 changed files with 30 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
unison-cli/src/Unison/LSP.hs
View File

@ -27,6 +27,7 @@ import Language.LSP.VFS
import Network.Simple.TCP qualified as TCP
import System.Environment (lookupEnv)
import System.IO (hPutStrLn)
import U.Codebase.HashTags
import Unison.Codebase
import Unison.Codebase.ProjectPath qualified as PP
import Unison.Codebase.Runtime (Runtime)
@ -60,8 +61,14 @@ getLspPort :: IO String
getLspPort = fromMaybe "5757" <$> lookupEnv "UNISON_LSP_PORT"
-- | Spawn an LSP server on the configured port.
spawnLsp :: LspFormattingConfig -> Codebase IO Symbol Ann -> Runtime Symbol -> STM PP.ProjectPath -> IO ()
spawnLsp lspFormattingConfig codebase runtime latestPath =
spawnLsp ::
LspFormattingConfig ->
Codebase IO Symbol Ann ->
Runtime Symbol ->
STM CausalHash ->
STM PP.ProjectPath ->
IO ()
spawnLsp lspFormattingConfig codebase runtime latestProjectRootHash latestPath =
ifEnabled . TCP.withSocketsDo $ do
lspPort <- getLspPort
UnliftIO.handleIO (handleFailure lspPort) $ do
@ -81,7 +88,7 @@ spawnLsp lspFormattingConfig codebase runtime latestPath =
-- different un-saved state for the same file.
initVFS $ \vfs -> do
vfsVar <- newMVar vfs
void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestPath)
void $ runServerWith lspServerLogger lspClientLogger clientInput clientOutput (serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestProjectRootHash latestPath)
where
handleFailure :: String -> IOException -> IO ()
handleFailure lspPort ioerr =
@ -112,15 +119,16 @@ serverDefinition ::
Codebase IO Symbol Ann ->
Runtime Symbol ->
Ki.Scope ->
STM CausalHash ->
STM PP.ProjectPath ->
ServerDefinition Config
serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestPath =
serverDefinition lspFormattingConfig vfsVar codebase runtime scope latestProjectRootHash latestPath =
ServerDefinition
{ defaultConfig = defaultLSPConfig,
configSection = "unison",
parseConfig = Config.parseConfig,
onConfigChange = Config.updateConfig,
doInitialize = lspDoInitialize vfsVar codebase runtime scope latestPath,
doInitialize = lspDoInitialize vfsVar codebase runtime scope latestProjectRootHash latestPath,
staticHandlers = lspStaticHandlers lspFormattingConfig,
interpretHandler = lspInterpretHandler,
options = lspOptions
@ -132,11 +140,12 @@ lspDoInitialize ::
Codebase IO Symbol Ann ->
Runtime Symbol ->
Ki.Scope ->
STM CausalHash ->
STM PP.ProjectPath ->
LanguageContextEnv Config ->
Msg.TMessage 'Msg.Method_Initialize ->
IO (Either Msg.ResponseError Env)
lspDoInitialize vfsVar codebase runtime scope latestPath lspContext _initMsg = do
lspDoInitialize vfsVar codebase runtime scope latestRootHash latestPath lspContext _initMsg = do
checkedFilesVar <- newTVarIO mempty
dirtyFilesVar <- newTVarIO mempty
ppedCacheVar <- newEmptyTMVarIO
@ -155,7 +164,7 @@ lspDoInitialize vfsVar codebase runtime scope latestPath lspContext _initMsg = d
}
let lspToIO = flip runReaderT lspContext . unLspT . flip runReaderT env . runLspM
Ki.fork scope (lspToIO Analysis.fileAnalysisWorker)
Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestPath)
Ki.fork scope (lspToIO $ ucmWorker ppedCacheVar currentNamesCacheVar nameSearchCacheVar currentPathCacheVar latestRootHash latestPath)
pure $ Right $ env
-- | LSP request handlers that don't register/unregister dynamically

24
unison-cli/src/Unison/LSP/UCMWorker.hs
View File

@ -1,6 +1,7 @@
module Unison.LSP.UCMWorker where
import Control.Monad.Reader
import U.Codebase.HashTags (CausalHash)
import Unison.Codebase qualified as Codebase
import Unison.Codebase.Branch qualified as Branch
import Unison.Codebase.Branch.Names qualified as Branch
@ -25,12 +26,13 @@ ucmWorker ::
TMVar Names ->
TMVar (NameSearch Sqlite.Transaction) ->
TMVar ProjectPath ->
STM CausalHash ->
STM ProjectPath ->
Lsp ()
ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestProjectPath = do
ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestProjectRootHash getLatestProjectPath = do
Env {codebase, completionsVar} <- ask
let loop :: ProjectPath -> Lsp a
loop currentProjectPath = do
let loop :: CausalHash -> ProjectPath -> Lsp a
loop currentProjectRootHash currentProjectPath = do
currentBranch <- liftIO $ Codebase.expectProjectBranchRoot codebase (currentProjectPath ^. #branch . #projectId) (currentProjectPath ^. #branch . #branchId)
Debug.debugM Debug.LSP "LSP path: " currentProjectPath
let currentBranch0 = Branch.head currentBranch
@ -47,16 +49,18 @@ ucmWorker ppedVar currentNamesVar nameSearchCacheVar currentPathVar getLatestPro
atomically do
writeTMVar completionsVar (namesToCompletionTree currentNames)
Debug.debugLogM Debug.LSP "LSP Initialized"
latest <- atomically $ do
(latestRootHash, latestProjectPath) <- atomically $ do
latestRootHash <- getLatestProjectRootHash
latestPath <- getLatestProjectPath
guard $ (currentProjectPath /= latestPath)
pure latestPath
guard $ (currentProjectRootHash /= latestRootHash || currentProjectPath /= latestPath)
pure (latestRootHash, latestPath)
Debug.debugLogM Debug.LSP "LSP Change detected"
loop latest
currentProjectPath <- atomically $ do
loop latestRootHash latestProjectPath
(currentProjectRootHash, currentProjectPath) <- atomically $ do
latestProjectRootHash <- getLatestProjectRootHash
currentProjectPath <- getLatestProjectPath
pure currentProjectPath
loop currentProjectPath
pure (latestProjectRootHash, currentProjectPath)
loop currentProjectRootHash currentProjectPath
where
-- This is added in stm-2.5.1, remove this if we upgrade.
writeTMVar :: TMVar a -> a -> STM ()