Skip to content

Commit 98d9e74

Browse files
alexnaspoalexnaspoleapjneira
authored
Move pragmas completion to pragmas plugin (#2134)
* Move pragmas completion to pragmas plugin * update pragmas plugin tests * move options pragmas to pragmas plugin return empty list from logic completions when opts or pragma start fix empty list logic Co-authored-by: Alex Naspo <[email protected]> Co-authored-by: Javier Neira <[email protected]>
1 parent c914c35 commit 98d9e74

File tree

3 files changed

+58
-51
lines changed

3 files changed

+58
-51
lines changed

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

+2-47
Original file line numberDiff line numberDiff line change
@@ -299,11 +299,6 @@ mkExtCompl label =
299299
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
300300
Nothing Nothing Nothing Nothing Nothing Nothing
301301

302-
mkPragmaCompl :: T.Text -> T.Text -> CompletionItem
303-
mkPragmaCompl label insertText =
304-
CompletionItem label (Just CiKeyword) Nothing Nothing
305-
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
306-
Nothing Nothing Nothing Nothing Nothing Nothing
307302

308303
fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem
309304
fromIdentInfo doc IdentInfo{..} q = CI
@@ -600,36 +595,19 @@ getCompletions plId ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, qu
600595
, enteredQual `T.isPrefixOf` label
601596
]
602597

603-
filtListWithSnippet f list suffix =
604-
[ toggleSnippets caps config (f label (snippet <> suffix))
605-
| (snippet, label) <- list
606-
, Fuzzy.test fullPrefix label
607-
]
608-
609598
filtImportCompls = filtListWith (mkImportCompl enteredQual) importableModules
610-
filtPragmaCompls = filtListWithSnippet mkPragmaCompl validPragmas
611-
filtOptsCompls = filtListWith mkExtCompl
612599
filtKeywordCompls
613600
| T.null prefixModule = filtListWith mkExtCompl (optKeywords ideOpts)
614601
| otherwise = []
615602

616-
stripLeading :: Char -> String -> String
617-
stripLeading _ [] = []
618-
stripLeading c (s:ss)
619-
| s == c = ss
620-
| otherwise = s:ss
621603

622604
if
623605
| "import " `T.isPrefixOf` fullLine
624606
-> return filtImportCompls
625607
-- we leave this condition here to avoid duplications and return empty list
626-
-- since HLS implements this completion (#haskell-language-server/pull/662)
627-
| "{-# language" `T.isPrefixOf` T.toLower fullLine
628-
-> return []
629-
| "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine
630-
-> return $ filtOptsCompls (map (T.pack . stripLeading '-') $ flagsForCompletion False)
608+
-- since HLS implements these completions (#haskell-language-server/pull/662)
631609
| "{-# " `T.isPrefixOf` fullLine
632-
-> return $ filtPragmaCompls (pragmaSuffix fullLine)
610+
-> return []
633611
| otherwise -> do
634612
-- assumes that nubOrdBy is stable
635613
let uniqueFiltCompls = nubOrdBy uniqueCompl filtCompls
@@ -651,29 +629,6 @@ uniqueCompl x y =
651629
then EQ
652630
else compare (insertText x) (insertText y)
653631
other -> other
654-
-- ---------------------------------------------------------------------
655-
-- helper functions for pragmas
656-
-- ---------------------------------------------------------------------
657-
658-
validPragmas :: [(T.Text, T.Text)]
659-
validPragmas =
660-
[ ("LANGUAGE ${1:extension}" , "LANGUAGE")
661-
, ("OPTIONS_GHC -${1:option}" , "OPTIONS_GHC")
662-
, ("INLINE ${1:function}" , "INLINE")
663-
, ("NOINLINE ${1:function}" , "NOINLINE")
664-
, ("INLINABLE ${1:function}" , "INLINABLE")
665-
, ("WARNING ${1:message}" , "WARNING")
666-
, ("DEPRECATED ${1:message}" , "DEPRECATED")
667-
, ("ANN ${1:annotation}" , "ANN")
668-
, ("RULES" , "RULES")
669-
, ("SPECIALIZE ${1:function}" , "SPECIALIZE")
670-
, ("SPECIALIZE INLINE ${1:function}", "SPECIALIZE INLINE")
671-
]
672-
673-
pragmaSuffix :: T.Text -> T.Text
674-
pragmaSuffix fullLine
675-
| "}" `T.isSuffixOf` fullLine = mempty
676-
| otherwise = " #-}"
677632

678633
-- ---------------------------------------------------------------------
679634
-- helper functions for infix backticks

‎plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs

+51-1
Original file line numberDiff line numberDiff line change
@@ -150,6 +150,9 @@ allPragmas =
150150

151151
-- ---------------------------------------------------------------------
152152

153+
flags :: [T.Text]
154+
flags = map (T.pack . stripLeading '-') $ flagsForCompletion False
155+
153156
completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion
154157
completion _ide _ complParams = do
155158
let (J.TextDocumentIdentifier uri) = complParams ^. J.textDocument
@@ -163,9 +166,19 @@ completion _ide _ complParams = do
163166
| "{-# LANGUAGE" `T.isPrefixOf` VFS.fullLine pfix
164167
= J.List $ map buildCompletion
165168
(Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)
169+
| "{-# options_ghc" `T.isPrefixOf` T.toLower (VFS.fullLine pfix)
170+
= J.List $ map mkExtCompl
171+
(Fuzzy.simpleFilter (VFS.prefixText pfix) flags)
172+
-- if there already is a closing bracket - complete without one
173+
| isPragmaPrefix (VFS.fullLine pfix) && "}" `T.isSuffixOf` VFS.fullLine pfix
174+
= J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas Nothing)
175+
-- if there is no closing bracket - complete with one
176+
| isPragmaPrefix (VFS.fullLine pfix)
177+
= J.List $ map (\(a, b, c) -> mkPragmaCompl a b c) (validPragmas (Just "}"))
166178
| otherwise
167179
= J.List []
168180
result Nothing = J.List []
181+
isPragmaPrefix line = "{-#" `T.isPrefixOf` line
169182
buildCompletion p =
170183
J.CompletionItem
171184
{ _label = p,
@@ -187,8 +200,31 @@ completion _ide _ complParams = do
187200
_xdata = Nothing
188201
}
189202
_ -> return $ J.List []
190-
191203
-----------------------------------------------------------------------
204+
validPragmas :: Maybe T.Text -> [(T.Text, T.Text, T.Text)]
205+
validPragmas mSuffix =
206+
[ ("LANGUAGE ${1:extension} #-" <> suffix , "LANGUAGE", "{-# LANGUAGE #-}")
207+
, ("OPTIONS_GHC -${1:option} #-" <> suffix , "OPTIONS_GHC", "{-# OPTIONS_GHC #-}")
208+
, ("INLINE ${1:function} #-" <> suffix , "INLINE", "{-# INLINE #-}")
209+
, ("NOINLINE ${1:function} #-" <> suffix , "NOINLINE", "{-# NOINLINE #-}")
210+
, ("INLINABLE ${1:function} #-"<> suffix , "INLINABLE", "{-# INLINABLE #-}")
211+
, ("WARNING ${1:message} #-" <> suffix , "WARNING", "{-# WARNING #-}")
212+
, ("DEPRECATED ${1:message} #-" <> suffix , "DEPRECATED", "{-# DEPRECATED #-}")
213+
, ("ANN ${1:annotation} #-" <> suffix , "ANN", "{-# ANN #-}")
214+
, ("RULES #-" <> suffix , "RULES", "{-# RULES #-}")
215+
, ("SPECIALIZE ${1:function} #-" <> suffix , "SPECIALIZE", "{-# SPECIALIZE #-}")
216+
, ("SPECIALIZE INLINE ${1:function} #-"<> suffix , "SPECIALIZE INLINE", "{-# SPECIALIZE INLINE #-}")
217+
]
218+
where suffix = case mSuffix of
219+
(Just s) -> s
220+
Nothing -> ""
221+
222+
223+
mkPragmaCompl :: T.Text -> T.Text -> T.Text -> J.CompletionItem
224+
mkPragmaCompl insertText label detail =
225+
J.CompletionItem label (Just J.CiKeyword) Nothing (Just detail)
226+
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet)
227+
Nothing Nothing Nothing Nothing Nothing Nothing
192228

