Skip to content

Commit 8b02ab4

Browse files
jhrcekjhrcek
committed
Refactor, more reuse
1 parent 42088bf commit 8b02ab4

File tree

2 files changed

+34
-51
lines changed

2 files changed

+34
-51
lines changed

‎haskell-language-server.cabal

-1
Original file line numberDiff line numberDiff line change
@@ -773,7 +773,6 @@ library hls-pragmas-plugin
773773
, lens
774774
, lsp
775775
, text
776-
, text-rope
777776
, transformers
778777
, containers
779778

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

+34-50
Original file line numberDiff line numberDiff line change
@@ -21,28 +21,23 @@ import Control.Monad.Trans.Class (lift)
2121
import Data.Char (isAlphaNum)
2222
import Data.List.Extra (nubOrdOn)
2323
import qualified Data.Map as M
24-
import Data.Maybe (fromMaybe,
25-
listToMaybe,
26-
mapMaybe)
24+
import Data.Maybe (mapMaybe)
2725
import qualified Data.Text as T
28-
import qualified Data.Text.Utf16.Rope.Mixed as Rope
2926
import Development.IDE hiding (line)
3027
import Development.IDE.Core.Compile (sourceParser,
3128
sourceTypecheck)
3229
import Development.IDE.Core.PluginUtils
3330
import Development.IDE.GHC.Compat
3431
import Development.IDE.Plugin.Completions (ghcideCompletionsPluginPriority)
3532
import Development.IDE.Plugin.Completions.Logic (getCompletionPrefix)
36-
import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..),
37-
prefixText)
33+
import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (..))
3834
import qualified Development.IDE.Spans.Pragmas as Pragmas
3935
import Ide.Plugin.Error
4036
import Ide.Types
4137
import qualified Language.LSP.Protocol.Lens as L
4238
import qualified Language.LSP.Protocol.Message as LSP
4339
import qualified Language.LSP.Protocol.Types as LSP
4440
import qualified Language.LSP.Server as LSP
45-
import qualified Language.LSP.VFS as VFS
4641
import qualified Text.Fuzzy as Fuzzy
4742

4843
-- ---------------------------------------------------------------------
@@ -135,7 +130,6 @@ suggestDisableWarning Diagnostic {_code}
135130

136131
-- Don't suggest disabling type errors as a solution to all type errors
137132
warningBlacklist :: [T.Text]
138-
-- warningBlacklist = []
139133
warningBlacklist = ["deferred-type-errors"]
140134

