From 51f8821a22c8839b7aed01f910720f8e1df43756 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Sun, 28 Mar 2021 17:31:34 +0530 Subject: [PATCH 1/9] Update to lsp-1.2 --- cabal.project | 2 +- ghcide/exe/Main.hs | 3 +- ghcide/ghcide.cabal | 8 ++-- ghcide/src/Development/IDE/Core/Shake.hs | 12 ++---- .../src/Development/IDE/LSP/LanguageServer.hs | 11 +++-- .../src/Development/IDE/LSP/Notifications.hs | 1 - ghcide/src/Development/IDE/LSP/Outline.hs | 1 + ghcide/src/Development/IDE/Main.hs | 10 ++--- .../src/Development/IDE/Plugin/CodeAction.hs | 11 ++++- .../IDE/Plugin/CodeAction/ExactPrint.hs | 1 + .../IDE/Plugin/Completions/Logic.hs | 9 +++-- ghcide/src/Development/IDE/Plugin/HLS.hs | 21 +++++----- .../src/Development/IDE/Plugin/TypeLenses.hs | 2 +- ghcide/src/Development/IDE/Spans/AtPoint.hs | 2 +- ghcide/test/exe/Main.hs | 12 +++--- haskell-language-server.cabal | 2 +- hls-plugin-api/hls-plugin-api.cabal | 2 +- hls-plugin-api/src/Ide/Plugin/Properties.hs | 7 +--- hls-plugin-api/src/Ide/PluginUtils.hs | 16 ++++---- hls-plugin-api/src/Ide/Types.hs | 6 +-- hls-test-utils/hls-test-utils.cabal | 4 +- hls-test-utils/src/Test/Hls/Util.hs | 2 +- plugins/default/src/Ide/Plugin/Example.hs | 10 +++-- plugins/default/src/Ide/Plugin/Example2.hs | 10 +++-- plugins/default/src/Ide/Plugin/Fourmolu.hs | 2 +- plugins/default/src/Ide/Plugin/ModuleName.hs | 2 +- plugins/default/src/Ide/Plugin/Ormolu.hs | 2 +- plugins/default/src/Ide/Plugin/Pragmas.hs | 4 +- .../hls-class-plugin/src/Ide/Plugin/Class.hs | 5 +-- .../src/Ide/Plugin/Eval/CodeLens.hs | 2 +- .../src/Ide/Plugin/ExplicitImports.hs | 10 +++-- .../src/Ide/Plugin/HaddockComments.hs | 3 ++ .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 4 +- .../src/Ide/Plugin/Retrie.hs | 4 +- .../src/Ide/Plugin/Splice.hs | 20 +++++++--- .../Wingman/LanguageServer/TacticProviders.hs | 16 ++++---- stack-8.10.2.yaml | 6 +-- stack-8.10.3.yaml | 6 +-- stack-8.10.4.yaml | 6 +-- stack-8.6.4.yaml | 6 +-- stack-8.6.5.yaml | 6 +-- stack-8.8.2.yaml | 6 +-- stack-8.8.3.yaml | 6 +-- stack-8.8.4.yaml | 6 +-- stack.yaml | 6 +-- test/functional/FunctionalCodeAction.hs | 2 +- test/functional/Symbol.hs | 40 +++++++++---------- 47 files changed, 179 insertions(+), 156 deletions(-) diff --git a/cabal.project b/cabal.project index 745f326e6e..f3b33a86bc 100644 --- a/cabal.project +++ b/cabal.project @@ -27,7 +27,7 @@ package ghcide write-ghc-environment-files: never -index-state: 2021-03-02T21:23:14Z +index-state: 2021-03-29T21:23:14Z allow-newer: active:base, diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 042afed11c..041c6a6186 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -12,7 +12,6 @@ import Control.Monad.Extra (unless, when, whenJust) import qualified Data.Aeson.Encode.Pretty as A import Data.Default (Default (def)) import Data.List.Extra (upper) -import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Text.Lazy.Encoding (decodeUtf8) @@ -122,7 +121,7 @@ main = do then Test.plugin else mempty - ,Main.argsIdeOptions = \(fromMaybe def -> config) sessionLoader -> + ,Main.argsIdeOptions = \config sessionLoader -> let defOptions = defaultIdeOptions sessionLoader in defOptions { optShakeProfiling = argsShakeProfiling diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 82417ac0e3..e61b07aa88 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -59,8 +59,8 @@ library hls-plugin-api ^>= 1.1.0.0, lens, hiedb == 0.3.0.1, - lsp-types == 1.1.*, - lsp == 1.1.1.0, + lsp-types == 1.2.*, + lsp == 1.2.*, mtl, network-uri, parallel, @@ -339,7 +339,7 @@ test-suite ghcide-tests hls-plugin-api, network-uri, lens, - lsp-test == 0.13.0.0, + lsp-test == 0.14.0.0, optparse-applicative, process, QuickCheck, @@ -396,7 +396,7 @@ executable ghcide-bench extra, filepath, ghcide, - lsp-test == 0.13.0.0, + lsp-test == 0.14.0.0, optparse-applicative, process, safe-exceptions, diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 85c3dd1406..c67c2e6c5e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -50,7 +50,7 @@ module Development.IDE.Core.Shake( getIdeOptions, getIdeOptionsIO, GlobalIdeOptions(..), - getClientConfig, + HLS.getClientConfig, getPluginConfig, garbageCollect, knownTargets, @@ -230,14 +230,10 @@ getShakeExtrasRules = do Just x <- getShakeExtraRules @ShakeExtras return x -getClientConfig :: LSP.MonadLsp Config m => ShakeExtras -> m Config -getClientConfig ShakeExtras { defaultConfig } = - fromMaybe defaultConfig <$> HLS.getClientConfig - getPluginConfig - :: LSP.MonadLsp Config m => ShakeExtras -> PluginId -> m PluginConfig -getPluginConfig extras plugin = do - config <- getClientConfig extras + :: LSP.MonadLsp Config m => PluginId -> m PluginConfig +getPluginConfig plugin = do + config <- HLS.getClientConfig return $ HLS.configForPlugin config plugin -- | Register a function that will be called to get the "stale" result of a rule, possibly from disk diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index bc8a121c8b..53a2aee1e0 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -23,7 +23,6 @@ import Data.Aeson (Value) import Data.Maybe import qualified Data.Set as Set import qualified Data.Text as T -import qualified Development.IDE.GHC.Util as Ghcide import Development.IDE.LSP.Server import Development.IDE.Session (runWithDb) import Ide.Types (traceWithSpan) @@ -50,11 +49,12 @@ runLanguageServer -> Handle -- input -> Handle -- output -> (FilePath -> IO FilePath) -- ^ Map root paths to the location of the hiedb for the project - -> (IdeState -> Value -> IO (Either T.Text config)) + -> config + -> (config -> Value -> Either T.Text config) -> LSP.Handlers (ServerM config) -> (LSP.LanguageContextEnv config -> VFSHandle -> Maybe FilePath -> HieDb -> IndexQueue -> IO IdeState) -> IO () -runLanguageServer options inH outH getHieDbLoc onConfigurationChange userHandlers getIdeState = do +runLanguageServer options inH outH getHieDbLoc defaultConfig onConfigurationChange userHandlers getIdeState = do -- These barriers are signaled when the threads reading from these chans exit. -- This should not happen but if it does, we will make sure that the whole server @@ -103,9 +103,8 @@ runLanguageServer options inH outH getHieDbLoc onConfigurationChange userHandler let serverDefinition = LSP.ServerDefinition - { LSP.onConfigurationChange = \v -> do - (_chan, ide) <- ask - liftIO $ onConfigurationChange ide v + { LSP.onConfigurationChange = onConfigurationChange + , LSP.defaultConfig = defaultConfig , LSP.doInitialize = handleInit exit clearReqId waitForCancel clientMsgChan , LSP.staticHandlers = asyncHandlers , LSP.interpretHandler = \(env, st) -> LSP.Iso (LSP.runLspT env . flip runReaderT (clientMsgChan,st)) liftIO diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index e1909691f9..883e97bdf9 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -19,7 +19,6 @@ import qualified Language.LSP.Types.Capabilities as LSP import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.Service import Development.IDE.Core.Shake -import Development.IDE.LSP.Server import Development.IDE.Types.Location import Development.IDE.Types.Logger import Development.IDE.Types.Options diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index f6897aaa6d..3b7d3c3c7f 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -213,6 +213,7 @@ defDocumentSymbol l = DocumentSymbol { .. } where _range = realSrcSpanToRange l _selectionRange = realSrcSpanToRange l _children = Nothing + _tags = Nothing showRdrName :: RdrName -> Text showRdrName = pprText diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 6efc21c17b..778f4536bd 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -88,7 +88,7 @@ data Arguments = Arguments , argsHlsPlugins :: IdePlugins IdeState , argsGhcidePlugin :: Plugin Config -- ^ Deprecated , argsSessionLoadingOptions :: SessionLoadingOptions - , argsIdeOptions :: Maybe Config -> Action IdeGhcSession -> IdeOptions + , argsIdeOptions :: Config -> Action IdeGhcSession -> IdeOptions , argsLspOptions :: LSP.Options , argsDefaultHlsConfig :: Config , argsGetHieDbLoc :: FilePath -> IO FilePath -- ^ Map project roots to the location of the hiedb for the project @@ -142,11 +142,11 @@ defaultMain Arguments{..} = do logger <- argsLogger hSetBuffering stderr LineBuffering - let hlsPlugin = asGhcIdePlugin argsDefaultHlsConfig argsHlsPlugins + let hlsPlugin = asGhcIdePlugin argsHlsPlugins hlsCommands = allLspCmdIds' pid argsHlsPlugins plugins = hlsPlugin <> argsGhcidePlugin options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands } - argsOnConfigChange _ide = pure . getConfigFromNotification argsDefaultHlsConfig + argsOnConfigChange = getConfigFromNotification rules = argsRules >> pluginRules plugins debouncer <- argsDebouncer @@ -158,7 +158,7 @@ defaultMain Arguments{..} = do t <- offsetTime hPutStrLn stderr "Starting LSP server..." hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" - runLanguageServer options inH outH argsGetHieDbLoc argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do + runLanguageServer options inH outH argsGetHieDbLoc argsDefaultHlsConfig argsOnConfigChange (pluginHandlers plugins) $ \env vfs rootPath hiedb hieChan -> do t <- t hPutStrLn stderr $ "Started LSP server in " ++ showDuration t @@ -214,7 +214,7 @@ defaultMain Arguments{..} = do putStrLn "\nStep 3/4: Initializing the IDE" vfs <- makeVFSHandle sessionLoader <- loadSessionWithOptions argsSessionLoadingOptions dir - let options = (argsIdeOptions Nothing sessionLoader) + let options = (argsIdeOptions argsDefaultHlsConfig sessionLoader) { optCheckParents = pure NeverCheck , optCheckProject = pure False } diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index a1b54841bc..857e686c7b 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -117,7 +117,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod actions = [ mkCA title kind isPreferred [x] edit | x <- xs, (title, kind, isPreferred, tedit) <- suggestAction $ CodeActionArgs exportsMap ideOptions parsedModule text df annotatedPS tcM har bindings gblSigs x - , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing + , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing ] actions' = caRemoveRedundantImports parsedModule text diag xs uri <> actions @@ -126,7 +126,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod mkCA :: T.Text -> Maybe CodeActionKind -> Maybe Bool -> [Diagnostic] -> WorkspaceEdit -> (Command |? CodeAction) mkCA title kind isPreferred diags edit = - InR $ CodeAction title kind (Just $ List diags) isPreferred Nothing (Just edit) Nothing + InR $ CodeAction title kind (Just $ List diags) isPreferred Nothing (Just edit) Nothing Nothing suggestAction :: CodeActionArgs -> GhcideCodeActions suggestAction caa = @@ -282,6 +282,7 @@ caRemoveRedundantImports m contents digs ctxDigs uri removeSingle title tedit diagnostic = mkCA title (Just CodeActionQuickFix) Nothing [diagnostic] WorkspaceEdit{..} where _changes = Just $ Map.singleton uri $ List tedit _documentChanges = Nothing + _changeAnnotations = Nothing removeAll tedit = InR $ CodeAction{..} where _changes = Just $ Map.singleton uri $ List tedit _title = "Remove all redundant imports" @@ -292,6 +293,8 @@ caRemoveRedundantImports m contents digs ctxDigs uri _isPreferred = Nothing _command = Nothing _disabled = Nothing + _xdata = Nothing + _changeAnnotations = Nothing caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> [Diagnostic] -> Uri -> [Command |? CodeAction] caRemoveInvalidExports m contents digs ctxDigs uri @@ -328,6 +331,8 @@ caRemoveInvalidExports m contents digs ctxDigs uri _command = Nothing _isPreferred = Nothing _disabled = Nothing + _xdata = Nothing + _changeAnnotations = Nothing removeAll [] = Nothing removeAll ranges = Just $ InR $ CodeAction{..} where tedit = concatMap (\r -> [TextEdit r ""]) ranges @@ -340,6 +345,8 @@ caRemoveInvalidExports m contents digs ctxDigs uri _command = Nothing _isPreferred = Nothing _disabled = Nothing + _xdata = Nothing + _changeAnnotations = Nothing suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (T.Text, [Range]) suggestRemoveRedundantExport ParsedModule{pm_parsed_source = L _ HsModule{..}} Diagnostic{..} diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 403c318f8e..fcd8625d59 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -83,6 +83,7 @@ rewriteToWEdit dflags uri anns r = do WorkspaceEdit { _changes = Just (fromList [(uri, List edits)]) , _documentChanges = Nothing + , _changeAnnotations = Nothing } ------------------------------------------------------------------------------ diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 94cdfc6a9d..dcbe94376d 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -186,6 +186,7 @@ mkCompl _filterText = Nothing, _insertText = Just insertText, _insertTextFormat = Just Snippet, + _insertTextMode = Nothing, _textEdit = Nothing, _additionalTextEdits = Nothing, _commitCharacters = Nothing, @@ -272,13 +273,13 @@ mkModCompl :: T.Text -> CompletionItem mkModCompl label = CompletionItem label (Just CiModule) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing mkImportCompl :: T.Text -> T.Text -> CompletionItem mkImportCompl enteredQual label = CompletionItem m (Just CiModule) Nothing (Just label) Nothing Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing where m = fromMaybe "" (T.stripPrefix enteredQual label) @@ -286,13 +287,13 @@ mkExtCompl :: T.Text -> CompletionItem mkExtCompl label = CompletionItem label (Just CiKeyword) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing mkPragmaCompl :: T.Text -> T.Text -> CompletionItem mkPragmaCompl label insertText = CompletionItem label (Just CiKeyword) Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet) - Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing cacheDataProducer :: Uri -> HscEnvEq -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> IO CachedCompletions diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 1a87e36582..66d611ea14 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -20,7 +20,6 @@ import Data.Either import qualified Data.List as List import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) import qualified Data.Map as Map -import Data.Maybe (fromMaybe) import Data.String import qualified Data.Text as T import Development.IDE.Core.Shake @@ -44,12 +43,12 @@ import UnliftIO.Exception (catchAny) -- -- | Map a set of plugins to the underlying ghcide engine. -asGhcIdePlugin :: Config -> IdePlugins IdeState -> Plugin Config -asGhcIdePlugin defaultConfig mp = +asGhcIdePlugin :: IdePlugins IdeState -> Plugin Config +asGhcIdePlugin mp = mkPlugin rulesPlugins HLS.pluginRules <> mkPlugin executeCommandPlugins HLS.pluginCommands <> - mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers <> - mkPlugin (extensibleNotificationPlugins defaultConfig) HLS.pluginNotificationHandlers + mkPlugin extensiblePlugins HLS.pluginHandlers <> + mkPlugin extensibleNotificationPlugins HLS.pluginNotificationHandlers where ls = Map.toList (ipMap mp) @@ -133,8 +132,8 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd -- --------------------------------------------------------------------- -extensiblePlugins :: Config -> [(PluginId, PluginHandlers IdeState)] -> Plugin Config -extensiblePlugins defaultConfig xs = Plugin mempty handlers +extensiblePlugins :: [(PluginId, PluginHandlers IdeState)] -> Plugin Config +extensiblePlugins xs = Plugin mempty handlers where IdeHandlers handlers' = foldMap bakePluginId xs bakePluginId :: (PluginId, PluginHandlers IdeState) -> IdeHandlers @@ -144,7 +143,7 @@ extensiblePlugins defaultConfig xs = Plugin mempty handlers handlers = mconcat $ do (IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers' pure $ requestHandler m $ \ide params -> do - config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig + config <- Ide.PluginUtils.getClientConfig let fs = filter (\(pid,_) -> pluginEnabled m pid config) fs' case nonEmpty fs of Nothing -> pure $ Left $ ResponseError InvalidRequest @@ -161,8 +160,8 @@ extensiblePlugins defaultConfig xs = Plugin mempty handlers pure $ Right $ combineResponses m config caps params xs -- --------------------------------------------------------------------- -extensibleNotificationPlugins :: Config -> [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config -extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers +extensibleNotificationPlugins :: [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config +extensibleNotificationPlugins xs = Plugin mempty handlers where IdeNotificationHandlers handlers' = foldMap bakePluginId xs bakePluginId :: (PluginId, PluginNotificationHandlers IdeState) -> IdeNotificationHandlers @@ -172,7 +171,7 @@ extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers handlers = mconcat $ do (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers' pure $ notificationHandler m $ \ide params -> do - config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig + config <- Ide.PluginUtils.getClientConfig let fs = filter (\(pid,_) -> plcGlobalOn $ configForPlugin config pid) fs' case nonEmpty fs of Nothing -> do diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 196c161212..dfeed10713 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -117,7 +117,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif diag <- getDiagnostics ideState hDiag <- getHiddenDiagnostics ideState - let toWorkSpaceEdit tedit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing + let toWorkSpaceEdit tedit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing generateLensForGlobal sig@GlobalBindingTypeSig{..} = do range <- srcSpanToRange $ gbSrcSpan sig tedit <- gblBindingTypeSigToEdit sig diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 2ae56b2cca..0d33e88dff 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -344,7 +344,7 @@ toUri = fromNormalizedUri . filePathToUri' . toNormalizedFilePath' defRowToSymbolInfo :: Res DefRow -> Maybe SymbolInformation defRowToSymbolInfo (DefRow{..}:.(modInfoSrcFile -> Just srcFile)) - = Just $ SymbolInformation (showGhc defNameOcc) kind Nothing loc Nothing + = Just $ SymbolInformation (showGhc defNameOcc) kind Nothing Nothing loc Nothing where kind | isVarOcc defNameOcc = SkVariable diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index f8e39b025f..f1b39c7bcb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4286,19 +4286,20 @@ outlineTests = testGroup ] where docSymbol name kind loc = - DocumentSymbol name Nothing kind Nothing loc loc Nothing + DocumentSymbol name Nothing kind Nothing Nothing loc loc Nothing docSymbol' name kind loc selectionLoc = - DocumentSymbol name Nothing kind Nothing loc selectionLoc Nothing + DocumentSymbol name Nothing kind Nothing Nothing loc selectionLoc Nothing docSymbolD name detail kind loc = - DocumentSymbol name (Just detail) kind Nothing loc loc Nothing + DocumentSymbol name (Just detail) kind Nothing Nothing loc loc Nothing docSymbolWithChildren name kind loc cc = - DocumentSymbol name Nothing kind Nothing loc loc (Just $ List cc) + DocumentSymbol name Nothing kind Nothing Nothing loc loc (Just $ List cc) docSymbolWithChildren' name kind loc selectionLoc cc = - DocumentSymbol name Nothing kind Nothing loc selectionLoc (Just $ List cc) + DocumentSymbol name Nothing kind Nothing Nothing loc selectionLoc (Just $ List cc) moduleSymbol name loc cc = DocumentSymbol name Nothing SkFile Nothing + Nothing (R 0 0 maxBound 0) loc (Just $ List cc) @@ -4306,6 +4307,7 @@ outlineTests = testGroup (Just "class") SkInterface Nothing + Nothing loc loc (Just $ List cc) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 43a277118b..380870733b 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -391,7 +391,7 @@ test-suite func-test , lsp-types , aeson , hls-plugin-api >= 1.0 && < 1.2 - , lsp-test == 0.13.0.0 + , lsp-test == 0.14.0.0 , containers , unordered-containers diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index ef91e712e4..b3189b6f2a 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -39,7 +39,7 @@ library , containers , data-default , Diff - , lsp ^>=1.1.0 + , lsp ^>=1.2.0 , hashable , hslogger , lens diff --git a/hls-plugin-api/src/Ide/Plugin/Properties.hs b/hls-plugin-api/src/Ide/Plugin/Properties.hs index 266ea7348c..8554ec342d 100644 --- a/hls-plugin-api/src/Ide/Plugin/Properties.hs +++ b/hls-plugin-api/src/Ide/Plugin/Properties.hs @@ -215,12 +215,9 @@ useProperty :: (HasProperty s k t r) => KeyNameProxy s -> Properties r -> - Maybe A.Object -> + A.Object -> ToHsType t -useProperty kn p = - maybe - (defaultValue metadata) - (fromRight (defaultValue metadata) . usePropertyEither kn p) +useProperty kn p = fromRight (defaultValue metadata) . usePropertyEither kn p where (_, metadata) = find kn p diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index d0ae8d8132..896256df40 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -121,13 +121,13 @@ diffTextEdit fText f2Text withDeletions = J.List r diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit diffText' supports (f,fText) f2Text withDeletions = if supports - then WorkspaceEdit Nothing (Just docChanges) - else WorkspaceEdit (Just h) Nothing + then WorkspaceEdit Nothing (Just docChanges) Nothing + else WorkspaceEdit (Just h) Nothing Nothing where diff = diffTextEdit fText f2Text withDeletions h = H.singleton f diff docChanges = J.List [InL docEdit] - docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f (Just 0)) diff + docEdit = J.TextDocumentEdit (J.VersionedTextDocumentIdentifier f (Just 0)) $ fmap InL diff -- --------------------------------------------------------------------- @@ -136,7 +136,7 @@ clientSupportsDocumentChanges caps = let ClientCapabilities mwCaps _ _ _ = caps supports = do wCaps <- mwCaps - WorkspaceEditClientCapabilities mDc _ _ <- _workspaceEdit wCaps + WorkspaceEditClientCapabilities mDc _ _ _ _ <- _workspaceEdit wCaps mDc in Just True == supports @@ -152,7 +152,7 @@ pluginDescToIdePlugins plugins = IdePlugins $ Map.fromList $ map (\p -> (pluginI -- cache the returned value of this function, as clients can at runitime change -- their configuration. -- -getClientConfig :: MonadLsp Config m => m (Maybe Config) +getClientConfig :: MonadLsp Config m => m Config getClientConfig = getConfig -- --------------------------------------------------------------------- @@ -160,10 +160,10 @@ getClientConfig = getConfig -- | Returns the current plugin configuration. It is not wise to permanently -- cache the returned value of this function, as clients can change their -- configuration at runtime. -getPluginConfig :: MonadLsp Config m => PluginId -> m (Maybe PluginConfig) +getPluginConfig :: MonadLsp Config m => PluginId -> m PluginConfig getPluginConfig plugin = do config <- getClientConfig - return $ flip configForPlugin plugin <$> config + return $ flip configForPlugin plugin config -- --------------------------------------------------------------------- @@ -176,7 +176,7 @@ usePropertyLsp :: m (ToHsType t) usePropertyLsp kn pId p = do config <- getPluginConfig pId - return $ useProperty kn p $ plcConfig <$> config + return $ useProperty kn p $ plcConfig config -- --------------------------------------------------------------------- diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 4324d12817..1983b6025d 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -143,8 +143,8 @@ instance PluginMethod TextDocumentDocumentSymbol where res | supportsHierarchy = InL $ sconcat $ fmap (either id (fmap siToDs)) dsOrSi | otherwise = InR $ sconcat $ fmap (either (List . concatMap dsToSi) id) dsOrSi - siToDs (SymbolInformation name kind dep (Location _uri range) cont) - = DocumentSymbol name cont kind dep range range Nothing + siToDs (SymbolInformation name kind _tags dep (Location _uri range) cont) + = DocumentSymbol name cont kind Nothing dep range range Nothing dsToSi = go Nothing go :: Maybe T.Text -> DocumentSymbol -> [SymbolInformation] go parent ds = @@ -152,7 +152,7 @@ instance PluginMethod TextDocumentDocumentSymbol where children' = concatMap (go (Just name')) (fromMaybe mempty (ds ^. children)) loc = Location uri' (ds ^. range) name' = ds ^. name - si = SymbolInformation name' (ds ^. kind) (ds ^. deprecated) loc parent + si = SymbolInformation name' (ds ^. kind) Nothing (ds ^. deprecated) loc parent in [si] <> children' instance PluginMethod TextDocumentCompletion where diff --git a/hls-test-utils/hls-test-utils.cabal b/hls-test-utils/hls-test-utils.cabal index 8e9dc107ff..f0ec162c34 100644 --- a/hls-test-utils/hls-test-utils.cabal +++ b/hls-test-utils/hls-test-utils.cabal @@ -45,8 +45,8 @@ library , hspec , hspec-core , lens - , lsp-test ==0.13.0.0 - , lsp-types ^>=1.1 + , lsp-test ==0.14.0.0 + , lsp-types ^>=1.2 , tasty , tasty-ant-xml >=1.1.6 , tasty-expected-failure diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index 8573089847..b01a003a1d 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -66,7 +66,7 @@ codeActionSupportCaps :: C.ClientCapabilities codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } where textDocumentCaps = def { C._codeAction = Just codeActionCaps } - codeActionCaps = CodeActionClientCapabilities (Just True) (Just literalSupport) (Just True) + codeActionCaps = CodeActionClientCapabilities (Just True) (Just literalSupport) (Just True) Nothing Nothing Nothing Nothing literalSupport = CodeActionLiteralSupport def -- --------------------------------------------------------------------- diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs index 4ef1528e4a..c9e0e6c098 100644 --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -111,9 +111,9 @@ codeAction state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range title = "Add TODO Item 1" tedit = [TextEdit (Range (Position 2 0) (Position 2 0)) "-- TODO1 added by Example Plugin directly\n"] - edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing + edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing pure $ Right $ List - [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing] + [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing] -- --------------------------------------------------------------------- @@ -155,6 +155,7 @@ addTodoCmd _ide (AddTodoParams uri todoText) = do res = WorkspaceEdit (Just $ Map.singleton uri textEdits) Nothing + Nothing _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ()) return $ Right Null @@ -196,7 +197,7 @@ symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol symbols _ide _pid (DocumentSymbolParams _ _ _doc) = pure $ Right $ InL $ List [r] where - r = DocumentSymbol name detail kind deprecation range selR chList + r = DocumentSymbol name detail kind Nothing deprecation range selR chList name = "Example_symbol_name" detail = Nothing kind = SkVariable @@ -212,7 +213,7 @@ completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt) = pure $ Right $ InL $ List [r] where r = CompletionItem label kind tags detail documentation deprecated preselect - sortText filterText insertText insertTextFormat + sortText filterText insertText insertTextFormat insertTextMode textEdit additionalTextEdits commitCharacters command xd label = "Example completion" @@ -225,6 +226,7 @@ completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt) sortText = Nothing filterText = Nothing insertText = Nothing + insertTextMode = Nothing insertTextFormat = Nothing textEdit = Nothing additionalTextEdits = Nothing diff --git a/plugins/default/src/Ide/Plugin/Example2.hs b/plugins/default/src/Ide/Plugin/Example2.hs index b7f28779ce..61651c6fc8 100644 --- a/plugins/default/src/Ide/Plugin/Example2.hs +++ b/plugins/default/src/Ide/Plugin/Example2.hs @@ -107,9 +107,9 @@ codeAction _state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range title = "Add TODO2 Item" tedit = [TextEdit (Range (Position 3 0) (Position 3 0)) "-- TODO2 added by Example2 Plugin directly\n"] - edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing + edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing Nothing pure $ Right $ List - [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing ] + [ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing Nothing] -- --------------------------------------------------------------------- @@ -148,6 +148,7 @@ addTodoCmd _ide (AddTodoParams uri todoText) = do res = WorkspaceEdit (Just $ Map.singleton uri textEdits) Nothing + Nothing _ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ()) return $ Right Null @@ -189,7 +190,7 @@ symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol symbols _ide _ (DocumentSymbolParams _ _ _doc) = pure $ Right $ InL $ List [r] where - r = DocumentSymbol name detail kind deprecation range selR chList + r = DocumentSymbol name detail kind Nothing deprecation range selR chList name = "Example2_symbol_name" detail = Nothing kind = SkVariable @@ -205,7 +206,7 @@ completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt) = pure $ Right $ InL $ List [r] where r = CompletionItem label kind tags detail documentation deprecated preselect - sortText filterText insertText insertTextFormat + sortText filterText insertText insertTextFormat insertTextMode textEdit additionalTextEdits commitCharacters command xd label = "Example2 completion" @@ -218,6 +219,7 @@ completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt) sortText = Nothing filterText = Nothing insertText = Nothing + insertTextMode = Nothing insertTextFormat = Nothing textEdit = Nothing additionalTextEdits = Nothing diff --git a/plugins/default/src/Ide/Plugin/Fourmolu.hs b/plugins/default/src/Ide/Plugin/Fourmolu.hs index 9186e2a007..1855462da8 100644 --- a/plugins/default/src/Ide/Plugin/Fourmolu.hs +++ b/plugins/default/src/Ide/Plugin/Fourmolu.hs @@ -25,7 +25,7 @@ import Ide.PluginUtils (makeDiffTextEdit) import Control.Monad.IO.Class import Ide.Types -import Language.LSP.Server +import Language.LSP.Server hiding (defaultConfig) import Language.LSP.Types import Language.LSP.Types.Lens import "fourmolu" Ormolu diff --git a/plugins/default/src/Ide/Plugin/ModuleName.hs b/plugins/default/src/Ide/Plugin/ModuleName.hs index 326c9ccd4b..58ee66ccc8 100644 --- a/plugins/default/src/Ide/Plugin/ModuleName.hs +++ b/plugins/default/src/Ide/Plugin/ModuleName.hs @@ -88,7 +88,7 @@ data Action = Replace {aUri :: Uri, aRange :: Range, aTitle :: Text, aCode :: Te -- | Convert an Action to the corresponding edit operation asEdit :: Action -> WorkspaceEdit asEdit act@Replace{..} = - WorkspaceEdit (Just $ Map.singleton aUri $ List (asTextEdits act)) Nothing + WorkspaceEdit (Just $ Map.singleton aUri $ List (asTextEdits act)) Nothing Nothing asTextEdits :: Action -> [TextEdit] asTextEdits Replace{..} = [TextEdit aRange aCode] diff --git a/plugins/default/src/Ide/Plugin/Ormolu.hs b/plugins/default/src/Ide/Plugin/Ormolu.hs index e447b84062..780276188c 100644 --- a/plugins/default/src/Ide/Plugin/Ormolu.hs +++ b/plugins/default/src/Ide/Plugin/Ormolu.hs @@ -21,7 +21,7 @@ import GHC.LanguageExtensions.Type import GhcPlugins (HscEnv (hsc_dflags)) import Ide.PluginUtils import Ide.Types -import Language.LSP.Server +import Language.LSP.Server hiding (defaultConfig) import Language.LSP.Types import "ormolu" Ormolu import System.FilePath (takeFileName) diff --git a/plugins/default/src/Ide/Plugin/Pragmas.hs b/plugins/default/src/Ide/Plugin/Pragmas.hs index 75c540d2d0..9eb0a96761 100644 --- a/plugins/default/src/Ide/Plugin/Pragmas.hs +++ b/plugins/default/src/Ide/Plugin/Pragmas.hs @@ -55,7 +55,7 @@ codeActionProvider state _plId (CodeActionParams _ _ docId _ (J.CodeActionContex -- thus, not validated. pragmaEditToAction :: Uri -> Range -> PragmaEdit -> (Command |? CodeAction) pragmaEditToAction uri range (title, p) = - InR $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing Nothing (Just edit) Nothing + InR $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing Nothing (Just edit) Nothing Nothing where render (OptGHC x) = "{-# OPTIONS_GHC -Wno-" <> x <> " #-}\n" render (LangExt x) = "{-# LANGUAGE " <> x <> " #-}\n" @@ -64,6 +64,7 @@ pragmaEditToAction uri range (title, p) = J.WorkspaceEdit (Just $ H.singleton uri textEdits) Nothing + Nothing suggest :: Maybe DynFlags -> Diagnostic -> [PragmaEdit] suggest dflags diag = @@ -166,6 +167,7 @@ completion _ide _ complParams = do _filterText = Nothing, _insertText = Nothing, _insertTextFormat = Nothing, + _insertTextMode = Nothing, _textEdit = Nothing, _additionalTextEdits = Nothing, _commitCharacters = Nothing, diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs index 2ed4c2e3f9..90f45851fe 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class.hs @@ -163,10 +163,9 @@ codeAction state plId (CodeActionParams _ _ docId _ context) = liftIO $ fmap (fr mkCmdParams methodGroup = [toJSON (AddMinimalMethodsParams uri range (List methodGroup))] - mkCodeAction title + mkCodeAction title cmd = InR - . CodeAction title (Just CodeActionQuickFix) (Just (List [])) Nothing Nothing Nothing - . Just + $ CodeAction title (Just CodeActionQuickFix) (Just (List [])) Nothing Nothing Nothing (Just cmd) Nothing findClassIdentifier docPath range = do (hieAstResult, pmap) <- MaybeT . runAction "classplugin" state $ useWithStale GetHieAst docPath 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 76a968cf39..ab0cac5865 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -332,7 +332,7 @@ runEvalCmd st EvalParams{..} = tests let workspaceEditsMap = HashMap.fromList [(_uri, List $ addFinalReturn mdlText edits)] - let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing + let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing return workspaceEdits in perf "evalCmd" $ 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 a3aa1821fb..739605c5da 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -139,12 +139,14 @@ codeActionProvider ideState _pId (CodeActionParams _ _ docId range _context) _title = "Make all imports explicit" _kind = Just CodeActionQuickFix _command = Nothing - _edit = Just WorkspaceEdit {_changes, _documentChanges} + _edit = Just WorkspaceEdit {_changes, _documentChanges, _changeAnnotations} _changes = Just $ HashMap.singleton _uri $ List edits _documentChanges = Nothing _diagnostics = Nothing _isPreferred = Nothing _disabled = Nothing + _xdata = Nothing + _changeAnnotations = Nothing return $ Right $ List [caExplicitImports | not (null edits)] | otherwise = return $ Right $ List [] @@ -232,13 +234,13 @@ mkExplicitEdit posMapping (L src imp) explicit -- | Given an import declaration, generate a code lens unless it has an -- explicit import list or it's qualified generateLens :: PluginId -> Uri -> TextEdit -> IO (Maybe CodeLens) -generateLens pId uri importEdit@TextEdit {_range} = do +generateLens pId uri importEdit@TextEdit {_range, _newText} = do -- The title of the command is just the minimal explicit import decl - let title = _newText importEdit + let title = _newText -- the code lens has no extra data _xdata = Nothing -- an edit that replaces the whole declaration with the explicit one - edit = WorkspaceEdit (Just editsMap) Nothing + edit = WorkspaceEdit (Just editsMap) Nothing Nothing editsMap = HashMap.fromList [(uri, List [importEdit])] -- the command argument is simply the edit _arguments = Just [toJSON $ ImportCommandParams edit] diff --git a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs index 6ee8d0ff88..58ee2c914a 100644 --- a/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs +++ b/plugins/hls-haddock-comments-plugin/src/Ide/Plugin/HaddockComments.hs @@ -125,6 +125,9 @@ toAction title uri edit = CodeAction {..} _edit = Just WorkspaceEdit {..} _isPreferred = Nothing _disabled = Nothing + _xdata = Nothing + _changeAnnotations = Nothing + toRange :: SrcSpan -> Maybe Range toRange src diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 34a6b4b1b0..e72bf3e7eb 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -289,7 +289,7 @@ codeActionProvider ideState plId (CodeActionParams _ _ docId _ context) = Right applyAllAction = let args = Just [toJSON (docId ^. LSP.uri)] cmd = mkLspCommand plId "applyAll" "Apply all hints" args - in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionQuickFix) Nothing Nothing Nothing Nothing (Just cmd) + in LSP.CodeAction "Apply all hints" (Just LSP.CodeActionQuickFix) Nothing Nothing Nothing Nothing (Just cmd) Nothing applyOneActions :: [LSP.CodeAction] applyOneActions = mapMaybe mkHlintAction (filter validCommand diags) @@ -306,7 +306,7 @@ codeActionProvider ideState plId (CodeActionParams _ _ docId _ context) = Right mkHlintAction diag@(LSP.Diagnostic (LSP.Range start _) _s (Just (InR code)) (Just "hlint") _ _ _) = Just . codeAction $ mkLspCommand plId "applyOne" title (Just args) where - codeAction cmd = LSP.CodeAction title (Just LSP.CodeActionQuickFix) (Just (LSP.List [diag])) Nothing Nothing Nothing (Just cmd) + codeAction cmd = LSP.CodeAction title (Just LSP.CodeActionQuickFix) (Just (LSP.List [diag])) Nothing Nothing Nothing (Just cmd) Nothing -- we have to recover the original ideaHint removing the prefix ideaHint = T.replace "refact:" "" code title = "Apply hint: " <> ideaHint diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index d5690a4547..a39fd7ca54 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -203,7 +203,7 @@ provider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range ca) commands <- lift $ forM rewrites $ \(title, kind, params) -> liftIO $ do let c = mkLspCommand plId (coerce retrieCommandName) title (Just [toJSON params]) - return $ CodeAction title (Just kind) Nothing Nothing Nothing Nothing (Just c) + return $ CodeAction title (Just kind) Nothing Nothing Nothing Nothing (Just c) Nothing return $ J.List [InR c | c <- commands] @@ -430,7 +430,7 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do let (errors :: [CallRetrieError], replacements) = partitionEithers results editParams :: WorkspaceEdit editParams = - WorkspaceEdit (Just $ asEditMap replacements) Nothing + WorkspaceEdit (Just $ asEditMap replacements) Nothing Nothing return (errors, editParams) where diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index c0651de875..aefd5d270c 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -14,6 +14,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE NamedFieldPuns #-} module Ide.Plugin.Splice ( descriptor, @@ -23,7 +24,7 @@ where import Control.Applicative (Alternative ((<|>))) import Control.Arrow import qualified Control.Foldl as L -import Control.Lens (ix, view, (%~), (<&>), (^.)) +import Control.Lens (ix, view, (%~), (<&>), (^.), Identity(..)) import Control.Monad import Control.Monad.Extra (eitherM) import qualified Control.Monad.Fail as Fail @@ -238,8 +239,8 @@ setupDynFlagsForGHCiLike env dflags = do initializePlugins env dflags4 adjustToRange :: Uri -> Range -> WorkspaceEdit -> WorkspaceEdit -adjustToRange uri ran (WorkspaceEdit mhult mlt) = - WorkspaceEdit (adjustWS <$> mhult) (fmap adjustDoc <$> mlt) +adjustToRange uri ran (WorkspaceEdit mhult mlt x) = + WorkspaceEdit (adjustWS <$> mhult) (fmap adjustDoc <$> mlt) x where adjustTextEdits :: Traversable f => f TextEdit -> f TextEdit adjustTextEdits eds = @@ -248,12 +249,21 @@ adjustToRange uri ran (WorkspaceEdit mhult mlt) = (L.premap (view J.range) L.minimum) eds in adjustLine minStart <$> eds + + adjustATextEdits :: Traversable f => f (TextEdit |? AnnotatedTextEdit) -> f (TextEdit |? AnnotatedTextEdit) + adjustATextEdits = fmap $ \case + InL t -> InL $ runIdentity $ adjustTextEdits (Identity t) + InR AnnotatedTextEdit{_range, _newText, _annotationId} -> + let oldTE = TextEdit{_range,_newText} + in let TextEdit{_range,_newText} = runIdentity $ adjustTextEdits (Identity oldTE) + in InR $ AnnotatedTextEdit{_range,_newText,_annotationId} + adjustWS = ix uri %~ adjustTextEdits adjustDoc :: DocumentChange -> DocumentChange adjustDoc (InR es) = InR es adjustDoc (InL es) | es ^. J.textDocument . J.uri == uri = - InL $ es & J.edits %~ adjustTextEdits + InL $ es & J.edits %~ adjustATextEdits | otherwise = InL es adjustLine :: Range -> TextEdit -> TextEdit @@ -405,7 +415,7 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $ act = mkLspCommand plId cmdId title (Just [toJSON params]) pure $ InR $ - CodeAction title (Just CodeActionRefactorRewrite) Nothing Nothing Nothing Nothing (Just act) + CodeAction title (Just CodeActionRefactorRewrite) Nothing Nothing Nothing Nothing (Just act) Nothing pure $ maybe mempty List mcmds where diff --git a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs index 549af57716..839a0615d7 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/LanguageServer/TacticProviders.hs @@ -261,13 +261,15 @@ provide tc name TacticProviderData{..} = do $ pure $ InR $ CodeAction - title - (Just $ mkTacticKind tc) - Nothing - (Just $ tacticPreferred tc) - Nothing - Nothing - $ Just cmd + { _title = title + , _kind = Just $ mkTacticKind tc + , _diagnostics = Nothing + , _isPreferred = Just $ tacticPreferred tc + , _disabled = Nothing + , _edit = Nothing + , _command = Just cmd + , _xdata = Nothing + } ------------------------------------------------------------------------------ diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index d6839f1327..31ab4b2c52 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -32,9 +32,9 @@ extra-deps: - ghc-exactprint-0.6.3.4 - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - haddock-library-1.10.0 - heapsize-0.3.0 - hie-bios-0.7.4 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index 066ec10edc..86c93b2fbf 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -43,9 +43,9 @@ extra-deps: - temporary-1.2.1.1 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml index d489454027..897bae7d48 100644 --- a/stack-8.10.4.yaml +++ b/stack-8.10.4.yaml @@ -41,9 +41,9 @@ extra-deps: - temporary-1.2.1.1 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 834f650d24..697fbaca64 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -82,9 +82,9 @@ extra-deps: - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index 7e339016d0..b1bf7b0b2f 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -81,9 +81,9 @@ extra-deps: - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index 0f63af7611..bd89886298 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -68,9 +68,9 @@ extra-deps: - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 7c904bc293..474842cc2f 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -62,9 +62,9 @@ extra-deps: - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index 1cea93da82..a7bd128ea9 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -59,9 +59,9 @@ extra-deps: - hiedb-0.3.0.1 - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/stack.yaml b/stack.yaml index d8a8f52f68..e41adb3fcb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -83,9 +83,9 @@ extra-deps: - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-1.1.1.0 - - lsp-types-1.1.0.0 - - lsp-test-0.13.0.0 + - lsp-types-1.2.0.0 + - lsp-types-1.2.0.0 + - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 - dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 - dependent-sum-template-0.1.0.3@sha256:0bbbacdfbd3abf2a15aaf0cf2c27e5bdd159b519441fec39e1e6f2f54424adde,1682 diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 00ccc42832..a9ad77b053 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -691,7 +691,7 @@ noLiteralCaps :: C.ClientCapabilities noLiteralCaps = def { C._textDocument = Just textDocumentCaps } where textDocumentCaps = def { C._codeAction = Just codeActionCaps } - codeActionCaps = CodeActionClientCapabilities (Just True) Nothing Nothing + codeActionCaps = CodeActionClientCapabilities (Just True) Nothing Nothing Nothing Nothing Nothing Nothing testSession :: String -> Session () -> TestTree testSession name s = testCase name $ withTempDir $ \dir -> diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs index 965d30d4c1..56a7142701 100644 --- a/test/functional/Symbol.hs +++ b/test/functional/Symbol.hs @@ -21,9 +21,9 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ doc <- openDoc "Symbols.hs" "haskell" Left symbs <- getDocumentSymbols doc - let myData = DocumentSymbol "MyData" Nothing SkStruct Nothing myDataR myDataSR (Just (List [a, b])) - a = DocumentSymbol "A" Nothing SkConstructor Nothing aR aSR Nothing - b = DocumentSymbol "B" Nothing SkConstructor Nothing bR bSR Nothing + let myData = DocumentSymbol "MyData" Nothing SkStruct Nothing Nothing myDataR myDataSR (Just (List [a, b])) + a = DocumentSymbol "A" Nothing SkConstructor Nothing Nothing aR aSR Nothing + b = DocumentSymbol "B" Nothing SkConstructor Nothing Nothing bR bSR Nothing let myData' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 2 liftIO $ Just myData == myData' @? "Contains symbol" @@ -32,10 +32,10 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ doc <- openDoc "Symbols.hs" "haskell" Left symbs <- getDocumentSymbols doc - let foo = DocumentSymbol "foo" Nothing SkFunction Nothing fooR fooSR (Just (List [bar])) - bar = DocumentSymbol "bar" Nothing SkFunction Nothing barR barSR (Just (List [dog, cat])) - dog = DocumentSymbol "dog" Nothing SkVariable Nothing dogR dogSR (Just mempty) - cat = DocumentSymbol "cat" Nothing SkVariable Nothing catR catSR (Just mempty) + let foo = DocumentSymbol "foo" Nothing SkFunction Nothing Nothing fooR fooSR (Just (List [bar])) + bar = DocumentSymbol "bar" Nothing SkFunction Nothing Nothing barR barSR (Just (List [dog, cat])) + dog = DocumentSymbol "dog" Nothing SkVariable Nothing Nothing dogR dogSR (Just mempty) + cat = DocumentSymbol "cat" Nothing SkVariable Nothing Nothing catR catSR (Just mempty) let foo' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 1 liftIO $ Just foo == foo' @? "Contains symbol" @@ -45,7 +45,7 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ Left symbs <- getDocumentSymbols doc let testPattern = DocumentSymbol "TestPattern" - Nothing SkFunction Nothing testPatternR testPatternSR (Just mempty) + Nothing SkFunction Nothing Nothing testPatternR testPatternSR (Just mempty) let testPattern' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 3 liftIO $ Just testPattern == testPattern' @? "Contains symbol" @@ -54,8 +54,8 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ doc <- openDoc "Symbols.hs" "haskell" Left symbs <- getDocumentSymbols doc - let imports = DocumentSymbol "imports" Nothing SkModule Nothing importsR importsSR (Just (List [importDataMaybe])) - importDataMaybe = DocumentSymbol "import Data.Maybe" Nothing SkModule Nothing importDataMaybeR importDataMaybeSR Nothing + let imports = DocumentSymbol "imports" Nothing SkModule Nothing Nothing importsR importsSR (Just (List [importDataMaybe])) + importDataMaybe = DocumentSymbol "import Data.Maybe" Nothing SkModule Nothing Nothing importDataMaybeR importDataMaybeSR Nothing let imports' = symbs ^? ix 0 . L.children . _Just .to fromList . ix 0 liftIO $ Just imports == imports' @? "Contains symbol" @@ -67,9 +67,9 @@ pre310Tests = testGroup "pre 3.10 symbol information" [ doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell" Right symbs <- getDocumentSymbols doc - let myData = SymbolInformation "MyData" SkStruct Nothing (Location testUri myDataR) (Just "Symbols") - a = SymbolInformation "A" SkConstructor Nothing (Location testUri aR) (Just "MyData") - b = SymbolInformation "B" SkConstructor Nothing (Location testUri bR) (Just "MyData") + let myData = SymbolInformation "MyData" SkStruct Nothing Nothing (Location testUri myDataR) (Just "Symbols") + a = SymbolInformation "A" SkConstructor Nothing Nothing (Location testUri aR) (Just "MyData") + b = SymbolInformation "B" SkConstructor Nothing Nothing (Location testUri bR) (Just "MyData") liftIO $ [myData, a, b] `isInfixOf` symbs @? "Contains symbols" @@ -77,10 +77,10 @@ pre310Tests = testGroup "pre 3.10 symbol information" [ doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell" Right symbs <- getDocumentSymbols doc - let foo = SymbolInformation "foo" SkFunction Nothing (Location testUri fooR) (Just "Symbols") - bar = SymbolInformation "bar" SkFunction Nothing (Location testUri barR) (Just "foo") - dog = SymbolInformation "dog" SkVariable Nothing (Location testUri dogR) (Just "bar") - cat = SymbolInformation "cat" SkVariable Nothing (Location testUri catR) (Just "bar") + let foo = SymbolInformation "foo" SkFunction Nothing Nothing (Location testUri fooR) (Just "Symbols") + bar = SymbolInformation "bar" SkFunction Nothing Nothing (Location testUri barR) (Just "foo") + dog = SymbolInformation "dog" SkVariable Nothing Nothing (Location testUri dogR) (Just "bar") + cat = SymbolInformation "cat" SkVariable Nothing Nothing (Location testUri catR) (Just "bar") -- Order is important! liftIO $ [foo, bar, dog, cat] `isInfixOf` symbs @? "Contains symbols" @@ -90,7 +90,7 @@ pre310Tests = testGroup "pre 3.10 symbol information" [ Right symbs <- getDocumentSymbols doc let testPattern = SymbolInformation "TestPattern" - SkFunction Nothing (Location testUri testPatternR) (Just "Symbols") + SkFunction Nothing Nothing (Location testUri testPatternR) (Just "Symbols") liftIO $ testPattern `elem` symbs @? "Contains symbols" @@ -98,8 +98,8 @@ pre310Tests = testGroup "pre 3.10 symbol information" [ doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell" Right symbs <- getDocumentSymbols doc - let imports = SymbolInformation "imports" SkModule Nothing (Location testUri importsR) (Just "Symbols") - importDataMaybe = SymbolInformation "import Data.Maybe" SkModule Nothing (Location testUri importDataMaybeR) (Just "imports") + let imports = SymbolInformation "imports" SkModule Nothing Nothing (Location testUri importsR) (Just "Symbols") + importDataMaybe = SymbolInformation "import Data.Maybe" SkModule Nothing Nothing (Location testUri importDataMaybeR) (Just "imports") liftIO $ [imports, importDataMaybe] `isInfixOf` symbs @? "Contains symbol" ] From 0c551a4a35826295e85435c17177a457fe6f039f Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Sun, 28 Mar 2021 17:47:16 +0530 Subject: [PATCH 2/9] fix stack --- stack-8.10.2.yaml | 2 +- stack-8.10.3.yaml | 2 +- stack-8.10.4.yaml | 2 +- stack-8.6.4.yaml | 2 +- stack-8.6.5.yaml | 2 +- stack-8.8.2.yaml | 2 +- stack-8.8.3.yaml | 2 +- stack-8.8.4.yaml | 2 +- stack.yaml | 2 +- 9 files changed, 9 insertions(+), 9 deletions(-) diff --git a/stack-8.10.2.yaml b/stack-8.10.2.yaml index 31ab4b2c52..1d11d7019c 100644 --- a/stack-8.10.2.yaml +++ b/stack-8.10.2.yaml @@ -32,7 +32,7 @@ extra-deps: - ghc-exactprint-0.6.3.4 - ghc-lib-8.10.4.20210206 - ghc-lib-parser-8.10.4.20210206 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - haddock-library-1.10.0 diff --git a/stack-8.10.3.yaml b/stack-8.10.3.yaml index 86c93b2fbf..dbd1447991 100644 --- a/stack-8.10.3.yaml +++ b/stack-8.10.3.yaml @@ -43,7 +43,7 @@ extra-deps: - temporary-1.2.1.1 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack-8.10.4.yaml b/stack-8.10.4.yaml index 897bae7d48..d8cb1cc319 100644 --- a/stack-8.10.4.yaml +++ b/stack-8.10.4.yaml @@ -41,7 +41,7 @@ extra-deps: - temporary-1.2.1.1 - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack-8.6.4.yaml b/stack-8.6.4.yaml index 697fbaca64..6ee16c62b9 100644 --- a/stack-8.6.4.yaml +++ b/stack-8.6.4.yaml @@ -82,7 +82,7 @@ extra-deps: - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack-8.6.5.yaml b/stack-8.6.5.yaml index b1bf7b0b2f..8ba6ff4853 100644 --- a/stack-8.6.5.yaml +++ b/stack-8.6.5.yaml @@ -81,7 +81,7 @@ extra-deps: - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack-8.8.2.yaml b/stack-8.8.2.yaml index bd89886298..665746a4bd 100644 --- a/stack-8.8.2.yaml +++ b/stack-8.8.2.yaml @@ -68,7 +68,7 @@ extra-deps: - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack-8.8.3.yaml b/stack-8.8.3.yaml index 474842cc2f..9decdcf0ea 100644 --- a/stack-8.8.3.yaml +++ b/stack-8.8.3.yaml @@ -62,7 +62,7 @@ extra-deps: - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack-8.8.4.yaml b/stack-8.8.4.yaml index a7bd128ea9..b355ef7781 100644 --- a/stack-8.8.4.yaml +++ b/stack-8.8.4.yaml @@ -59,7 +59,7 @@ extra-deps: - hiedb-0.3.0.1 - sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002 - direct-sqlite-2.3.26@sha256:04e835402f1508abca383182023e4e2b9b86297b8533afbd4e57d1a5652e0c23,3718 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 diff --git a/stack.yaml b/stack.yaml index e41adb3fcb..3e681a6bcc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -83,7 +83,7 @@ extra-deps: - bytestring-encoding-0.1.0.0@sha256:460b49779fbf0112e8e2f1753c1ed9131eb18827600c298f4d6bb51c4e8c1c0d,1727 - hiedb-0.3.0.1 - extra-1.7.9@sha256:f1dec740f0f2025790c540732bfd52c556ec55bde4f5dfd7cf18e22bd44ff3d0,2683 - - lsp-types-1.2.0.0 + - lsp-1.2.0.0 - lsp-types-1.2.0.0 - lsp-test-0.14.0.0 - dependent-map-0.4.0.0@sha256:ca2b131046f4340a1c35d138c5a003fe4a5be96b14efc26291ed35fd08c62221,1657 From f85905c118330fbdb624a7e5fb14ff4edcb14a91 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Sun, 28 Mar 2021 18:51:07 +0530 Subject: [PATCH 3/9] fix splice plugin tests --- plugins/hls-splice-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-splice-plugin/test/Main.hs b/plugins/hls-splice-plugin/test/Main.hs index 78304cccd6..53cc62ed88 100644 --- a/plugins/hls-splice-plugin/test/Main.hs +++ b/plugins/hls-splice-plugin/test/Main.hs @@ -128,4 +128,4 @@ pointRange -- | Get the title of a code action. codeActionTitle :: (Command |? CodeAction) -> Maybe Text codeActionTitle InL{} = Nothing -codeActionTitle (InR(CodeAction title _ _ _ _ _ _)) = Just title +codeActionTitle (InR(CodeAction title _ _ _ _ _ _ _)) = Just title From 051adc9598c3c8d4a493c62f909ef782eaad9e42 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Sun, 28 Mar 2021 18:51:51 +0530 Subject: [PATCH 4/9] fix tactic plugin tests --- plugins/hls-tactics-plugin/test/Utils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-tactics-plugin/test/Utils.hs b/plugins/hls-tactics-plugin/test/Utils.hs index 87c0dcefb1..4dae186079 100644 --- a/plugins/hls-tactics-plugin/test/Utils.hs +++ b/plugins/hls-tactics-plugin/test/Utils.hs @@ -46,7 +46,7 @@ pointRange -- | Get the title of a code action. codeActionTitle :: (Command |? CodeAction) -> Maybe Text codeActionTitle InL{} = Nothing -codeActionTitle (InR(CodeAction title _ _ _ _ _ _)) = Just title +codeActionTitle (InR(CodeAction title _ _ _ _ _ _ _)) = Just title ------------------------------------------------------------------------------ From d54e189e77f140487fa37afec4bfc0d7f89196d3 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 31 Mar 2021 16:47:55 +0530 Subject: [PATCH 5/9] fix some tests --- ghcide/test/exe/Main.hs | 53 ++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 27 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index f1b39c7bcb..6f89cae415 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -846,7 +846,7 @@ typeWildCardActionTests = testGroup "type wildcard actions" ] doc <- createDoc "Testing.hs" "haskell" content _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10)) + actionsOrCommands <- getAllCodeActions doc let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands , "Use type signature" `T.isInfixOf` actionTitle ] @@ -866,7 +866,7 @@ typeWildCardActionTests = testGroup "type wildcard actions" ] doc <- createDoc "Testing.hs" "haskell" content _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10)) + actionsOrCommands <- getAllCodeActions doc let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands , "Use type signature" `T.isInfixOf` actionTitle ] @@ -889,7 +889,7 @@ typeWildCardActionTests = testGroup "type wildcard actions" ] doc <- createDoc "Testing.hs" "haskell" content _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 4 1) (Position 4 10)) + actionsOrCommands <- getAllCodeActions doc let [addSignature] = [action | InR action@CodeAction { _title = actionTitle } <- actionsOrCommands , "Use type signature" `T.isInfixOf` actionTitle ] @@ -1111,7 +1111,7 @@ removeImportTests = testGroup "remove import actions" doc <- createDoc "ModuleC.hs" "haskell" content _ <- waitForDiagnostics [_, _, _, _, InR action@CodeAction { _title = actionTitle }] - <- getCodeActions doc (Range (Position 2 0) (Position 2 5)) + <- nub <$> getAllCodeActions doc liftIO $ "Remove all redundant imports" @=? actionTitle executeCodeAction action contentAfterAction <- documentContents doc @@ -1149,7 +1149,7 @@ extendImportTests = testGroup "extend import actions" , "import ModuleA as A (stuffB)" , "main = print (stuffA, stuffB)" ]) - (Range (Position 3 17) (Position 3 18)) + (Range (Position 2 17) (Position 2 18)) ["Add stuffA to the import list of ModuleA"] (T.unlines [ "module ModuleB where" @@ -1169,7 +1169,7 @@ extendImportTests = testGroup "extend import actions" , "import ModuleA as A (stuffB)" , "main = print (stuffB .* stuffB)" ]) - (Range (Position 3 17) (Position 3 18)) + (Range (Position 2 17) (Position 2 18)) ["Add (.*) to the import list of ModuleA"] (T.unlines [ "module ModuleB where" @@ -1206,7 +1206,7 @@ extendImportTests = testGroup "extend import actions" , "b :: A" , "b = Constructor" ]) - (Range (Position 2 5) (Position 2 5)) + (Range (Position 3 5) (Position 3 5)) ["Add A(Constructor) to the import list of ModuleA"] (T.unlines [ "module ModuleB where" @@ -1225,7 +1225,7 @@ extendImportTests = testGroup "extend import actions" , "b :: A" , "b = Constructor" ]) - (Range (Position 2 5) (Position 2 5)) + (Range (Position 3 5) (Position 3 5)) ["Add A(Constructor) to the import list of ModuleA"] (T.unlines [ "module ModuleB where" @@ -1245,7 +1245,7 @@ extendImportTests = testGroup "extend import actions" , "b :: A" , "b = ConstructorFoo" ]) - (Range (Position 2 5) (Position 2 5)) + (Range (Position 3 5) (Position 3 5)) ["Add A(ConstructorFoo) to the import list of ModuleA"] (T.unlines [ "module ModuleB where" @@ -1266,7 +1266,7 @@ extendImportTests = testGroup "extend import actions" , "import qualified ModuleA as A (stuffB)" , "main = print (A.stuffA, A.stuffB)" ]) - (Range (Position 3 17) (Position 3 18)) + (Range (Position 2 17) (Position 2 18)) ["Add stuffA to the import list of ModuleA"] (T.unlines [ "module ModuleB where" @@ -1682,9 +1682,7 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti doc <- openDoc file "haskell" waitForProgressDone void $ expectDiagnostics [(file, [(DsError, loc, "Ambiguous occurrence") | loc <- locs])] - contents <- documentContents doc - let range = Range (Position 0 0) (Position (length $ T.lines contents) 0) - actions <- getCodeActions doc range + actions <- getAllCodeActions doc k doc actions withHideFunction = withTarget ("HideFunction" <.> "hs") @@ -1891,7 +1889,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions" _ <- waitForDiagnostics InR action@CodeAction { _title = actionTitle } : _ <- sortOn (\(InR CodeAction{_title=x}) -> x) <$> - getCodeActions docB (R 1 0 1 50) + getCodeActions docB (R 0 0 0 50) liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool" executeCodeAction action contentAfterAction <- documentContents docB @@ -1915,7 +1913,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions" _ <- waitForDiagnostics InR action@CodeAction { _title = actionTitle } : _ <- sortOn (\(InR CodeAction{_title=x}) -> x) <$> - getCodeActions docB (R 1 0 1 50) + getCodeActions docB (R 0 0 0 50) liftIO $ actionTitle @?= "Define select :: [Bool] -> Bool" executeCodeAction action contentAfterAction <- documentContents docB @@ -2063,15 +2061,15 @@ deleteUnusedDefinitionTests = testGroup "delete unused definition action" docId <- createDoc "A.hs" "haskell" source expectDiagnostics [ ("A.hs", [(DsWarning, pos, "not used")]) ] - (action, title) <- extractCodeAction docId "Delete" + (action, title) <- extractCodeAction docId "Delete" pos liftIO $ title @?= expectedTitle executeCodeAction action contentAfterAction <- documentContents docId liftIO $ contentAfterAction @?= expectedResult - extractCodeAction docId actionPrefix = do - [action@CodeAction { _title = actionTitle }] <- findCodeActionsByPrefix docId (R 0 0 0 0) [actionPrefix] + extractCodeAction docId actionPrefix (l, c) = do + [action@CodeAction { _title = actionTitle }] <- findCodeActionsByPrefix docId (R l c l c) [actionPrefix] return (action, actionTitle) addTypeAnnotationsToLiteralsTest :: TestTree @@ -2196,15 +2194,16 @@ addTypeAnnotationsToLiteralsTest = testGroup "add type annotations to literals t docId <- createDoc "A.hs" "haskell" source expectDiagnostics [ ("A.hs", diag) ] - (action, title) <- extractCodeAction docId "Add type annotation" + let cursors = map snd3 diag + (action, title) <- extractCodeAction docId "Add type annotation" (minimum cursors) (maximum cursors) liftIO $ title @?= expectedTitle executeCodeAction action contentAfterAction <- documentContents docId liftIO $ contentAfterAction @?= expectedResult - extractCodeAction docId actionPrefix = do - [action@CodeAction { _title = actionTitle }] <- findCodeActionsByPrefix docId (R 0 0 0 0) [actionPrefix] + extractCodeAction docId actionPrefix (l,c) (l', c')= do + [action@CodeAction { _title = actionTitle }] <- findCodeActionsByPrefix docId (R l c l' c') [actionPrefix] return (action, actionTitle) @@ -2250,7 +2249,7 @@ importRenameActionTests = testGroup "import rename actions" ] doc <- createDoc "Testing.hs" "haskell" content _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 2 8) (Position 2 16)) + actionsOrCommands <- getCodeActions doc (Range (Position 1 8) (Position 1 16)) let [changeToMap] = [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, ("Data." <> modname) `T.isInfixOf` actionTitle ] executeCodeAction changeToMap contentAfterAction <- documentContents doc @@ -2380,7 +2379,7 @@ addInstanceConstraintTests = let check actionTitle originalCode expectedCode = testSession (T.unpack actionTitle) $ do doc <- createDoc "Testing.hs" "haskell" originalCode _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 6 0) (Position 6 68)) + actionsOrCommands <- getAllCodeActions doc chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands executeCodeAction chosenAction modifiedCode <- documentContents doc @@ -2532,7 +2531,7 @@ checkCodeAction :: String -> T.Text -> T.Text -> T.Text -> TestTree checkCodeAction testName actionTitle originalCode expectedCode = testSession testName $ do doc <- createDoc "Testing.hs" "haskell" originalCode _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 6 0) (Position 6 maxBound)) + actionsOrCommands <- getAllCodeActions doc chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands executeCodeAction chosenAction modifiedCode <- documentContents doc @@ -2615,7 +2614,7 @@ removeRedundantConstraintsTests = let check actionTitle originalCode expectedCode = testSession (T.unpack actionTitle) $ do doc <- createDoc "Testing.hs" "haskell" originalCode _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 4 0) (Position 4 maxBound)) + actionsOrCommands <- getAllCodeActions doc chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands executeCodeAction chosenAction modifiedCode <- documentContents doc @@ -2625,7 +2624,7 @@ removeRedundantConstraintsTests = let checkPeculiarFormatting title code = testSession title $ do doc <- createDoc "Testing.hs" "haskell" code _ <- waitForDiagnostics - actionsOrCommands <- getCodeActions doc (Range (Position 4 0) (Position 4 maxBound)) + actionsOrCommands <- getAllCodeActions doc liftIO $ assertBool "Found some actions" (null actionsOrCommands) in testGroup "remove redundant function constraints" @@ -2769,7 +2768,7 @@ exportUnusedTests = testGroup "export unused actions" , " ) where" , "foo = id" , "bar = foo"]) - (R 4 0 4 3) + (R 5 0 5 3) "Export ‘bar’" (Just $ T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" From ad6f77f473f53a39cc44117113240d13dd045c61 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 31 Mar 2021 17:11:18 +0530 Subject: [PATCH 6/9] fix some tests --- ghcide/test/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 6f89cae415..11d6ae9456 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4862,7 +4862,7 @@ asyncTests = testGroup "async" , "foo = id" ] void waitForDiagnostics - actions <- getCodeActions doc (Range (Position 0 0) (Position 0 0)) + actions <- getCodeActions doc (Range (Position 1 0) (Position 1 0)) liftIO $ [ _title | InR CodeAction{_title} <- actions] @=? [ "add signature: foo :: a -> a" ] ] From e0c9a0a2b6801b956d53c36385758df1d5c896a6 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 31 Mar 2021 17:33:54 +0530 Subject: [PATCH 7/9] fix outline tests --- ghcide/src/Development/IDE/LSP/Outline.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 3b7d3c3c7f..046c0c9339 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -19,7 +19,7 @@ import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat -import Development.IDE.GHC.Error (realSrcSpanToRange) +import Development.IDE.GHC.Error (realSrcSpanToRange, rangeToRealSrcSpan) import Development.IDE.Types.Location import Language.LSP.Server (LspM) import Language.LSP.Types @@ -183,12 +183,10 @@ documentSymbolForImportSummary importSymbols = mergeRanges xs = Range (minimum $ map _start xs) (maximum $ map _end xs) importRange = mergeRanges $ map (_range :: DocumentSymbol -> Range) importSymbols in - Just (defDocumentSymbol empty :: DocumentSymbol) + Just (defDocumentSymbol (rangeToRealSrcSpan "" importRange)) { _name = "imports" , _kind = SkModule , _children = Just (List importSymbols) - , _range = importRange - , _selectionRange = importRange } documentSymbolForImport :: Located (ImportDecl GhcPs) -> Maybe DocumentSymbol From b15539db74c28cfad1b1ce41ed2d7d8b2d71009e Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 31 Mar 2021 18:45:06 +0530 Subject: [PATCH 8/9] hlint --- ghcide/test/exe/Main.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 11d6ae9456..28081dbb65 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -906,6 +906,7 @@ typeWildCardActionTests = testGroup "type wildcard actions" liftIO $ expectedContentAfterAction @=? contentAfterAction ] +{-# HLINT ignore "Use nubOrd" #-} removeImportTests :: TestTree removeImportTests = testGroup "remove import actions" [ testSession "redundant" $ do From 9e80039b2898c9631a59817fff2d4edd6fe29540 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 1 Apr 2021 00:59:09 +0530 Subject: [PATCH 9/9] fix func-test --- test/functional/FunctionalCodeAction.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index a9ad77b053..6e706973dd 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -624,7 +624,7 @@ disableWarningTests = <&> \(warning, initialContent, expectedContent) -> testSession (T.unpack warning) $ do doc <- createDoc "Module.hs" "haskell" initialContent _ <- waitForDiagnostics - codeActs <- mapMaybe caResultToCodeAct <$> getCodeActions doc (Range (Position 0 0) (Position 0 0)) + codeActs <- mapMaybe caResultToCodeAct <$> getAllCodeActions doc case find (\CodeAction{_title} -> _title == "Disable \"" <> warning <> "\" warnings") codeActs of Nothing -> liftIO $ assertFailure "No code action with expected title" Just action -> do