Skip to content

Commit 0c81fb2

Browse files
jhrcekjhrcek
committed
Fix the bug
1 parent 28dc9df commit 0c81fb2

File tree

3 files changed

+53
-23
lines changed

3 files changed

+53
-23
lines changed

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

+1-1
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

+3-2
Original file line numberDiff line numberDiff line change
@@ -769,7 +769,7 @@ common pragmas
769769
cpp-options: -Dhls_pragmas
770770

771771
library hls-pragmas-plugin
772-
import: defaults, warnings
772+
import: defaults, pedantic, warnings
773773
exposed-modules: Ide.Plugin.Pragmas
774774
hs-source-dirs: plugins/hls-pragmas-plugin/src
775775
build-depends:
@@ -781,11 +781,12 @@ library hls-pragmas-plugin
781781
, lens
782782
, lsp
783783
, text
784+
, text-rope
784785
, transformers
785786
, containers
786787

787788
test-suite hls-pragmas-plugin-tests
788-
import: defaults, test-defaults, warnings
789+
import: defaults, pedantic, test-defaults, warnings
789790
type: exitcode-stdio-1.0
790791
hs-source-dirs: plugins/hls-pragmas-plugin/test
791792
main-is: Main.hs

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

+49-20
Original file line numberDiff line numberDiff line change
@@ -18,10 +18,13 @@ 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, listToMaybe,
25+
mapMaybe)
2426
import qualified Data.Text as T
27+
import qualified Data.Text.Utf16.Rope as Rope
2528
import Development.IDE hiding (line)
2629
import Development.IDE.Core.Compile (sourceParser,
2730
sourceTypecheck)
@@ -192,30 +195,32 @@ allPragmas =
192195

193196
-- ---------------------------------------------------------------------
194197
flags :: [T.Text]
195-
flags = map (T.pack . stripLeading '-') $ flagsForCompletion False
198+
flags = map T.pack $ flagsForCompletion False
196199

197200
completion :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion
198201
completion _ide _ complParams = do
199202
let (LSP.TextDocumentIdentifier uri) = complParams ^. L.textDocument
200-
position = complParams ^. L.position
203+
cursorPos@(Position l c) = complParams ^. L.position
201204
contents <- lift $ LSP.getVirtualFile $ toNormalizedUri uri
202205
fmap LSP.InL $ case (contents, uriToFilePath' uri) of
203206
(Just cnts, Just _path) ->
204-
result <$> VFS.getCompletionPrefix position cnts
207+
result <$> VFS.getCompletionPrefix cursorPos cnts
205208
where
206209
result (Just pfix)
207210
| "{-# language" `T.isPrefixOf` line
208-
= map buildCompletion
209-
(Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas)
211+
= map mkLanguagePragmaCompl $
212+
Fuzzy.simpleFilter (VFS.prefixText pfix) allPragmas
210213
| "{-# options_ghc" `T.isPrefixOf` line
211-
= map buildCompletion
212-
(Fuzzy.simpleFilter (VFS.prefixText pfix) flags)
214+
= let flagPrefix = getGhcOptionPrefix cursorPos cnts
215+
prefixLength = fromIntegral $ T.length flagPrefix
216+
prefixRange = LSP.Range (Position l (c - prefixLength)) cursorPos
217+
in map (mkGhcOptionCompl prefixRange) $ Fuzzy.simpleFilter flagPrefix flags
213218
| "{-#" `T.isPrefixOf` line
214219
= [ mkPragmaCompl (a <> suffix) b c
215220
| (a, b, c, w) <- validPragmas, w == NewLine
216221
]
217222
| -- Do not suggest any pragmas any of these conditions:
218-
-- 1. Current line is a an import
223+
-- 1. Current line is an import
219224
-- 2. There is a module name right before the current word.
220225
-- Something like `Text.la` shouldn't suggest adding the
221226
-- 'LANGUAGE' pragma.
@@ -238,7 +243,7 @@ completion _ide _ complParams = do
238243
module_ = VFS.prefixModule pfix
239244
word = VFS.prefixText pfix
240245
-- Not completely correct, may fail if more than one "{-#" exist
241-
-- , we can ignore it since it rarely happen.
246+
-- , we can ignore it since it rarely happens.
242247
prefix
243248
| "{-# " `T.isInfixOf` line = ""
244249
| "{-#" `T.isInfixOf` line = " "
@@ -293,19 +298,43 @@ mkPragmaCompl insertText label detail =
293298
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just LSP.InsertTextFormat_Snippet)
294299
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
295300

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

331+
mkGhcOptionCompl :: Range -> T.Text -> LSP.CompletionItem
332+
mkGhcOptionCompl editRange completedFlag =
333+
LSP.CompletionItem completedFlag Nothing (Just LSP.CompletionItemKind_Keyword) Nothing Nothing
334+
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
335+
Nothing (Just insertCompleteFlag) Nothing Nothing Nothing Nothing Nothing
336+
where
337+
insertCompleteFlag = LSP.InL $ LSP.TextEdit editRange completedFlag
338+
310339

311340

0 commit comments

Comments
 (0)