Skip to content

Commit 75e365a

Browse files
berbermanberberman
authored
Use custom config for completions plugin (#1619)
1 parent a4e22db commit 75e365a

File tree

6 files changed

+47
-21
lines changed

6 files changed

+47
-21
lines changed

‎ghcide/src/Development/IDE/Plugin/Completions.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ import Development.Shake
3535
import Development.Shake.Classes
3636
import GHC.Exts (toList)
3737
import GHC.Generics
38-
import Ide.Plugin.Config (Config (completionSnippetsOn))
38+
import Ide.Plugin.Config (Config)
3939
import Ide.Types
4040
import qualified Language.LSP.Server as LSP
4141
import Language.LSP.Types
@@ -47,6 +47,7 @@ descriptor plId = (defaultPluginDescriptor plId)
4747
{ pluginRules = produceCompletions
4848
, pluginHandlers = mkPluginHandler STextDocumentCompletion getCompletionsLSP
4949
, pluginCommands = [extendImportCommand]
50+
, pluginCustomConfig = mkCustomConfig properties
5051
}
5152

5253
produceCompletions :: Rules ()
@@ -135,9 +136,8 @@ getCompletionsLSP ide plId
135136
-> return (InL $ List [])
136137
(Just pfix', _) -> do
137138
let clientCaps = clientCapabilities $ shakeExtras ide
138-
config <- getClientConfig $ shakeExtras ide
139-
let snippets = WithSnippets . completionSnippetsOn $ config
140-
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps snippets
139+
config <- getCompletionsConfig plId
140+
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps config
141141
pure $ InL (List allCompletions)
142142
_ -> return (InL $ List [])
143143
_ -> return (InL $ List [])

‎ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ module Development.IDE.Plugin.Completions.Logic (
99
CachedCompletions
1010
, cacheDataProducer
1111
, localCompletionsForParsedModule
12-
, WithSnippets(..)
1312
, getCompletions
1413
) where
1514

@@ -56,8 +55,7 @@ import Development.IDE.Types.Options
5655
import GhcPlugins (flLabel, unpackFS)
5756
import Ide.PluginUtils (mkLspCommand)
5857
import Ide.Types (CommandId (..),
59-
PluginId,
60-
WithSnippets (..))
58+
PluginId)
6159
import Language.LSP.Types
6260
import Language.LSP.Types.Capabilities
6361
import qualified Language.LSP.VFS as VFS
@@ -465,13 +463,17 @@ findRecordCompl _ _ _ _ = []
465463
ppr :: Outputable a => a -> T.Text
466464
ppr = T.pack . prettyPrint
467465

468-
toggleSnippets :: ClientCapabilities -> WithSnippets -> CompletionItem -> CompletionItem
469-
toggleSnippets ClientCapabilities {_textDocument} (WithSnippets with) =
466+
toggleSnippets :: ClientCapabilities -> CompletionsConfig -> CompletionItem -> CompletionItem
467+
toggleSnippets ClientCapabilities {_textDocument} (CompletionsConfig with _) =
470468
removeSnippetsWhen (not $ with && supported)
471469
where
472470
supported =
473471
Just True == (_textDocument >>= _completion >>= _completionItem >>= _snippetSupport)
474472

473+
toggleAutoExtend :: CompletionsConfig -> CompItem -> CompItem
474+
toggleAutoExtend (CompletionsConfig _ False) x = x {additionalTextEdits = Nothing}
475+
toggleAutoExtend _ x = x
476+
475477
removeSnippetsWhen :: Bool -> CompletionItem -> CompletionItem
476478
removeSnippetsWhen condition x =
477479
if condition
@@ -491,10 +493,10 @@ getCompletions
491493
-> (Bindings, PositionMapping)
492494
-> VFS.PosPrefixInfo
493495
-> ClientCapabilities
494-
-> WithSnippets
496+
-> CompletionsConfig
495497
-> IO [CompletionItem]
496498
getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, importableModules}
497-
maybe_parsed (localBindings, bmapping) prefixInfo caps withSnippets = do
499+
maybe_parsed (localBindings, bmapping) prefixInfo caps config = do
498500
let VFS.PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
499501
enteredQual = if T.null prefixModule then "" else prefixModule <> "."
500502
fullPrefix = enteredQual <> prefixText
@@ -530,7 +532,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
530532
Just ValueContext -> filter (not . isTypeCompl) compls
531533
Just _ -> filter (not . isTypeCompl) compls
532534
-- Add whether the text to insert has backticks
533-
ctxCompls = map (\comp -> comp { isInfix = infixCompls }) ctxCompls'
535+
ctxCompls = map (\comp -> toggleAutoExtend config $ comp { isInfix = infixCompls }) ctxCompls'
534536

535537
infixCompls :: Maybe Backtick
536538
infixCompls = isUsedAsInfix fullLine prefixModule prefixText pos
@@ -562,7 +564,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
562564
]
563565

