Skip to content
This repository was archived by the owner on Oct 7, 2020. It is now read-only.

Commit ede0031

Browse files
alanzalanz
authored
Merge pull request #895 from haskell/complete-pragmas
Completion for pragmas
2 parents b70010b + bd376fb commit ede0031

File tree

2 files changed

+144
-51
lines changed

2 files changed

+144
-51
lines changed

‎src/Haskell/Ide/Engine/Plugin/HieExtras.hs

Lines changed: 95 additions & 47 deletions
Original file line numberDiff line numberDiff line change
@@ -151,6 +151,12 @@ mkExtCompl label =
151151
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
152152
Nothing Nothing Nothing Nothing Nothing
153153

154+
mkPragmaCompl :: T.Text -> T.Text -> J.CompletionItem
155+
mkPragmaCompl label insertText =
156+
J.CompletionItem label (Just J.CiKeyword) Nothing
157+
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just J.Snippet)
158+
Nothing Nothing Nothing Nothing Nothing
159+
154160
safeTyThingId :: TyThing -> Maybe Id
155161
safeTyThingId (AnId i) = Just i
156162
safeTyThingId (AConLike (RealDataCon dc)) = Just $ dataConWrapId dc
@@ -309,53 +315,95 @@ newtype WithSnippets = WithSnippets Bool
309315

