From b6f00473838fcc6e1b93be166025d6531db66bd9 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sat, 3 Feb 2024 20:48:18 +0000 Subject: [PATCH 1/3] Bump lsp versions Broadly: - A few places where we need to pipe `ProgressToken`s around. - I also just removed the progress reporting from resolve commands, since it's going to often be costly to do progress reporting on something that short. Possibly we could revisit after https://github.com/haskell/lsp/issues/549 - Some changes to the registration options we infer - A few places where we need to adapt to ignoring registrations or not - Adapting to use the ghcide verison of `getCompletionPrefix` everywhere - Adapting to use the new mixed rope format --- cabal.project | 2 +- ghcide-bench/ghcide-bench.cabal | 2 +- ghcide/ghcide.cabal | 6 +-- .../session-loader/Development/IDE/Session.hs | 2 +- ghcide/src/Development/IDE/Core/FileStore.hs | 2 +- ghcide/src/Development/IDE/Core/Rules.hs | 2 +- .../IDE/Plugin/Completions/Logic.hs | 2 +- ghcide/src/Development/IDE/Plugin/HLS.hs | 10 ++-- ghcide/src/Development/IDE/Plugin/Test.hs | 2 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 2 +- ghcide/test/exe/ClientSettingsTests.hs | 1 - ghcide/test/exe/ExceptionTests.hs | 2 +- ghcide/test/exe/InitializeResponseTests.hs | 30 +++++------ ghcide/test/exe/PositionMappingTests.hs | 4 +- ghcide/test/exe/WatchedFileTests.hs | 2 + ghcide/test/ghcide-test-utils.cabal | 2 +- haskell-language-server.cabal | 13 ++--- hls-plugin-api/hls-plugin-api.cabal | 2 +- hls-plugin-api/src/Ide/Plugin/Resolve.hs | 46 ++++++++-------- hls-plugin-api/src/Ide/Types.hs | 10 ++-- hls-test-utils/hls-test-utils.cabal | 2 +- .../src/Ide/Plugin/CabalFmt.hs | 4 +- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 11 ++-- .../Plugin/Cabal/Completion/Completions.hs | 20 +++---- plugins/hls-cabal-plugin/test/Completer.hs | 24 ++++----- plugins/hls-cabal-plugin/test/Context.hs | 2 +- .../src/Ide/Plugin/Class/CodeAction.hs | 2 +- .../src/Ide/Plugin/Class/CodeLens.hs | 2 +- .../src/Ide/Plugin/Eval/CodeLens.hs | 4 +- .../src/Ide/Plugin/ExplicitImports.hs | 4 +- .../src/Ide/Plugin/Floskell.hs | 2 +- .../src/Ide/Plugin/Fourmolu.hs | 2 +- .../hls-gadt-plugin/src/Ide/Plugin/GADT.hs | 2 +- .../src/Ide/Plugin/ModuleName.hs | 2 +- .../src/Ide/Plugin/Ormolu.hs | 2 +- .../src/Ide/Plugin/Pragmas.hs | 52 +++++++++---------- .../src/Development/IDE/Plugin/CodeAction.hs | 6 +-- .../src/Ide/Plugin/Retrie.hs | 6 +-- .../src/Ide/Plugin/SemanticTokens/Tokenize.hs | 3 +- .../hls-semantic-tokens-plugin/test/Main.hs | 2 +- .../src/Ide/Plugin/Splice.hs | 2 +- .../src/Ide/Plugin/StylishHaskell.hs | 2 +- 42 files changed, 152 insertions(+), 150 deletions(-) diff --git a/cabal.project b/cabal.project index dd45e316e3..5e97a20001 100644 --- a/cabal.project +++ b/cabal.project @@ -9,7 +9,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2024-01-21T00:00:00Z +index-state: 2024-02-25T00:00:00Z tests: True test-show-details: direct diff --git a/ghcide-bench/ghcide-bench.cabal b/ghcide-bench/ghcide-bench.cabal index 700cf6153e..b6794dcc4f 100644 --- a/ghcide-bench/ghcide-bench.cabal +++ b/ghcide-bench/ghcide-bench.cabal @@ -99,7 +99,7 @@ test-suite test base, extra, ghcide-bench, - lsp-test ^>= 0.16, + lsp-test ^>= 0.17, tasty, tasty-hunit >= 0.10, tasty-rerun, diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 41e1edbf92..1210507e51 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -93,7 +93,7 @@ library , implicit-hie >= 0.1.4.0 && < 0.1.5 , lens , list-t - , lsp ^>=2.3.0.0 + , lsp ^>=2.4.0.0 , lsp-types ^>=2.1.0.0 , mtl , opentelemetry >=0.6.1 @@ -183,6 +183,7 @@ library Development.IDE.Plugin Development.IDE.Plugin.Completions Development.IDE.Plugin.Completions.Types + Development.IDE.Plugin.Completions.Logic Development.IDE.Plugin.HLS Development.IDE.Plugin.HLS.GhcIde Development.IDE.Plugin.Test @@ -210,7 +211,6 @@ library Development.IDE.Core.FileExists Development.IDE.GHC.CPP Development.IDE.GHC.Warnings - Development.IDE.Plugin.Completions.Logic Development.IDE.Session.VersionCheck Development.IDE.Types.Action @@ -305,7 +305,7 @@ test-suite ghcide-tests , lens , list-t , lsp - , lsp-test ^>=0.16.0.0 + , lsp-test ^>=0.17.0.0 , lsp-types , monoid-subclasses , mtl diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index bdd27f3d5f..d4224bd252 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -635,7 +635,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- Display a user friendly progress message here: They probably don't know what a cradle is let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle)) <> " (for " <> T.pack lfp <> ")" - eopts <- mRunLspTCallback lspEnv (withIndefiniteProgress progMsg NotCancellable) $ + eopts <- mRunLspTCallback lspEnv (\act -> withIndefiniteProgress progMsg Nothing NotCancellable (const act)) $ withTrace "Load cradle" $ \addTag -> do addTag "file" lfp old_files <- readIORef cradle_files diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 711cf69130..7be4c71827 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -183,7 +183,7 @@ getFileContentsImpl file = do time <- use_ GetModificationTime file res <- do mbVirtual <- getVirtualFile file - pure $ Rope.toText . _file_text <$> mbVirtual + pure $ virtualFileText <$> mbVirtual pure ([], Just (time, res)) -- | Returns the modification time and the contents. diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 4f1c703760..8729ee028f 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -575,7 +575,7 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe vfsData <- liftIO $ _vfsMap <$> readTVarIO vfsRef (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file) - Just vf -> pure (Rope.toText $ _file_text vf, Just $ _lsp_version vf) + Just vf -> pure (virtualFileText vf, Just $ virtualFileVersion vf) let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 9ce9a79c93..a08a188337 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -62,7 +62,7 @@ import qualified Language.LSP.VFS as VFS import Text.Fuzzy.Parallel (Scored (score), original) -import qualified Data.Text.Utf16.Rope as Rope +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE hiding (line) import Development.IDE.Spans.AtPoint (pointCommand) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index a90335e444..149a28b7e9 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -177,7 +177,7 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom -- The parameters to the HLS command are always the first element execCmd :: IdeState -> ExecuteCommandParams -> LSP.LspT Config IO (Either ResponseError (A.Value |? Null)) - execCmd ide (ExecuteCommandParams _ cmdId args) = do + execCmd ide (ExecuteCommandParams mtoken cmdId args) = do let cmdParams :: A.Value cmdParams = case args of Just ((x:_)) -> x @@ -201,15 +201,15 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom A.Error _str -> return $ Right $ InR Null -- Just an ordinary HIE command - Just (plugin, cmd) -> runPluginCommand ide plugin cmd cmdParams + Just (plugin, cmd) -> runPluginCommand ide plugin cmd mtoken cmdParams -- Couldn't parse the command identifier _ -> do logWith recorder Warning LogInvalidCommandIdentifier return $ Left $ ResponseError (InR ErrorCodes_InvalidParams) "Invalid command identifier" Nothing - runPluginCommand :: IdeState -> PluginId -> CommandId -> A.Value -> LSP.LspT Config IO (Either ResponseError (A.Value |? Null)) - runPluginCommand ide p com arg = + runPluginCommand :: IdeState -> PluginId -> CommandId -> Maybe ProgressToken -> A.Value -> LSP.LspT Config IO (Either ResponseError (A.Value |? Null)) + runPluginCommand ide p com mtoken arg = case Map.lookup p pluginMap of Nothing -> logAndReturnError recorder p (InR ErrorCodes_InvalidRequest) (pluginDoesntExist p) Just xs -> case List.find ((com ==) . commandId) xs of @@ -217,7 +217,7 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom Just (PluginCommand _ _ f) -> case A.fromJSON arg of A.Error err -> logAndReturnError recorder p (InR ErrorCodes_InvalidParams) (failedToParseArgs com p err arg) A.Success a -> do - res <- runExceptT (f ide a) `catchAny` -- See Note [Exception handling in plugins] + res <- runExceptT (f ide mtoken a) `catchAny` -- See Note [Exception handling in plugins] (\e -> pure $ Left $ PluginInternalError (exceptionInPlugin p SMethod_WorkspaceExecuteCommand e)) case res of (Left (PluginRequestRefused r)) -> diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index 8b33f3c2aa..5dfc8460b0 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -170,7 +170,7 @@ blockCommandDescriptor plId = (defaultPluginDescriptor plId "") { } blockCommandHandler :: CommandFunction state ExecuteCommandParams -blockCommandHandler _ideState _params = do +blockCommandHandler _ideState _ _params = do lift $ LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/blocking/command")) A.Null liftIO $ threadDelay maxBound pure $ InR Null diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 9809144dcf..040f49f904 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -192,7 +192,7 @@ generateLensCommand pId uri title edit = -- recompute the edit upon command. Hence the command here just takes a edit -- and applies it. commandHandler :: CommandFunction IdeState WorkspaceEdit -commandHandler _ideState wedit = do +commandHandler _ideState _ wedit = do _ <- lift $ LSP.sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) pure $ InR Null diff --git a/ghcide/test/exe/ClientSettingsTests.hs b/ghcide/test/exe/ClientSettingsTests.hs index 23bc752f82..6801e9fe8a 100644 --- a/ghcide/test/exe/ClientSettingsTests.hs +++ b/ghcide/test/exe/ClientSettingsTests.hs @@ -21,7 +21,6 @@ tests :: TestTree tests = testGroup "client settings handling" [ testSession "ghcide restarts shake session on config changes" $ do setIgnoringLogNotifications False - void $ skipManyTill anyMessage $ message SMethod_ClientRegisterCapability void $ createDoc "A.hs" "haskell" "module A where" waitForProgressDone setConfigSection "haskell" $ toJSON (def :: Config) diff --git a/ghcide/test/exe/ExceptionTests.hs b/ghcide/test/exe/ExceptionTests.hs index 1a5003d5f4..b7fcca4b99 100644 --- a/ghcide/test/exe/ExceptionTests.hs +++ b/ghcide/test/exe/ExceptionTests.hs @@ -65,7 +65,7 @@ tests recorder logger = do plugins = pluginDescToIdePlugins $ [ (defaultPluginDescriptor pluginId "") { pluginCommands = - [ PluginCommand commandId "Causes an exception" $ \_ (_::Int) -> do + [ PluginCommand commandId "Causes an exception" $ \_ _ (_::Int) -> do _ <- liftIO $ throwIO DivideByZero pure (InR Null) ] diff --git a/ghcide/test/exe/InitializeResponseTests.hs b/ghcide/test/exe/InitializeResponseTests.hs index e5b336f962..745195b36e 100644 --- a/ghcide/test/exe/InitializeResponseTests.hs +++ b/ghcide/test/exe/InitializeResponseTests.hs @@ -36,29 +36,29 @@ tests = withResource acquire release tests where tests getInitializeResponse = testGroup "initialize response capabilities" [ chk " text doc sync" _textDocumentSync tds - , chk " hover" _hoverProvider (Just $ InL True) - , chk " completion" _completionProvider (Just $ CompletionOptions Nothing (Just ["."]) Nothing (Just True) Nothing) + , chk " hover" _hoverProvider (Just $ InR (HoverOptions (Just False))) + , chk " completion" _completionProvider (Just $ CompletionOptions (Just False) (Just ["."]) Nothing (Just True) Nothing) , chk "NO signature help" _signatureHelpProvider Nothing - , chk " goto definition" _definitionProvider (Just $ InL True) - , chk " goto type definition" _typeDefinitionProvider (Just $ InL True) + , chk " goto definition" _definitionProvider (Just $ InR (DefinitionOptions (Just False))) + , chk " goto type definition" _typeDefinitionProvider (Just $ InR (InL (TypeDefinitionOptions (Just False)))) -- BUG in lsp-test, this test fails, just change the accepted response -- for now - , chk "NO goto implementation" _implementationProvider (Just $ InL False) - , chk " find references" _referencesProvider (Just $ InL True) - , chk " doc highlight" _documentHighlightProvider (Just $ InL True) - , chk " doc symbol" _documentSymbolProvider (Just $ InL True) - , chk " workspace symbol" _workspaceSymbolProvider (Just $ InL True) - , chk " code action" _codeActionProvider (Just $ InL False) + , chk "NO goto implementation" _implementationProvider Nothing + , chk " find references" _referencesProvider (Just $ InR (ReferenceOptions (Just False))) + , chk " doc highlight" _documentHighlightProvider (Just $ InR (DocumentHighlightOptions (Just False))) + , chk " doc symbol" _documentSymbolProvider (Just $ InR (DocumentSymbolOptions (Just False) Nothing)) + , chk " workspace symbol" _workspaceSymbolProvider (Just $ InR (WorkspaceSymbolOptions (Just False) (Just False))) + , chk "NO code action" _codeActionProvider Nothing , chk " code lens" _codeLensProvider (Just $ CodeLensOptions (Just False) (Just True)) - , chk "NO doc formatting" _documentFormattingProvider (Just $ InL False) + , chk "NO doc formatting" _documentFormattingProvider Nothing , chk "NO doc range formatting" - _documentRangeFormattingProvider (Just $ InL False) + _documentRangeFormattingProvider Nothing , chk "NO doc formatting on typing" _documentOnTypeFormattingProvider Nothing - , chk "NO renaming" _renameProvider (Just $ InL False) + , chk "NO renaming" _renameProvider Nothing , chk "NO doc link" _documentLinkProvider Nothing - , chk "NO color" (^. L.colorProvider) (Just $ InL False) - , chk "NO folding range" _foldingRangeProvider (Just $ InL False) + , chk "NO color" (^. L.colorProvider) Nothing + , chk "NO folding range" _foldingRangeProvider Nothing , che " execute command" _executeCommandProvider [typeLensCommandId, blockCommandId] , chk " workspace" (^. L.workspace) (Just $ #workspaceFolders .== Just WorkspaceFoldersServerCapabilities{_supported = Just True, _changeNotifications = Just ( InR True )} .+ #fileOperations .== Nothing) diff --git a/ghcide/test/exe/PositionMappingTests.hs b/ghcide/test/exe/PositionMappingTests.hs index 8ffbdfd4c1..c48c2fdf8f 100644 --- a/ghcide/test/exe/PositionMappingTests.hs +++ b/ghcide/test/exe/PositionMappingTests.hs @@ -6,8 +6,8 @@ module PositionMappingTests (tests) where import qualified Data.EnumMap.Strict as EM import Data.Row import qualified Data.Text as T -import Data.Text.Utf16.Rope (Rope) -import qualified Data.Text.Utf16.Rope as Rope +import Data.Text.Utf16.Rope.Mixed (Rope) +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE.Core.PositionMapping (PositionResult (..), fromCurrent, positionResultToMaybe, diff --git a/ghcide/test/exe/WatchedFileTests.hs b/ghcide/test/exe/WatchedFileTests.hs index a866ea72d9..7a2a68762b 100644 --- a/ghcide/test/exe/WatchedFileTests.hs +++ b/ghcide/test/exe/WatchedFileTests.hs @@ -28,6 +28,7 @@ tests = testGroup "watched files" [ testSession' "workspace files" $ \sessionDir -> do liftIO $ writeFile (sessionDir "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\", \"A\", \"WatchedFilesMissingModule\"]}}" _doc <- createDoc "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport WatchedFilesMissingModule" + setIgnoringRegistrationRequests False watchedFileRegs <- getWatchedFilesSubscriptionsUntil SMethod_TextDocumentPublishDiagnostics -- Expect 2 subscriptions: one for all .hs files and one for the hie.yaml cradle @@ -38,6 +39,7 @@ tests = testGroup "watched files" let yaml = "cradle: {direct: {arguments: [\"-i" <> tail(init(show tmpDir)) <> "\", \"A\", \"WatchedFilesMissingModule\"]}}" liftIO $ writeFile (sessionDir "hie.yaml") yaml _doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule" + setIgnoringRegistrationRequests False watchedFileRegs <- getWatchedFilesSubscriptionsUntil SMethod_TextDocumentPublishDiagnostics -- Expect 2 subscriptions: one for all .hs files and one for the hie.yaml cradle diff --git a/ghcide/test/ghcide-test-utils.cabal b/ghcide/test/ghcide-test-utils.cabal index 56e507c236..6b1be3f8d4 100644 --- a/ghcide/test/ghcide-test-utils.cabal +++ b/ghcide/test/ghcide-test-utils.cabal @@ -35,7 +35,7 @@ library lsp-types, hls-plugin-api, lens, - lsp-test ^>= 0.16, + lsp-test ^>= 0.17, tasty-hunit >= 0.10, text, row-types, diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index b4a0d12753..de60d7fc0b 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -181,7 +181,7 @@ library hls-cabal-plugin , hls-plugin-api == 2.6.0.0 , hls-graph == 2.6.0.0 , lens - , lsp ^>=2.3 + , lsp ^>=2.4 , lsp-types ^>=2.1 , regex-tdfa ^>=1.3.1 , stm @@ -206,6 +206,7 @@ test-suite hls-cabal-plugin-tests , bytestring , Cabal-syntax >= 3.7 , filepath + , ghcide , haskell-language-server:hls-cabal-plugin , hls-test-utils == 2.6.0.0 , lens @@ -309,7 +310,7 @@ library hls-call-hierarchy-plugin , hiedb , hls-plugin-api == 2.6.0.0 , lens - , lsp >=2.3 + , lsp >=2.4 , sqlite-simple , text @@ -876,7 +877,7 @@ library hls-alternate-number-format-plugin , hls-graph , hls-plugin-api == 2.6.0.0 , lens - , lsp ^>=2.3.0.0 + , lsp ^>=2.4 , mtl , regex-tdfa , syb @@ -1091,7 +1092,7 @@ library hls-gadt-plugin , hls-plugin-api == 2.6.0.0 , haskell-language-server:hls-refactor-plugin , lens - , lsp >=2.3 + , lsp >=2.4 , mtl , text , transformers @@ -1137,7 +1138,7 @@ library hls-explicit-fixity-plugin , ghcide == 2.6.0.0 , hashable , hls-plugin-api == 2.6.0.0 - , lsp >=2.3 + , lsp >=2.4 , text default-extensions: DataKinds @@ -1566,7 +1567,7 @@ library hls-semantic-tokens-plugin , ghcide == 2.6.0.0 , hls-plugin-api == 2.6.0.0 , lens - , lsp >=2.3 + , lsp >=2.4 , text , transformers , bytestring diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 76ce242581..6043100b28 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -69,7 +69,7 @@ library , hls-graph == 2.6.0.0 , lens , lens-aeson - , lsp ^>=2.3 + , lsp ^>=2.4 , megaparsec >=9.0 , mtl , opentelemetry >=0.4 diff --git a/hls-plugin-api/src/Ide/Plugin/Resolve.hs b/hls-plugin-api/src/Ide/Plugin/Resolve.hs index a36871d613..e83e45a816 100644 --- a/hls-plugin-api/src/Ide/Plugin/Resolve.hs +++ b/hls-plugin-api/src/Ide/Plugin/Resolve.hs @@ -22,7 +22,7 @@ import Control.Lens (_Just, (&), (.~), (?~), (^.), (^?)) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Control.Monad.Trans.Except (ExceptT (..)) import qualified Data.Aeson as A import Data.Maybe (catMaybes) @@ -35,11 +35,8 @@ import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types -import Language.LSP.Server (LspT, - ProgressCancellable (Cancellable), - getClientCapabilities, - sendRequest, - withIndefiniteProgress) +import Language.LSP.Server (LspT, getClientCapabilities, + sendRequest) data Log = DoesNotSupportResolve T.Text @@ -140,25 +137,24 @@ mkCodeActionWithResolveAndCommand recorder plId codeActionMethod codeResolveMeth codeAction & L.data_ .~ (A.toJSON .WithURI uri <$> data_) where data_ = codeAction ^? L.data_ . _Just executeResolveCmd :: ResolveFunction ideState a 'Method_CodeActionResolve -> CommandFunction ideState CodeAction - executeResolveCmd resolveProvider ideState ca@CodeAction{_data_=Just value} = do - ExceptT $ withIndefiniteProgress "Applying edits for code action..." Cancellable $ runExceptT $ do - case A.fromJSON value of - A.Error err -> throwError $ parseError (Just value) (T.pack err) - A.Success (WithURI uri innerValue) -> do - case A.fromJSON innerValue of - A.Error err -> throwError $ parseError (Just value) (T.pack err) - A.Success innerValueDecoded -> do - resolveResult <- resolveProvider ideState plId ca uri innerValueDecoded - case resolveResult of - ca2@CodeAction {_edit = Just wedits } | diffCodeActions ca ca2 == ["edit"] -> do - _ <- ExceptT $ Right <$> sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) handleWEditCallback - pure $ InR Null - ca2@CodeAction {_edit = Just _ } -> - throwError $ internalError $ - "The resolve provider unexpectedly returned a code action with the following differing fields: " - <> (T.pack $ show $ diffCodeActions ca ca2) - _ -> throwError $ internalError "The resolve provider unexpectedly returned a result with no data field" - executeResolveCmd _ _ CodeAction{_data_= value} = throwError $ invalidParamsError ("The code action to resolve has an illegal data field: " <> (T.pack $ show value)) + executeResolveCmd resolveProvider ideState _token ca@CodeAction{_data_=Just value} = do + case A.fromJSON value of + A.Error err -> throwError $ parseError (Just value) (T.pack err) + A.Success (WithURI uri innerValue) -> do + case A.fromJSON innerValue of + A.Error err -> throwError $ parseError (Just value) (T.pack err) + A.Success innerValueDecoded -> do + resolveResult <- resolveProvider ideState plId ca uri innerValueDecoded + case resolveResult of + ca2@CodeAction {_edit = Just wedits } | diffCodeActions ca ca2 == ["edit"] -> do + _ <- ExceptT $ Right <$> sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) handleWEditCallback + pure $ InR Null + ca2@CodeAction {_edit = Just _ } -> + throwError $ internalError $ + "The resolve provider unexpectedly returned a code action with the following differing fields: " + <> (T.pack $ show $ diffCodeActions ca ca2) + _ -> throwError $ internalError "The resolve provider unexpectedly returned a result with no data field" + executeResolveCmd _ _ _ CodeAction{_data_= value} = throwError $ invalidParamsError ("The code action to resolve has an illegal data field: " <> (T.pack $ show value)) handleWEditCallback (Left err ) = do logWith recorder Warning (ApplyWorkspaceEditFailed err) pure () diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 66dc5d5cdf..62552e7e05 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -980,6 +980,7 @@ data PluginCommand ideState = forall a. (FromJSON a) => type CommandFunction ideState a = ideState + -> Maybe ProgressToken -> a -> ExceptT PluginError (LspM Config) (Value |? Null) @@ -1068,6 +1069,7 @@ type FormattingMethod m = type FormattingHandler a = a + -> Maybe ProgressToken -> FormattingType -> T.Text -> NormalizedFilePath @@ -1084,11 +1086,11 @@ mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provid mf <- lift $ getVirtualFile $ toNormalizedUri uri case mf of Just vf -> do - let typ = case m of - SMethod_TextDocumentFormatting -> FormatText - SMethod_TextDocumentRangeFormatting -> FormatRange (params ^. L.range) + let (typ, mtoken) = case m of + SMethod_TextDocumentFormatting -> (FormatText, params ^. L.workDoneToken) + SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. L.range), params ^. L.workDoneToken) _ -> Prelude.error "mkFormattingHandlers: impossible" - f ide typ (virtualFileText vf) nfp opts + f ide mtoken typ (virtualFileText vf) nfp opts Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri | otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index 76f9217910..2fdbe3434d 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -44,7 +44,7 @@ library , ghcide == 2.6.0.0 , hls-plugin-api == 2.6.0.0 , lens - , lsp-test ^>=0.16 + , lsp-test ^>=0.17 , lsp-types ^>=2.1 , tasty , tasty-expected-failure diff --git a/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs b/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs index 99f7901223..367898fa21 100644 --- a/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs +++ b/plugins/hls-cabal-fmt-plugin/src/Ide/Plugin/CabalFmt.hs @@ -47,10 +47,10 @@ descriptor recorder plId = -- Formats the given source in either a given Range or the whole Document. -- If the provider fails an error is returned that can be displayed to the user. provider :: Recorder (WithPriority Log) -> FormattingHandler IdeState -provider recorder _ (FormatRange _) _ _ _ = do +provider recorder _ _ (FormatRange _) _ _ _ = do logWith recorder Info LogInvalidInvocationInfo throwError $ PluginInvalidParams "You cannot format a text-range using cabal-fmt." -provider recorder _ide FormatText contents nfp opts = do +provider recorder _ide _ FormatText contents nfp opts = do let cabalFmtArgs = [ "--indent", show tabularSize] x <- liftIO $ findExecutable "cabal-fmt" case x of diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index be1c798324..7126dc14b1 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -25,6 +25,8 @@ import Development.IDE as D import Development.IDE.Core.Shake (restartShakeSession) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph (alwaysRerun) +import qualified Development.IDE.Plugin.Completions.Logic as Ghcide +import qualified Development.IDE.Plugin.Completions.Types as Ghcide import GHC.Generics import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes import qualified Ide.Plugin.Cabal.Completion.Completions as Completions @@ -279,14 +281,13 @@ completion recorder ide _ complParams = do contents <- lift $ getVirtualFile $ toNormalizedUri uri case (contents, uriToFilePath' uri) of (Just cnts, Just path) -> do - pref <- VFS.getCompletionPrefix position cnts + let pref = Ghcide.getCompletionPrefix position cnts let res = result pref path cnts liftIO $ fmap InL res _ -> pure . InR $ InR Null where - result :: Maybe VFS.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem] - result Nothing _ _ = pure [] - result (Just prefix) fp cnts = do + result :: Ghcide.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem] + result prefix fp cnts = do runMaybeT context >>= \case Nothing -> pure [] Just ctx -> do @@ -306,6 +307,6 @@ completion recorder ide _ complParams = do pure completions where completerRecorder = cmapWithPrio LogCompletions recorder - pos = VFS.cursorPos prefix + pos = Ghcide.cursorPos prefix context = Completions.getContext completerRecorder prefInfo (cnts ^. VFS.file_text) prefInfo = Completions.getCabalPrefixInfo fp prefix diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs index 0cd4f64e8b..6a59b2fb69 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs @@ -10,16 +10,18 @@ import qualified Data.List as List import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Text as T -import Data.Text.Utf16.Rope (Rope) -import qualified Data.Text.Utf16.Rope as Rope +import qualified Data.Text.Utf16.Lines as Rope (Position (..)) +import Data.Text.Utf16.Rope.Mixed (Rope) +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE as D +import qualified Development.IDE.Plugin.Completions.Logic as Ghcide +import qualified Development.IDE.Plugin.Completions.Types as Ghcide import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Snippet import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) import Ide.Plugin.Cabal.Completion.Data import Ide.Plugin.Cabal.Completion.Types import qualified Language.LSP.Protocol.Lens as JL -import qualified Language.LSP.VFS as VFS import qualified System.FilePath as FP import System.FilePath (takeBaseName) @@ -96,23 +98,23 @@ getContext recorder prefInfo ls = -- Checks whether a suffix needs to be completed -- and calculates the range in the document -- where the completion action should be applied. -getCabalPrefixInfo :: FilePath -> VFS.PosPrefixInfo -> CabalPrefixInfo +getCabalPrefixInfo :: FilePath -> Ghcide.PosPrefixInfo -> CabalPrefixInfo getCabalPrefixInfo fp prefixInfo = CabalPrefixInfo { completionPrefix = completionPrefix', isStringNotation = mkIsStringNotation separator afterCursorText, - completionCursorPosition = VFS.cursorPos prefixInfo, + completionCursorPosition = Ghcide.cursorPos prefixInfo, completionRange = Range completionStart completionEnd, completionWorkingDir = FP.takeDirectory fp, completionFileName = T.pack $ takeBaseName fp } where - completionEnd = VFS.cursorPos prefixInfo + completionEnd = Ghcide.cursorPos prefixInfo completionStart = Position (_line completionEnd) (_character completionEnd - (fromIntegral $ T.length completionPrefix')) - (beforeCursorText, afterCursorText) = T.splitAt cursorColumn $ VFS.fullLine prefixInfo + (beforeCursorText, afterCursorText) = T.splitAt cursorColumn $ Ghcide.fullLine prefixInfo completionPrefix' = T.takeWhileEnd (not . (`elem` stopConditionChars)) beforeCursorText separator = -- if there is an opening apostrophe before the cursor in the line somewhere, @@ -120,7 +122,7 @@ getCabalPrefixInfo fp prefixInfo = if odd $ T.count "\"" beforeCursorText then '\"' else ' ' - cursorColumn = fromIntegral $ VFS.cursorPos prefixInfo ^. JL.character + cursorColumn = fromIntegral $ Ghcide.cursorPos prefixInfo ^. JL.character stopConditionChars = separator : [',', ':'] -- \| Takes the character occurring exactly before, @@ -207,7 +209,7 @@ splitAtPosition pos ls = do split <- splitFile pure $ reverse $ Rope.lines $ fst split where - splitFile = Rope.splitAtPosition ropePos ls + splitFile = Rope.utf16SplitAtPosition ropePos ls ropePos = Rope.Position { Rope.posLine = fromIntegral $ pos ^. JL.line, diff --git a/plugins/hls-cabal-plugin/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs index 594678ad71..61d637a1b6 100644 --- a/plugins/hls-cabal-plugin/test/Completer.hs +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -8,6 +8,7 @@ import Control.Lens.Prism import qualified Data.ByteString as ByteString import Data.Maybe (mapMaybe) import qualified Data.Text as T +import qualified Development.IDE.Plugin.Completions.Types as Ghcide import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module @@ -18,7 +19,6 @@ import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo StanzaName) import Ide.Plugin.Cabal.Parse (GenericPackageDescription) import qualified Language.LSP.Protocol.Lens as L -import qualified Language.LSP.VFS as VFS import System.FilePath import Test.Hls import Utils @@ -152,13 +152,13 @@ filePathCompletionContextTests = compls @?== ["f1.txt", "f2.hs"] ] where - simplePosPrefixInfo :: T.Text -> UInt -> UInt -> VFS.PosPrefixInfo + simplePosPrefixInfo :: T.Text -> UInt -> UInt -> Ghcide.PosPrefixInfo simplePosPrefixInfo lineString linePos charPos = - VFS.PosPrefixInfo - { VFS.fullLine = lineString, - VFS.prefixModule = "", - VFS.prefixText = "", - VFS.cursorPos = Position linePos charPos + Ghcide.PosPrefixInfo + { Ghcide.fullLine = lineString, + Ghcide.prefixScope = "", + Ghcide.prefixText = "", + Ghcide.cursorPos = Position linePos charPos } directoryCompleterTests :: TestTree @@ -228,11 +228,11 @@ completionHelperTests = getFilePathCursorPrefix :: T.Text -> UInt -> UInt -> T.Text getFilePathCursorPrefix lineString linePos charPos = completionPrefix . getCabalPrefixInfo "" $ - VFS.PosPrefixInfo - { VFS.fullLine = lineString, - VFS.prefixModule = "", - VFS.prefixText = "", - VFS.cursorPos = Position linePos charPos + Ghcide.PosPrefixInfo + { Ghcide.fullLine = lineString, + Ghcide.prefixScope = "", + Ghcide.prefixText = "", + Ghcide.cursorPos = Position linePos charPos } filePathExposedModulesTests :: TestTree diff --git a/plugins/hls-cabal-plugin/test/Context.hs b/plugins/hls-cabal-plugin/test/Context.hs index 63b9ad24bc..ba2275dc1b 100644 --- a/plugins/hls-cabal-plugin/test/Context.hs +++ b/plugins/hls-cabal-plugin/test/Context.hs @@ -6,7 +6,7 @@ module Context where import Control.Monad.Trans.Maybe (runMaybeT) import qualified Data.Text as T -import qualified Data.Text.Utf16.Rope as Rope +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Ide.Plugin.Cabal import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completions diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs index 29808db583..ad17c1409a 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeAction.hs @@ -42,7 +42,7 @@ import Language.LSP.Protocol.Types import Language.LSP.Server addMethodPlaceholders :: PluginId -> CommandFunction IdeState AddMinimalMethodsParams -addMethodPlaceholders _ state param@AddMinimalMethodsParams{..} = do +addMethodPlaceholders _ state _ param@AddMinimalMethodsParams{..} = do caps <- lift getClientCapabilities nfp <- getNormalizedFilePathE (verTxtDocId ^. L.uri) pm <- runActionE "classplugin.addMethodPlaceholders.GetParsedModule" state diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs index e2a04cce51..6b009b272d 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/CodeLens.hs @@ -68,7 +68,7 @@ codeLensResolve state plId cl uri uniqueID = do -- Finally the command actually generates and applies the workspace edit for the -- specified unique id. codeLensCommandHandler :: PluginId -> CommandFunction IdeState InstanceBindLensCommand -codeLensCommandHandler plId state InstanceBindLensCommand{commandUri, commandEdit} = do +codeLensCommandHandler plId state _ InstanceBindLensCommand{commandUri, commandEdit} = do nfp <- getNormalizedFilePathE commandUri (InstanceBindLensResult (InstanceBindLens{lensEnabledExtensions}), _) <- runActionE "classplugin.GetInstanceBindLens" state diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 1cd9fdca08..6d840968c5 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -199,7 +199,7 @@ evalCommand plId = PluginCommand evalCommandName "evaluate" (runEvalCmd plId) type EvalId = Int runEvalCmd :: PluginId -> CommandFunction IdeState EvalParams -runEvalCmd plId st EvalParams{..} = +runEvalCmd plId st mtoken EvalParams{..} = let dbg = logWith st perf = timed dbg cmd :: ExceptT PluginError (LspM Config) WorkspaceEdit @@ -233,7 +233,7 @@ runEvalCmd plId st EvalParams{..} = return workspaceEdits in perf "evalCmd" $ ExceptT $ - withIndefiniteProgress "Evaluating" Cancellable $ + withIndefiniteProgress "Evaluating" mtoken Cancellable $ \_updater -> runExceptT $ response' cmd -- | Create an HscEnv which is suitable for performing interactive evaluation. diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 9050436081..8b66538308 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -105,7 +105,7 @@ descriptorForModules recorder modFilter plId = -- | The actual command handler runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData -runImportCommand recorder ideState eird@(ResolveOne _ _) = do +runImportCommand recorder ideState _ eird@(ResolveOne _ _) = do wedit <- resolveWTextEdit ideState eird _ <- lift $ sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) logErrors return $ InR Null @@ -113,7 +113,7 @@ runImportCommand recorder ideState eird@(ResolveOne _ _) = do logWith recorder Error (LogWAEResponseError re) pure () logErrors (Right _) = pure () -runImportCommand _ _ rd = do +runImportCommand _ _ _ rd = do throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for command handler:" <> show rd) diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs index 521a676a0f..6a3481404c 100644 --- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs +++ b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs @@ -32,7 +32,7 @@ descriptor plId = (defaultPluginDescriptor plId desc) -- Formats the given source in either a given Range or the whole Document. -- If the provider fails an error is returned that can be displayed to the user. provider :: FormattingHandler IdeState -provider _ideState typ contents fp _ = do +provider _ideState _token typ contents fp _ = do let file = fromNormalizedFilePath fp config <- liftIO $ findConfigOrDefault file let (range, selectedContents) = case typ of diff --git a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs index 024675ca0d..f8ed5871e9 100644 --- a/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/hls-fourmolu-plugin/src/Ide/Plugin/Fourmolu.hs @@ -66,7 +66,7 @@ properties = False provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState -provider recorder plId ideState typ contents fp fo = ExceptT $ withIndefiniteProgress title Cancellable $ runExceptT $ do +provider recorder plId ideState token typ contents fp fo = ExceptT $ withIndefiniteProgress title token Cancellable $ \_updater -> runExceptT $ do fileOpts <- maybe [] (convertDynFlags . hsc_dflags . hscEnv) <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp) diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs index 58e2b6ab9b..933d276e48 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GADT.hs @@ -53,7 +53,7 @@ toGADTSyntaxCommandId = "GADT.toGADT" -- | A command replaces H98 data decl with GADT decl in place toGADTCommand :: PluginId -> CommandFunction IdeState ToGADTParams -toGADTCommand pId@(PluginId pId') state ToGADTParams{..} = withExceptT handleGhcidePluginError $ do +toGADTCommand pId@(PluginId pId') state _ ToGADTParams{..} = withExceptT handleGhcidePluginError $ do nfp <- withExceptT GhcidePluginErrors $ getNormalizedFilePathE uri (decls, exts) <- getInRangeH98DeclsAndExts state range nfp (L ann decl) <- case decls of diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index b2f1e130ec..a62fb674ad 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -88,7 +88,7 @@ codeLens recorder state pluginId CodeLensParams{_textDocument=TextDocumentIdenti -- | (Quasi) Idempotent command execution: recalculate action to execute on command request command :: Recorder (WithPriority Log) -> CommandFunction IdeState Uri -command recorder state uri = do +command recorder state _ uri = do actMaybe <- action recorder state uri forM_ actMaybe $ \Replace{..} -> let diff --git a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs index dc876b8944..115fea6232 100644 --- a/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs +++ b/plugins/hls-ormolu-plugin/src/Ide/Plugin/Ormolu.hs @@ -63,7 +63,7 @@ properties = -- --------------------------------------------------------------------- provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState -provider recorder plId ideState typ contents fp _ = ExceptT $ withIndefiniteProgress title Cancellable $ runExceptT $ do +provider recorder plId ideState token typ contents fp _ = ExceptT $ withIndefiniteProgress title token Cancellable $ \_updater -> runExceptT $ do fileOpts <- maybe [] (fromDyn . hsc_dflags . hscEnv) <$> liftIO (runAction "Ormolu" ideState $ use GhcSession fp) diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index afb79854a9..28ced1d5bc 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -15,28 +15,29 @@ module Ide.Plugin.Pragmas , AppearWhere(..) ) where -import Control.Lens hiding (List) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans.Class (lift) -import Data.List.Extra (nubOrdOn) -import qualified Data.Map as M -import Data.Maybe (mapMaybe) -import qualified Data.Text as T -import Development.IDE hiding (line) -import Development.IDE.Core.Compile (sourceParser, - sourceTypecheck) +import Control.Lens hiding (List) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans.Class (lift) +import Data.List.Extra (nubOrdOn) +import qualified Data.Map as M +import Data.Maybe (mapMaybe) +import qualified Data.Text as T +import Development.IDE hiding (line) +import Development.IDE.Core.Compile (sourceParser, + sourceTypecheck) import Development.IDE.Core.PluginUtils import Development.IDE.GHC.Compat -import Development.IDE.Plugin.Completions (ghcideCompletionsPluginPriority) -import qualified Development.IDE.Spans.Pragmas as Pragmas +import Development.IDE.Plugin.Completions (ghcideCompletionsPluginPriority) +import Development.IDE.Plugin.Completions.Logic (getCompletionPrefix) +import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..)) +import qualified Development.IDE.Spans.Pragmas as Pragmas import Ide.Plugin.Error import Ide.Types -import qualified Language.LSP.Protocol.Lens as L -import qualified Language.LSP.Protocol.Message as LSP -import qualified Language.LSP.Protocol.Types as LSP -import qualified Language.LSP.Server as LSP -import qualified Language.LSP.VFS as VFS -import qualified Text.Fuzzy as Fuzzy +import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Message as LSP +import qualified Language.LSP.Protocol.Types as LSP +import qualified Language.LSP.Server as LSP +import qualified Text.Fuzzy as Fuzzy -- --------------------------------------------------------------------- @@ -201,15 +202,15 @@ completion _ide _ complParams = do contents <- lift $ LSP.getVirtualFile $ toNormalizedUri uri fmap LSP.InL $ case (contents, uriToFilePath' uri) of (Just cnts, Just _path) -> - result <$> VFS.getCompletionPrefix position cnts + pure $ result $ getCompletionPrefix position cnts where - result (Just pfix) + result pfix | "{-# language" `T.isPrefixOf` line = map buildCompletion - (Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas) + (Fuzzy.simpleFilter (prefixText pfix) allPragmas) | "{-# options_ghc" `T.isPrefixOf` line = map buildCompletion - (Fuzzy.simpleFilter (VFS.prefixText pfix) flags) + (Fuzzy.simpleFilter (prefixText pfix) flags) | "{-#" `T.isPrefixOf` line = [ mkPragmaCompl (a <> suffix) b c | (a, b, c, w) <- validPragmas, w == NewLine @@ -234,9 +235,9 @@ completion _ide _ complParams = do (appearWhere == CanInline && line /= word && Fuzzy.test word matcher) ] where - line = T.toLower $ VFS.fullLine pfix - module_ = VFS.prefixModule pfix - word = VFS.prefixText pfix + line = T.toLower $ fullLine pfix + module_ = prefixScope pfix + word = prefixText pfix -- Not completely correct, may fail if more than one "{-#" exist -- , we can ignore it since it rarely happen. prefix @@ -249,7 +250,6 @@ completion _ide _ complParams = do | "-}" `T.isSuffixOf` line = " #" | "}" `T.isSuffixOf` line = " #-" | otherwise = " #-}" - result Nothing = [] _ -> return [] ----------------------------------------------------------------------- diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index cf61feebe6..cd96758b39 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -103,7 +103,7 @@ import Language.LSP.Protocol.Types (ApplyWorkspa uriToFilePath) import qualified Language.LSP.Server as LSP import Language.LSP.VFS (VirtualFile, - _file_text) + virtualFileText) import qualified Text.Fuzzy.Parallel as TFP import qualified Text.Regex.Applicative as RE import Text.Regex.TDFA ((=~), (=~~)) @@ -115,7 +115,7 @@ codeAction :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics= xs}) = do contents <- lift $ LSP.getVirtualFile $ toNormalizedUri uri liftIO $ do - let text = Rope.toText . (_file_text :: VirtualFile -> Rope.Rope) <$> contents + let text = virtualFileText <$> contents mbFile = toNormalizedFilePath' <$> uriToFilePath uri diag <- atomically $ fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile @@ -188,7 +188,7 @@ extendImportCommand = PluginCommand (CommandId extendImportCommandId) "additional edits for a completion" extendImportHandler extendImportHandler :: CommandFunction IdeState ExtendImport -extendImportHandler ideState edit@ExtendImport {..} = ExceptT $ do +extendImportHandler ideState _ edit@ExtendImport {..} = ExceptT $ do res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do let (_, (head -> TextEdit {_range})) = fromJust $ _changes >>= listToMaybe . M.toList diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 46e9750683..322661f417 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -168,8 +168,8 @@ data RunRetrieParams = RunRetrieParams } deriving (Eq, Show, Generic, FromJSON, ToJSON) runRetrieCmd :: CommandFunction IdeState RunRetrieParams -runRetrieCmd state RunRetrieParams{originatingFile = uri, ..} = ExceptT $ - withIndefiniteProgress description Cancellable $ do +runRetrieCmd state token RunRetrieParams{originatingFile = uri, ..} = ExceptT $ + withIndefiniteProgress description token Cancellable $ \_updater -> do runExceptT $ do nfp <- getNormalizedFilePathE uri (session, _) <- @@ -203,7 +203,7 @@ data RunRetrieInlineThisParams = RunRetrieInlineThisParams deriving (Eq, Show, Generic, FromJSON, ToJSON) runRetrieInlineThisCmd :: CommandFunction IdeState RunRetrieInlineThisParams -runRetrieInlineThisCmd state RunRetrieInlineThisParams{..} = do +runRetrieInlineThisCmd state token RunRetrieInlineThisParams{..} = do nfp <- getNormalizedFilePathE $ getLocationUri inlineIntoThisLocation nfpSource <- getNormalizedFilePathE $ getLocationUri inlineFromThisLocation -- What we do here: diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs index 388137cbc2..2ed11be333 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs @@ -17,7 +17,6 @@ import qualified Data.Map.Strict as Map import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Rope as Char -import Data.Text.Utf16.Rope (toText) import qualified Data.Text.Utf16.Rope as Utf16 import Data.Text.Utf16.Rope.Mixed (Rope) import qualified Data.Text.Utf16.Rope.Mixed as Rope @@ -55,7 +54,7 @@ mkPTokenState :: VirtualFile -> PTokenState mkPTokenState vf = PTokenState { - rope = Rope.fromText $ toText vf._file_text, + rope = vf._file_text, cursor = Char.Position 0 0, columnsInUtf16 = 0 } diff --git a/plugins/hls-semantic-tokens-plugin/test/Main.hs b/plugins/hls-semantic-tokens-plugin/test/Main.hs index 8905b0ae7d..a2d7fde20a 100644 --- a/plugins/hls-semantic-tokens-plugin/test/Main.hs +++ b/plugins/hls-semantic-tokens-plugin/test/Main.hs @@ -12,7 +12,7 @@ import Data.String (fromString) import Data.Text hiding (length, map, unlines) import qualified Data.Text as Text -import qualified Data.Text.Utf16.Rope as Rope +import qualified Data.Text.Utf16.Rope.Mixed as Rope import Development.IDE (Pretty) import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 7ebf26ebf5..a756fd301e 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -94,7 +94,7 @@ expandTHSplice :: -- | Inplace? ExpandStyle -> CommandFunction IdeState ExpandSpliceParams -expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = ExceptT $ do +expandTHSplice _eStyle ideState _ params@ExpandSpliceParams {..} = ExceptT $ do clientCapabilities <- getClientCapabilities rio <- askRunInIO let reportEditor :: ReportEditor diff --git a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs index 3e8f43414c..795b3e7172 100644 --- a/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs +++ b/plugins/hls-stylish-haskell-plugin/src/Ide/Plugin/StylishHaskell.hs @@ -37,7 +37,7 @@ descriptor plId = (defaultPluginDescriptor plId desc) -- Formats the given source in either a given Range or the whole Document. -- If the provider fails an error is returned that can be displayed to the user. provider :: FormattingHandler IdeState -provider ide typ contents fp _opts = do +provider ide _token typ contents fp _opts = do (msrModSummary -> ms_hspp_opts -> dyn) <- runActionE "stylish-haskell" ide $ useE GetModSummary fp let file = fromNormalizedFilePath fp config <- liftIO $ loadConfigFrom file From e7571625ea261e231e80b8c9d1310fcaf9175898 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Mon, 5 Feb 2024 17:04:28 +0000 Subject: [PATCH 2/3] stack --- stack-lts21.yaml | 6 +++--- stack.yaml | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/stack-lts21.yaml b/stack-lts21.yaml index 4cb4f6f4f5..92ff5a1a03 100644 --- a/stack-lts21.yaml +++ b/stack-lts21.yaml @@ -24,9 +24,9 @@ extra-deps: - monad-dijkstra-0.1.1.3 - retrie-1.2.2 - stylish-haskell-0.14.4.0 -- lsp-2.3.0.0 -- lsp-test-0.16.0.1 -- lsp-types-2.1.0.0 +- lsp-2.4.0.0 +- lsp-test-0.17.0.0 +- lsp-types-2.1.1.0 # stan dependencies not found in the stackage snapshot - stan-0.1.2.0 diff --git a/stack.yaml b/stack.yaml index ac6f5df4cf..3f278f8a6d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -21,9 +21,9 @@ extra-deps: - hiedb-0.5.0.1 - implicit-hie-0.1.4.0 - hie-bios-0.13.1 -- lsp-2.3.0.0 -- lsp-test-0.16.0.1 -- lsp-types-2.1.0.0 +- lsp-2.4.0.0 +- lsp-test-0.17.0.0 +- lsp-types-2.1.1.0 - attoparsec-aeson-2.1.0.0 - hw-fingertree-0.1.2.1 - integer-conversion-0.1.0.1 From f59d4e3f75083288ea7349c2fa6e0e4419e3ce2e Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Tue, 6 Feb 2024 15:24:06 +0000 Subject: [PATCH 3/3] More fixes --- plugins/hls-refactor-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 3e3dde6d6e..0918410489 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -81,7 +81,7 @@ initializeTests = withResource acquire release tests where tests :: IO (TResponseMessage Method_Initialize) -> TestTree tests getInitializeResponse = testGroup "initialize response capabilities" - [ chk " code action" _codeActionProvider (Just (InR (CodeActionOptions {_workDoneProgress = Nothing, _codeActionKinds = Nothing, _resolveProvider = Just False}))) + [ chk " code action" _codeActionProvider (Just (InR (CodeActionOptions {_workDoneProgress = Just False, _codeActionKinds = Nothing, _resolveProvider = Just False}))) , che " execute command" _executeCommandProvider [extendImportCommandId] ] where