11{-# LANGUAGE DeriveAnyClass #-}
22{-# LANGUAGE DeriveGeneric #-}
33{-# LANGUAGE OverloadedStrings #-}
4+ {-# LANGUAGE DuplicateRecordFields #-}
45
56-- | Provides code actions to add missing pragmas (whenever GHC suggests to)
67module Ide.Plugin.Pragmas
@@ -21,12 +22,16 @@ import qualified Language.Haskell.LSP.Types.Lens as J
2122import Development.IDE as D
2223import Language.Haskell.LSP.Types
2324
25+ import qualified Language.Haskell.LSP.Core as LSP
26+ import qualified Language.Haskell.LSP.VFS as VFS
27+
2428-- ---------------------------------------------------------------------
2529
2630descriptor :: PluginId -> PluginDescriptor
2731descriptor plId = (defaultPluginDescriptor plId)
2832 { pluginCommands = commands
2933 , pluginCodeActionProvider = Just codeActionProvider
34+ , pluginCompletionProvider = Just completion
3035 }
3136
3237-- ---------------------------------------------------------------------
@@ -160,3 +165,40 @@ possiblePragmas =
160165 ]
161166
162167-- ---------------------------------------------------------------------
168+
169+ completion :: CompletionProvider
170+ completion lspFuncs _ide complParams = do
171+ let (TextDocumentIdentifier uri) = complParams ^. J. textDocument
172+ position = complParams ^. J. position
173+ contents <- LSP. getVirtualFileFunc lspFuncs $ toNormalizedUri uri
174+ fmap Right $ case (contents, uriToFilePath' uri) of
175+ (Just cnts, Just _path) -> do
176+ pfix <- VFS. getCompletionPrefix position cnts
177+ return $ result pfix
178+ where
179+ result (Just pfix)
180+ | " {-# LANGUAGE" `T.isPrefixOf` VFS. fullLine pfix
181+ = Completions $ List $ map buildCompletion possiblePragmas
182+ | otherwise
183+ = Completions $ List []
184+ result Nothing = Completions $ List []
185+ buildCompletion p =
186+ CompletionItem
187+ { _label = p,
188+ _kind = Just CiKeyword ,
189+ _tags = List [] ,
190+ _detail = Nothing ,
191+ _documentation = Nothing ,
192+ _deprecated = Nothing ,
193+ _preselect = Nothing ,
194+ _sortText = Nothing ,
195+ _filterText = Nothing ,
196+ _insertText = Nothing ,
197+ _insertTextFormat = Nothing ,
198+ _textEdit = Nothing ,
199+ _additionalTextEdits = Nothing ,
200+ _commitCharacters = Nothing ,
201+ _command = Nothing ,
202+ _xdata = Nothing
203+ }
204+ _ -> return $ Completions $ List []
0 commit comments