310316
-- | Returns the cached completions for the given module and position.
311317
getCompletions :: Uri -> PosPrefixInfo -> WithSnippets -> IdeM (IdeResult [J.CompletionItem])
312-
getCompletions uri prefixInfo (WithSnippets withSnippets) = pluginGetFile "getCompletions: " uri $ \file -> do
313-
supportsSnippets <- fromMaybe False <$> asks (^? J.textDocument
314-
. _Just . J.completion
315-
. _Just . J.completionItem
316-
. _Just . J.snippetSupport
317-
. _Just)
318-
let toggleSnippets x
319-
| withSnippets && supportsSnippets = x
320-
| otherwise = x { J._insertTextFormat = Just J.PlainText
321-
, J._insertText = Nothing }
322-
323-
PosPrefixInfo {fullLine, prefixModule, prefixText} = prefixInfo
324-
debugm $ "got prefix" ++ show (prefixModule, prefixText)
325-
let enteredQual = if T.null prefixModule then "" else prefixModule <> "."
326-
fullPrefix = enteredQual <> prefixText
327-
ifCachedModuleAndData file (IdeResultOk []) $ \_ _ CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules, cachedExtensions } ->
328-
let
329-
filtModNameCompls = map mkModCompl
330-
$ mapMaybe (T.stripPrefix enteredQual)
331-
$ Fuzzy.simpleFilter fullPrefix allModNamesAsNS
332-
333-
filtCompls = Fuzzy.filterBy label prefixText compls
334-
where
335-
compls = if T.null prefixModule
336-
then unqualCompls
337-
else Map.findWithDefault [] prefixModule qualCompls
338-
339-
mkImportCompl label = (J.detail ?~ label)
340-
. mkModCompl
341-
$ fromMaybe "" (T.stripPrefix enteredQual label)
342-
343-
filtListWith f list = [ f label
344-
| label <- Fuzzy.simpleFilter fullPrefix list
345-
, enteredQual `T.isPrefixOf` label
346-
]
347-
348-
filtImportCompls = filtListWith mkImportCompl importableModules
349-
filtExtensionCompls = filtListWith mkExtCompl cachedExtensions
350-
351-
result
352-
| "import " `T.isPrefixOf` fullLine =
353-
filtImportCompls
354-
| "{-# language" `T.isPrefixOf` T.toLower fullLine =
355-
filtExtensionCompls
356-
| otherwise =
357-
filtModNameCompls ++ map (toggleSnippets . mkCompl) filtCompls
358-
in return $ IdeResultOk result
318+
getCompletions uri prefixInfo (WithSnippets withSnippets) =
319+
pluginGetFile "getCompletions: " uri $ \file -> do
320+
supportsSnippets <- fromMaybe False <$> asks
321+
(^? J.textDocument
322+
. _Just
323+
. J.completion
324+
. _Just
325+
. J.completionItem
326+
. _Just
327+
. J.snippetSupport
328+
. _Just
329+
)
330+
let toggleSnippets x
331+
| withSnippets && supportsSnippets = x
332+
| otherwise = x { J._insertTextFormat = Just J.PlainText
333+
, J._insertText = Nothing
334+
}
335+
336+
PosPrefixInfo { fullLine, prefixModule, prefixText } = prefixInfo
337+
debugm $ "got prefix" ++ show (prefixModule, prefixText)
338+
let enteredQual = if T.null prefixModule then "" else prefixModule <> "."
339+
fullPrefix = enteredQual <> prefixText
340+
ifCachedModuleAndData file (IdeResultOk [])
341+
$ \_ _ CC { allModNamesAsNS, unqualCompls, qualCompls, importableModules, cachedExtensions } ->
342+
let
343+
filtModNameCompls =
344+
map mkModCompl
345+
$ mapMaybe (T.stripPrefix enteredQual)
346+
$ Fuzzy.simpleFilter fullPrefix allModNamesAsNS
347+
348+
filtCompls = Fuzzy.filterBy label prefixText compls
349+
where
350+
compls = if T.null prefixModule
351+
then unqualCompls
352+
else Map.findWithDefault [] prefixModule qualCompls
353+
354+
mkImportCompl label = (J.detail ?~ label) . mkModCompl $ fromMaybe
355+
""
356+
(T.stripPrefix enteredQual label)
357+
358+
filtListWith f list =
359+
[ f label
360+
| label <- Fuzzy.simpleFilter fullPrefix list
361+
, enteredQual `T.isPrefixOf` label
362+
]
363+
364+
filtListWithSnippet f list suffix =
365+
[ toggleSnippets (f label (snippet <> suffix))
366+
| (snippet, label) <- list
367+
, Fuzzy.test fullPrefix label
368+
]
369+
370+
filtImportCompls = filtListWith mkImportCompl importableModules
371+
filtPragmaCompls = filtListWithSnippet mkPragmaCompl validPragmas
372+
filtOptsCompls = filtListWith mkExtCompl
373+
374+
result
375+
| "import " `T.isPrefixOf` fullLine
376+
= filtImportCompls
377+
| "{-# language" `T.isPrefixOf` T.toLower fullLine
378+
= filtOptsCompls cachedExtensions
379+
| "{-# options_ghc" `T.isPrefixOf` T.toLower fullLine
380+
= filtOptsCompls (map T.pack $ GHC.flagsForCompletion False)
381+
| "{-# " `T.isPrefixOf` fullLine
382+
= filtPragmaCompls (pragmaSuffix fullLine)
383+
| otherwise
384+
= filtModNameCompls ++ map (toggleSnippets . mkCompl) filtCompls
385+
in
386+
return $ IdeResultOk result
387+
where
388+
validPragmas :: [(T.Text, T.Text)]
389+
validPragmas =
390+
[ ("LANGUAGE ${1:extension}" , "LANGUAGE")
391+
, ("OPTIONS_GHC -${1:option}" , "OPTIONS_GHC")
392+
, ("INLINE ${1:function}" , "INLINE")
393+
, ("NOINLINE ${1:function}" , "NOINLINE")
394+
, ("INLINABLE ${1:function}" , "INLINABLE")
395+
, ("WARNING ${1:message}" , "WARNING")
396+
, ("DEPRECATED ${1:message}" , "DEPRECATED")
397+
, ("ANN ${1:annotation}" , "ANN")
398+
, ("RULES" , "RULES")
399+
, ("SPECIALIZE ${1:function}" , "SPECIALIZE")
400+
, ("SPECIALIZE INLINE ${1:function}", "SPECIALIZE INLINE")
401+
]
402+
403+
pragmaSuffix :: T.Text -> T.Text
404+
pragmaSuffix fullLine
405+
| "}" `T.isSuffixOf` fullLine = mempty
406+
| otherwise = " #-}"
359407
-- ---------------------------------------------------------------------
360408