141135
-- ---------------------------------------------------------------------
@@ -204,26 +198,26 @@ flags = map T.pack $ flagsForCompletion False
204198
completion :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion
205199
completion _ide _ complParams = do
206200
let (LSP.TextDocumentIdentifier uri) = complParams ^. L.textDocument
207-
cursorPos@(Position l c) = complParams ^. L.position
201+
position@(Position ln col) = complParams ^. L.position
208202
contents <- lift $ LSP.getVirtualFile $ toNormalizedUri uri
209203
fmap LSP.InL $ case (contents, uriToFilePath' uri) of
210204
(Just cnts, Just _path) ->
211-
pure $ result $ getCompletionPrefix cursorPos cnts
205+
pure $ result $ getCompletionPrefix position cnts
212206
where
213207
result pfix
214208
| "{-# language" `T.isPrefixOf` line
215209
= map mkLanguagePragmaCompl $
216-
Fuzzy.simpleFilter (prefixText pfix) allPragmas
210+
Fuzzy.simpleFilter word allPragmas
217211
| "{-# options_ghc" `T.isPrefixOf` line
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
212+
= let optionPrefix = getGhcOptionPrefix pfix
213+
prefixLength = fromIntegral $ T.length optionPrefix
214+
prefixRange = LSP.Range (Position ln (col - prefixLength)) position
215+
in map (mkGhcOptionCompl prefixRange) $ Fuzzy.simpleFilter optionPrefix flags
222216
| "{-#" `T.isPrefixOf` line
223217
= [ mkPragmaCompl (a <> suffix) b c
224218
| (a, b, c, w) <- validPragmas, w == NewLine
225219
]
226-
| -- Do not suggest any pragmas any of these conditions:
220+
| -- Do not suggest any pragmas under any of these conditions:
227221
-- 1. Current line is an import
228222
-- 2. There is a module name right before the current word.
229223
-- Something like `Text.la` shouldn't suggest adding the
@@ -234,20 +228,21 @@ completion _ide _ complParams = do
234228
| otherwise
235229
= [ mkPragmaCompl (prefix <> pragmaTemplate <> suffix) matcher detail
236230
| (pragmaTemplate, matcher, detail, appearWhere) <- validPragmas
237-
, -- Only suggest a pragma that needs its own line if the whole line
238-
-- fuzzily matches the pragma
239-
(appearWhere == NewLine && Fuzzy.test line matcher ) ||
240-
-- Only suggest a pragma that appears in the middle of a line when
241-
-- the current word is not the only thing in the line and the
242-
-- current word fuzzily matches the pragma
243-
(appearWhere == CanInline && line /= word && Fuzzy.test word matcher)
231+
, case appearWhere of
232+
-- Only suggest a pragma that needs its own line if the whole line
233+
-- fuzzily matches the pragma
234+
NewLine -> Fuzzy.test line matcher
235+
-- Only suggest a pragma that appears in the middle of a line when
236+
-- the current word is not the only thing in the line and the
237+
-- current word fuzzily matches the pragma
238+
CanInline -> line /= word && Fuzzy.test word matcher
244239
]
245240
where
246241
line = T.toLower $ fullLine pfix
247242
module_ = prefixScope pfix
248243
word = prefixText pfix
249-
-- Not completely correct, may fail if more than one "{-#" exist
250-
-- , we can ignore it since it rarely happens.
244+
-- Not completely correct, may fail if more than one "{-#" exist.
245+
-- We can ignore it since it rarely happens.
251246
prefix
252247
| "{-# " `T.isInfixOf` line = ""
253248
| "{-#" `T.isInfixOf` line = " "
@@ -301,30 +296,6 @@ mkPragmaCompl insertText label detail =
301296
Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just LSP.InsertTextFormat_Snippet)
302297
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
303298

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-
328299
mkLanguagePragmaCompl :: T.Text -> LSP.CompletionItem
329300
mkLanguagePragmaCompl label =
330301
LSP.CompletionItem label Nothing (Just LSP.CompletionItemKind_Keyword) Nothing Nothing
@@ -339,5 +310,18 @@ mkGhcOptionCompl editRange completedFlag =
339310
where
340311
insertCompleteFlag = LSP.InL $ LSP.TextEdit editRange completedFlag
341312

313+
-- The prefix extraction logic of getCompletionPrefix
314+
-- doesn't consider '-' part of prefix which breaks completion
315+
-- of flags like "-ddump-xyz". For OPTIONS_GHC completion we need the whole thing
316+
-- to be considered completion prefix, but `prefixText posPrefixInfo` would return"xyz" in this case
317+
getGhcOptionPrefix :: PosPrefixInfo -> T.Text
318+
getGhcOptionPrefix PosPrefixInfo {cursorPos = Position _ col, fullLine}=
319+
T.takeWhileEnd isGhcOptionChar beforePos
320+
where
321+
beforePos = T.take (fromIntegral col) fullLine
342322

343-
323+
-- Is this character contained in some GHC flag? Based on:
324+
-- >>> nub . sort . concat $ GHC.Driver.Session.flagsForCompletion False
325+
-- "#-.01234589=ABCDEFGHIJKLMNOPQRSTUVWX_abcdefghijklmnopqrstuvwxyz"
326+
isGhcOptionChar :: Char -> Bool
327+
isGhcOptionChar c = isAlphaNum c || c `elem` ("#-.=_" :: String)

0 commit comments

Comments
 (0)