Skip to content

Commit 42088bf

Browse files
jhrcekjhrcek
committed
Fix the bug
1 parent d49add9 commit 42088bf

File tree

3 files changed

+57
-24
lines changed

3 files changed

+57
-24
lines changed

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -904,7 +904,7 @@ getCompletionPrefix pos@(Position l c) (VFS.VirtualFile _ _ ropetext) =
904904
lastMaybe = headMaybe . reverse
905905

906906
-- grab the entire line the cursor is at
907-
curLine <- headMaybe $ T.lines $ Rope.toText
907+
curLine <- headMaybe $ Rope.lines
908908
$ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext
909909
let beforePos = T.take (fromIntegral c) curLine
910910
-- the word getting typed, after previous space and before cursor

‎haskell-language-server.cabal‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -761,7 +761,7 @@ common pragmas
761761
cpp-options: -Dhls_pragmas
762762

763763
library hls-pragmas-plugin
764-
import: defaults, warnings
764+
import: defaults, pedantic, warnings
765765
exposed-modules: Ide.Plugin.Pragmas
766766
hs-source-dirs: plugins/hls-pragmas-plugin/src
767767
build-depends:
@@ -773,11 +773,12 @@ library hls-pragmas-plugin
773773
, lens
774774
, lsp
775775
, text
776+
, text-rope
776777
, transformers
777778
, containers
778779

779780
test-suite hls-pragmas-plugin-tests
780-
import: defaults, test-defaults, warnings
781+
import: defaults, pedantic, test-defaults, warnings
781782
type: exitcode-stdio-1.0
782783
hs-source-dirs: plugins/hls-pragmas-plugin/test
783784
main-is: Main.hs

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

Lines changed: 53 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -18,25 +18,31 @@ module Ide.Plugin.Pragmas
1818
import Control.Lens hiding (List)
1919
import Control.Monad.IO.Class (MonadIO (liftIO))
2020
import Control.Monad.Trans.Class (lift)
21+
import Data.Char (isAlphaNum)
2122
import Data.List.Extra (nubOrdOn)
2223
import qualified Data.Map as M
23-
import Data.Maybe (mapMaybe)
24+
import Data.Maybe (fromMaybe,
25+
listToMaybe,
26+
mapMaybe)
2427
import qualified Data.Text as T
28+
import qualified Data.Text.Utf16.Rope.Mixed as Rope
2529
import Development.IDE hiding (line)
2630
import Development.IDE.Core.Compile (sourceParser,
2731
sourceTypecheck)
2832
import Development.IDE.Core.PluginUtils
2933
import Development.IDE.GHC.Compat
3034
import Development.IDE.Plugin.Completions (ghcideCompletionsPluginPriority)
3135
import Development.IDE.Plugin.Completions.Logic (getCompletionPrefix)
32-
import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..))
36+
import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..),
37+
prefixText)
3338
import qualified Development.IDE.Spans.Pragmas as Pragmas
3439
import Ide.Plugin.Error
3540
import Ide.Types
3641
import qualified Language.LSP.Protocol.Lens as L
3742
import qualified Language.LSP.Protocol.Message as LSP
3843
import qualified Language.LSP.Protocol.Types as LSP
3944
import qualified Language.LSP.Server as LSP
45+
import qualified Language.LSP.VFS as VFS
4046
import qualified Text.Fuzzy as Fuzzy
4147

4248
-- ---------------------------------------------------------------------
@@ -193,30 +199,32 @@ allPragmas =
193199

194200
-- ---------------------------------------------------------------------
195201
flags :: [T.Text]
196-
flags = map (T.pack . stripLeading '-') $ flagsForCompletion False
202+
flags = map T.pack $ flagsForCompletion False
197203