361409
getTypeForName :: Name -> IdeM (Maybe Type)

‎test/functional/CompletionSpec.hs

Lines changed: 49 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ spec = describe "completions" $ do
5858
item ^. label `shouldBe` "Data.List"
5959
item ^. detail `shouldBe` Just "Data.List"
6060
item ^. kind `shouldBe` Just CiModule
61-
61+
6262
it "completes language extensions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
6363
doc <- openDoc "Completion.hs" "haskell"
6464
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
@@ -70,8 +70,53 @@ spec = describe "completions" $ do
7070
let item = head $ filter ((== "OverloadedStrings") . (^. label)) compls
7171
liftIO $ do
7272
item ^. label `shouldBe` "OverloadedStrings"
73-
item ^. kind `shouldBe` Just CiKeyword
74-
73+
item ^. kind `shouldBe` Just CiKeyword
74+
75+
it "completes pragmas" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
76+
doc <- openDoc "Completion.hs" "haskell"
77+
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
78+
79+
let te = TextEdit (Range (Position 0 4) (Position 0 34)) ""
80+
_ <- applyEdit doc te
81+
82+
compls <- getCompletions doc (Position 0 4)
83+
let item = head $ filter ((== "LANGUAGE") . (^. label)) compls
84+
liftIO $ do
85+
item ^. label `shouldBe` "LANGUAGE"
86+
item ^. kind `shouldBe` Just CiKeyword
87+
item ^. insertTextFormat `shouldBe` Just Snippet
88+
item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension} #-}"
89+
90+
it "completes pragmas no close" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
91+
doc <- openDoc "Completion.hs" "haskell"
92+
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
93+
94+
let te = TextEdit (Range (Position 0 4) (Position 0 24)) ""
95+
_ <- applyEdit doc te
96+
97+
compls <- getCompletions doc (Position 0 4)
98+
let item = head $ filter ((== "LANGUAGE") . (^. label)) compls
99+
liftIO $ do
100+
item ^. label `shouldBe` "LANGUAGE"
101+
item ^. kind `shouldBe` Just CiKeyword
102+
item ^. insertTextFormat `shouldBe` Just Snippet
103+
item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension}"
104+
105+
it "completes options pragma" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
106+
doc <- openDoc "Completion.hs" "haskell"
107+
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
108+
109+
let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS"
110+
_ <- applyEdit doc te
111+
112+
compls <- getCompletions doc (Position 0 4)
113+
let item = head $ filter ((== "OPTIONS_GHC") . (^. label)) compls
114+
liftIO $ do
115+
item ^. label `shouldBe` "OPTIONS_GHC"
116+
item ^. kind `shouldBe` Just CiKeyword
117+
item ^. insertTextFormat `shouldBe` Just Snippet
118+
item ^. insertText `shouldBe` Just ("OPTIONS_GHC -${1:option} #-}")
119+
75120
it "completes with no prefix" $ runSession hieCommand fullCaps "test/testdata/completion" $ do
76121
doc <- openDoc "Completion.hs" "haskell"
77122
_ <- skipManyTill loggingNotification (count 2 noDiagnostics)
@@ -149,4 +194,4 @@ spec = describe "completions" $ do
149194
item ^. kind `shouldBe` Just CiFunction
150195
item ^. insertTextFormat `shouldBe` Just PlainText
151196
item ^. insertText `shouldBe` Nothing
152-
noSnippetsCaps = (textDocument . _Just . completion . _Just . completionItem . _Just . snippetSupport ?~ False) fullCaps
197+
noSnippetsCaps = (textDocument . _Just . completion . _Just . completionItem . _Just . snippetSupport ?~ False) fullCaps

0 commit comments

Comments
 (0)