diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index aab13448f4..0881c605c8 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -35,7 +35,7 @@ import Development.Shake import Development.Shake.Classes import GHC.Exts (toList) import GHC.Generics -import Ide.Plugin.Config (Config (completionSnippetsOn)) +import Ide.Plugin.Config (Config) import Ide.Types import qualified Language.LSP.Server as LSP import Language.LSP.Types @@ -47,6 +47,7 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginRules = produceCompletions , pluginHandlers = mkPluginHandler STextDocumentCompletion getCompletionsLSP , pluginCommands = [extendImportCommand] + , pluginCustomConfig = mkCustomConfig properties } produceCompletions :: Rules () @@ -135,9 +136,8 @@ getCompletionsLSP ide plId -> return (InL $ List []) (Just pfix', _) -> do let clientCaps = clientCapabilities $ shakeExtras ide - config <- getClientConfig $ shakeExtras ide - let snippets = WithSnippets . completionSnippetsOn $ config - allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps snippets + config <- getCompletionsConfig plId + allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config pure $ InL (List allCompletions) _ -> return (InL $ List []) _ -> return (InL $ List []) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 06d0c4b028..94cdfc6a9d 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -9,7 +9,6 @@ module Development.IDE.Plugin.Completions.Logic ( CachedCompletions , cacheDataProducer , localCompletionsForParsedModule -, WithSnippets(..) , getCompletions ) where @@ -56,8 +55,7 @@ import Development.IDE.Types.Options import GhcPlugins (flLabel, unpackFS) import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandId (..), - PluginId, - WithSnippets (..)) + PluginId) import Language.LSP.Types import Language.LSP.Types.Capabilities import qualified Language.LSP.VFS as VFS @@ -465,13 +463,17 @@ findRecordCompl _ _ _ _ = [] ppr :: Outputable a => a -> T.Text ppr = T.pack . prettyPrint -toggleSnippets :: ClientCapabilities -> WithSnippets -> CompletionItem -> CompletionItem -toggleSnippets ClientCapabilities {_textDocument} (WithSnippets with) = +toggleSnippets :: ClientCapabilities -> CompletionsConfig -> CompletionItem -> CompletionItem +toggleSnippets ClientCapabilities {_textDocument} (CompletionsConfig with _) = removeSnippetsWhen (not $ with && supported) where supported = Just True == (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport) +toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem +toggleAutoExtend (CompletionsConfig _ False) x = x {additionalTextEdits = Nothing} +toggleAutoExtend _ x = x + removeSnippetsWhen :: Bool -> CompletionItem -> CompletionItem removeSnippetsWhen condition x = if condition @@ -491,10 +493,10 @@ getCompletions -> (Bindings, PositionMapping) -> VFS.PosPrefixInfo -> ClientCapabilities - -> WithSnippets + -> CompletionsConfig -> IO [CompletionItem] getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, importableModules} - maybe_parsed (localBindings, bmapping) prefixInfo caps withSnippets = do + maybe_parsed (localBindings, bmapping) prefixInfo caps config = do let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo enteredQual = if T.null prefixModule then "" else prefixModule <> "." fullPrefix = enteredQual <> prefixText @@ -530,7 +532,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor Just ValueContext -> filter (not . isTypeCompl) compls Just _ -> filter (not . isTypeCompl) compls -- Add whether the text to insert has backticks - ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls' + ctxCompls = map (\comp -> toggleAutoExtend config $ comp { isInfix = infixCompls }) ctxCompls' infixCompls :: Maybe Backtick infixCompls = isUsedAsInfix fullLine prefixModule prefixText pos @@ -562,7 +564,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor ] filtListWithSnippet f list suffix = - [ toggleSnippets caps withSnippets (f label (snippet <> suffix)) + [ toggleSnippets caps config (f label (snippet <> suffix)) | (snippet, label) <- list , Fuzzy.test fullPrefix label ] @@ -596,7 +598,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls return $ filtModNameCompls ++ filtKeywordCompls - ++ map ( toggleSnippets caps withSnippets) compls + ++ map (toggleSnippets caps config) compls -- --------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 3f9c26b154..59ed71bedc 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedLabels #-} module Development.IDE.Plugin.Completions.Types ( module Development.IDE.Plugin.Completions.Types ) where @@ -13,6 +15,11 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import Development.IDE.Spans.Common import GHC.Generics (Generic) +import Ide.Plugin.Config (Config) +import Ide.Plugin.Properties +import Ide.PluginUtils (usePropertyLsp) +import Ide.Types (PluginId) +import Language.LSP.Server (MonadLsp) import Language.LSP.Types (CompletionItemKind, Uri) -- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs @@ -23,6 +30,29 @@ data Backtick = Surrounded | LeftSide extendImportCommandId :: Text extendImportCommandId = "extendImport" +properties :: Properties + '[ 'PropertyKey "autoExtendOn" 'TBoolean, + 'PropertyKey "snippetsOn" 'TBoolean] +properties = emptyProperties + & defineBooleanProperty #snippetsOn + "Inserts snippets when using code completions" + True + & defineBooleanProperty #autoExtendOn + "Extends the import list automatically when completing a out-of-scope identifier" + True + +getCompletionsConfig :: (MonadLsp Config m) => PluginId -> m CompletionsConfig +getCompletionsConfig pId = + CompletionsConfig + <$> usePropertyLsp #snippetsOn pId properties + <*> usePropertyLsp #autoExtendOn pId properties + + +data CompletionsConfig = CompletionsConfig { + enableSnippets :: Bool, + enableAutoExtend :: Bool +} + data ExtendImport = ExtendImport { doc :: !Uri, newThing :: !T.Text, diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 888ea7e6cf..150ecaf683 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -54,7 +54,6 @@ data Config = , diagnosticsOnChange :: !Bool , diagnosticsDebounceDuration :: !Int , liquidOn :: !Bool - , completionSnippetsOn :: !Bool , formatOnImportOn :: !Bool , formattingProvider :: !T.Text , maxCompletions :: !Int @@ -69,7 +68,6 @@ instance Default Config where , diagnosticsOnChange = True , diagnosticsDebounceDuration = 350000 , liquidOn = False - , completionSnippetsOn = True , formatOnImportOn = True -- , formattingProvider = "brittany" , formattingProvider = "ormolu" @@ -94,7 +92,6 @@ parseConfig defValue = A.withObject "Config" $ \v -> do <*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange defValue <*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration defValue <*> o .:? "liquidOn" .!= liquidOn defValue - <*> o .:? "completionSnippetsOn" .!= completionSnippetsOn defValue <*> o .:? "formatOnImportOn" .!= formatOnImportOn defValue <*> o .:? "formattingProvider" .!= formattingProvider defValue <*> o .:? "maxCompletions" .!= maxCompletions defValue @@ -110,7 +107,6 @@ instance A.ToJSON Config where , "diagnosticsOnChange" .= diagnosticsOnChange , "diagnosticsDebounceDuration" .= diagnosticsDebounceDuration , "liquidOn" .= liquidOn - , "completionSnippetsOn" .= completionSnippetsOn , "formatOnImportOn" .= formatOnImportOn , "formattingProvider" .= formattingProvider , "maxCompletions" .= maxCompletions diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 10703c5a8e..4324d12817 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -288,8 +288,6 @@ type CommandFunction ideState a -> a -> LspM Config (Either ResponseError Value) -newtype WithSnippets = WithSnippets Bool - -- --------------------------------------------------------------------- newtype PluginId = PluginId T.Text diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 2e665ce995..d6deab2065 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -328,7 +328,7 @@ snippetTests = testGroup "snippets" [ , testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Completion.hs" "haskell" - let config = object [ "haskell" .= object ["completionSnippetsOn" .= False]] + let config = object ["haskell" .= object ["plugin" .= object ["ghcide-completions" .= object ["config" .= object ["snippetsOn" .= False]]]]] sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams config)