198204
completion :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion
199205
completion _ide _ complParams = do
200206
let (LSP.TextDocumentIdentifier uri) = complParams ^. L.textDocument
201-
position = complParams ^. L.position
207+
cursorPos@(Position l c) = complParams ^. L.position
202208
contents <- lift $ LSP.getVirtualFile $ toNormalizedUri uri
203209
fmap LSP.InL $ case (contents, uriToFilePath' uri) of
204210
(Just cnts, Just _path) ->
205-
pure $ result $ getCompletionPrefix position cnts
211+
pure $ result $ getCompletionPrefix cursorPos cnts
206212
where
207213
result pfix
208214
| "{-# language" `T.isPrefixOf` line
209-
= map buildCompletion
210-
(Fuzzy.simpleFilter (prefixText pfix) allPragmas)
215+
= map mkLanguagePragmaCompl $
216+
Fuzzy.simpleFilter (prefixText pfix) allPragmas
211217
| "{-# options_ghc" `T.isPrefixOf` line
212-
= map buildCompletion
213-
(Fuzzy.simpleFilter (prefixText pfix) flags)
218+
= let flagPrefix = getGhcOptionPrefix cursorPos cnts
219+
prefixLength = fromIntegral $ T.length flagPrefix
220+
prefixRange = LSP.Range (Position l (c - prefixLength)) cursorPos
221+
in map (mkGhcOptionCompl prefixRange) $ Fuzzy.simpleFilter flagPrefix flags
214222
| "{-#" `T.isPrefixOf` line
215223
= [ mkPragmaCompl (a <> suffix) b c
216224
| (a, b, c, w) <- validPragmas, w == NewLine
217225
]
218226
| -- Do not suggest any pragmas any of these conditions:
219-
-- 1. Current line is a an import
227+
-- 1. Current line is an import
220228
-- 2. There is a module name right before the current word.
221229
-- Something like `Text.la` shouldn't suggest adding the
222230
-- 'LANGUAGE' pragma.
@@ -239,7 +247,7 @@ completion _ide _ complParams = do
239247
module_ = prefixScope pfix
240248
word = prefixText pfix
241249
-- Not completely correct, may fail if more than one "{-#" exist
242-
-- , we can ignore it since it rarely happen.
250+
-- , we can ignore it since it rarely happens.
243251
prefix
244252
| "{-# " `T.isInfixOf` line = ""
245253
| "{-#" `T.isInfixOf` line = " "
@@ -293,19 +301,43 @@ mkPragmaCompl insertText label detail =
293301
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just LSP.InsertTextFormat_Snippet)
294302
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
295303

296-
297-
stripLeading :: Char -> String -> String
298-
stripLeading _ [] = []
299-
stripLeading c (s:ss)
300-
| s == c = ss
301-
| otherwise = s:ss
302-
303-
304-
buildCompletion :: T.Text -> LSP.CompletionItem
305-
buildCompletion label =
304+
getGhcOptionPrefix :: Position -> VFS.VirtualFile -> T.Text
305+
getGhcOptionPrefix (Position l c) (VFS.VirtualFile _ _ ropetext) =
306+
fromMaybe "" $ do
307+
let lastMaybe = listToMaybe . reverse
308+
309+
-- grab the entire line the cursor is at
310+
curLine <- listToMaybe
311+
$ Rope.lines
312+
$ fst $ Rope.splitAtLine 1
313+
$ snd $ Rope.splitAtLine (fromIntegral l) ropetext
314+
let beforePos = T.take (fromIntegral c) curLine
315+
-- the word getting typed, after previous space and before cursor
316+
curWord <-
317+
if | T.null beforePos -> Just ""
318+
| T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc '
319+
| otherwise -> lastMaybe (T.words beforePos)
320+
pure $ T.takeWhileEnd isGhcOptionChar curWord
321+
322+
-- | Is this character contained in some GHC flag? Based on:
323+
-- GHCi> nub . sort . concat $ GHC.Driver.Session.flagsForCompletion False
324+
-- "#-.01234589=ABCDEFGHIJKLMNOPQRSTUVWX_abcdefghijklmnopqrstuvwxyz"
325+
isGhcOptionChar :: Char -> Bool
326+
isGhcOptionChar c = isAlphaNum c || c `elem` ("#-.=_" :: String)
327+
328+
mkLanguagePragmaCompl :: T.Text -> LSP.CompletionItem
329+
mkLanguagePragmaCompl label =
306330
LSP.CompletionItem label Nothing (Just LSP.CompletionItemKind_Keyword) Nothing Nothing
307331
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
308332
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
309333

334+
mkGhcOptionCompl :: Range -> T.Text -> LSP.CompletionItem
335+
mkGhcOptionCompl editRange completedFlag =
336+
LSP.CompletionItem completedFlag Nothing (Just LSP.CompletionItemKind_Keyword) Nothing Nothing
337+
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
338+
Nothing (Just insertCompleteFlag) Nothing Nothing Nothing Nothing Nothing
339+
where
340+
insertCompleteFlag = LSP.InL $ LSP.TextEdit editRange completedFlag
341+
310342

311343

0 commit comments

Comments
 (0)