564566
filtListWithSnippet f list suffix =
565-
[ toggleSnippets caps withSnippets (f label (snippet <> suffix))
567+
[ toggleSnippets caps config (f label (snippet <> suffix))
566568
| (snippet, label) <- list
567569
, Fuzzy.test fullPrefix label
568570
]
@@ -596,7 +598,7 @@ getCompletions plId ideOpts CC {allModNamesAsNS, unqualCompls, qualCompls, impor
596598
compls <- mapM (mkCompl plId ideOpts) uniqueFiltCompls
597599
return $ filtModNameCompls
598600
++ filtKeywordCompls
599-
++ map ( toggleSnippets caps withSnippets) compls
601+
++ map (toggleSnippets caps config) compls
600602

601603

602604
-- ---------------------------------------------------------------------

‎ghcide/src/Development/IDE/Plugin/Completions/Types.hs

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
{-# LANGUAGE DeriveAnyClass #-}
22
{-# LANGUAGE DerivingStrategies #-}
3+
{-# LANGUAGE GADTs #-}
4+
{-# LANGUAGE OverloadedLabels #-}
35
module Development.IDE.Plugin.Completions.Types (
46
module Development.IDE.Plugin.Completions.Types
57
) where
@@ -13,6 +15,11 @@ import Data.Aeson (FromJSON, ToJSON)
1315
import Data.Text (Text)
1416
import Development.IDE.Spans.Common
1517
import GHC.Generics (Generic)
18+
import Ide.Plugin.Config (Config)
19+
import Ide.Plugin.Properties
20+
import Ide.PluginUtils (usePropertyLsp)
21+
import Ide.Types (PluginId)
22+
import Language.LSP.Server (MonadLsp)
1623
import Language.LSP.Types (CompletionItemKind, Uri)
1724

1825
-- From haskell-ide-engine/src/Haskell/Ide/Engine/LSP/Completions.hs
@@ -23,6 +30,29 @@ data Backtick = Surrounded | LeftSide
2330
extendImportCommandId :: Text
2431
extendImportCommandId = "extendImport"
2532

33+
properties :: Properties
34+
'[ 'PropertyKey "autoExtendOn" 'TBoolean,
35+
'PropertyKey "snippetsOn" 'TBoolean]
36+
properties = emptyProperties
37+
& defineBooleanProperty #snippetsOn
38+
"Inserts snippets when using code completions"
39+
True
40+
& defineBooleanProperty #autoExtendOn
41+
"Extends the import list automatically when completing a out-of-scope identifier"
42+
True
43+
44+
getCompletionsConfig :: (MonadLsp Config m) => PluginId -> m CompletionsConfig
45+
getCompletionsConfig pId =
46+
CompletionsConfig
47+
<$> usePropertyLsp #snippetsOn pId properties
48+
<*> usePropertyLsp #autoExtendOn pId properties
49+
50+
51+
data CompletionsConfig = CompletionsConfig {
52+
enableSnippets :: Bool,
53+
enableAutoExtend :: Bool
54+
}
55+
2656
data ExtendImport = ExtendImport
2757
{ doc :: !Uri,
2858
newThing :: !T.Text,

‎hls-plugin-api/src/Ide/Plugin/Config.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,6 @@ data Config =
5454
, diagnosticsOnChange :: !Bool
5555
, diagnosticsDebounceDuration :: !Int
5656
, liquidOn :: !Bool
57-
, completionSnippetsOn :: !Bool
5857
, formatOnImportOn :: !Bool
5958
, formattingProvider :: !T.Text
6059
, maxCompletions :: !Int
@@ -69,7 +68,6 @@ instance Default Config where
6968
, diagnosticsOnChange = True
7069
, diagnosticsDebounceDuration = 350000
7170
, liquidOn = False
72-
, completionSnippetsOn = True
7371
, formatOnImportOn = True
7472
-- , formattingProvider = "brittany"
7573
, formattingProvider = "ormolu"
@@ -94,7 +92,6 @@ parseConfig defValue = A.withObject "Config" $ \v -> do
9492
<*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange defValue
9593
<*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration defValue
9694
<*> o .:? "liquidOn" .!= liquidOn defValue
97-
<*> o .:? "completionSnippetsOn" .!= completionSnippetsOn defValue
9895
<*> o .:? "formatOnImportOn" .!= formatOnImportOn defValue
9996
<*> o .:? "formattingProvider" .!= formattingProvider defValue
10097
<*> o .:? "maxCompletions" .!= maxCompletions defValue
@@ -110,7 +107,6 @@ instance A.ToJSON Config where
110107
, "diagnosticsOnChange" .= diagnosticsOnChange
111108
, "diagnosticsDebounceDuration" .= diagnosticsDebounceDuration
112109
, "liquidOn" .= liquidOn
113-
, "completionSnippetsOn" .= completionSnippetsOn
114110
, "formatOnImportOn" .= formatOnImportOn
115111
, "formattingProvider" .= formattingProvider
116112
, "maxCompletions" .= maxCompletions

‎hls-plugin-api/src/Ide/Types.hs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -288,8 +288,6 @@ type CommandFunction ideState a
288288
-> a
289289
-> LspM Config (Either ResponseError Value)
290290

291-
newtype WithSnippets = WithSnippets Bool
292-
293291
-- ---------------------------------------------------------------------
294292

295293
newtype PluginId = PluginId T.Text

‎test/functional/Completion.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -328,7 +328,7 @@ snippetTests = testGroup "snippets" [
328328
, testCase "respects lsp configuration" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
329329
doc <- openDoc "Completion.hs" "haskell"
330330

331-
let config = object [ "haskell" .= object ["completionSnippetsOn" .= False]]
331+
let config = object ["haskell" .= object ["plugin" .= object ["ghcide-completions" .= object ["config" .= object ["snippetsOn" .= False]]]]]
332332

333333
sendNotification SWorkspaceDidChangeConfiguration
334334
(DidChangeConfigurationParams config)

0 commit comments

Comments
 (0)