193229
-- | Find first line after the last file header pragma
194230
-- Defaults to line 0 if the file contains no shebang(s), OPTIONS_GHC pragma(s), or LANGUAGE pragma(s)
@@ -218,3 +254,17 @@ checkPragma name = check
218254
check l = isPragma l && getName l == name
219255
getName l = T.take (T.length name) $ T.dropWhile isSpace $ T.drop 3 l
220256
isPragma = T.isPrefixOf "{-#"
257+
258+
259+
stripLeading :: Char -> String -> String
260+
stripLeading _ [] = []
261+
stripLeading c (s:ss)
262+
| s == c = ss
263+
| otherwise = s:ss
264+
265+
266+
mkExtCompl :: T.Text -> J.CompletionItem
267+
mkExtCompl label =
268+
J.CompletionItem label (Just J.CiKeyword) Nothing Nothing
269+
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
270+
Nothing Nothing Nothing Nothing Nothing Nothing

‎plugins/hls-pragmas-plugin/test/Main.hs

+5-3
Original file line numberDiff line numberDiff line change
@@ -207,18 +207,20 @@ completionTests =
207207
item ^. L.kind @?= Just CiKeyword
208208
item ^. L.insertTextFormat @?= Just Snippet
209209
item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-}"
210+
item ^. L.detail @?= Just "{-# LANGUAGE #-}"
210211

211-
, testCase "completes pragmas no close" $ runSessionWithServer pragmasPlugin testDataDir $ do
212+
, testCase "completes pragmas with existing closing bracket" $ runSessionWithServer pragmasPlugin testDataDir $ do
212213
doc <- openDoc "Completion.hs" "haskell"
213-
let te = TextEdit (Range (Position 0 4) (Position 0 24)) ""
214+
let te = TextEdit (Range (Position 0 4) (Position 0 33)) ""
214215
_ <- applyEdit doc te
215216
compls <- getCompletions doc (Position 0 4)
216217
let item = head $ filter ((== "LANGUAGE") . (^. L.label)) compls
217218
liftIO $ do
218219
item ^. L.label @?= "LANGUAGE"
219220
item ^. L.kind @?= Just CiKeyword
220221
item ^. L.insertTextFormat @?= Just Snippet
221-
item ^. L.insertText @?= Just "LANGUAGE ${1:extension}"
222+
item ^. L.insertText @?= Just "LANGUAGE ${1:extension} #-"
223+
item ^. L.detail @?= Just "{-# LANGUAGE #-}"
222224

223225
, testCase "completes options pragma" $ runSessionWithServer pragmasPlugin testDataDir $ do
224226
doc <- openDoc "Completion.hs" "haskell"

0 commit comments

Comments
 (0)