Skip to content

Commit 16a201c

Browse files
fendorfendor
committed
Refactor context search to use readFields 
1 parent f8379bb commit 16a201c

File tree

11 files changed

+437
-223
lines changed

11 files changed

+437
-223
lines changed

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

+5-1
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Development.IDE.Plugin.Completions.Logic (
1212
, getCompletions
1313
, fromIdentInfo
1414
, getCompletionPrefix
15+
, getCompletionPrefixFromRope
1516
) where
1617

1718
import Control.Applicative
@@ -898,7 +899,10 @@ mergeListsBy cmp all_lists = merge_lists all_lists
898899

899900
-- |From the given cursor position, gets the prefix module or record for autocompletion
900901
getCompletionPrefix :: Position -> VFS.VirtualFile -> PosPrefixInfo
901-
getCompletionPrefix pos@(Position l c) (VFS.VirtualFile _ _ ropetext) =
902+
getCompletionPrefix pos (VFS.VirtualFile _ _ ropetext) = getCompletionPrefixFromRope pos ropetext
903+
904+
getCompletionPrefixFromRope :: Position -> Rope.Rope -> PosPrefixInfo
905+
getCompletionPrefixFromRope pos@(Position l c) ropetext =
902906
fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad
903907
let headMaybe = listToMaybe
904908
lastMaybe = headMaybe . reverse

‎haskell-language-server.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -238,6 +238,7 @@ library hls-cabal-plugin
238238
Ide.Plugin.Cabal.Completion.Data
239239
Ide.Plugin.Cabal.Completion.Types
240240
Ide.Plugin.Cabal.LicenseSuggest
241+
Ide.Plugin.Cabal.Orphans
241242
Ide.Plugin.Cabal.Parse
242243

243244

‎hls-test-utils/hls-test-utils.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ library
5555
, temporary
5656
, text
5757
, row-types
58+
, neat-interpolation
5859
ghc-options: -Wall -Wunused-packages
5960

6061
if flag(pedantic)

‎hls-test-utils/src/Test/Hls/Util.hs

+52
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,9 @@ module Test.Hls.Util
4545
, withCurrentDirectoryInTmp
4646
, withCurrentDirectoryInTmp'
4747
, withCanonicalTempDir
48+
-- * Extract positions from input file.
49+
, extractCursorPositions
50+
, trimming
4851
)
4952
where
5053

@@ -78,6 +81,9 @@ import Test.Tasty.ExpectedFailure (expectFailBecause,
7881
import Test.Tasty.HUnit (Assertion, assertFailure,
7982
(@?=))
8083

84+
import Development.IDE.Plugin.Completions.Logic (getCompletionPrefixFromRope)
85+
import qualified Data.Text.Internal.Search as T
86+
8187
noLiteralCaps :: ClientCapabilities
8288
noLiteralCaps = def & L.textDocument ?~ textDocumentCaps
8389
where
@@ -348,3 +354,49 @@ withCanonicalTempDir :: (FilePath -> IO a) -> IO a
348354
withCanonicalTempDir f = System.IO.Extra.withTempDir $ \dir -> do
349355
dir' <- canonicalizePath dir
350356
f dir'
357+
358+
-- ----------------------------------------------------------------------------
359+
-- Extract Position data from the source file itself.
360+
-- ----------------------------------------------------------------------------
361+
362+
data FoldState = FoldState
363+
{ foldStateRows :: !Int
364+
, foldStatePositions :: ![Position]
365+
, foldStateFinalText :: ![T.Text]
366+
}
367+
368+
emptyFoldState :: FoldState
369+
emptyFoldState = FoldState
370+
{ foldStateRows = 0
371+
, foldStatePositions = []
372+
, foldStateFinalText = []
373+
}
374+
375+
foldStateToText :: FoldState -> T.Text
376+
foldStateToText state = T.unlines $ reverse $ foldStateFinalText state
377+
378+
addTextCursor :: FoldState -> Int -> FoldState
379+
addTextCursor state col = state
380+
{ foldStatePositions = Position (fromIntegral (foldStateRows state) - 1) (fromIntegral col) : foldStatePositions state
381+
}
382+
383+
addTextLine :: FoldState -> T.Text -> FoldState
384+
addTextLine state l = state
385+
{ foldStateFinalText = l : foldStateFinalText state
386+
, foldStateRows = foldStateRows state + 1
387+
}
388+
389+
extractCursorPositions :: T.Text -> (T.Text, [PosPrefixInfo])
390+
extractCursorPositions t =
391+
let
392+
textLines = T.lines t
393+
foldState = List.foldl' go emptyFoldState textLines
394+
finalText = foldStateToText foldState
395+
in
396+
(finalText, fmap (\pos -> getCompletionPrefixFromRope pos (Rope.fromText finalText)) $ foldStatePositions foldState)
397+
398+
where
399+
go foldState l = case T.indices "^" l of
400+
[] -> addTextLine foldState l
401+
xs -> List.foldl' addTextCursor foldState xs
402+

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

+70-38
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ import Control.DeepSeq
1212
import Control.Lens ((^.))
1313
import Control.Monad.Extra
1414
import Control.Monad.IO.Class
15-
import Control.Monad.Trans.Class (lift)
15+
import Control.Monad.Trans.Class
1616
import Control.Monad.Trans.Maybe (runMaybeT)
1717
import qualified Data.ByteString as BS
1818
import Data.Hashable
@@ -27,12 +27,17 @@ import qualified Development.IDE.Core.Shake as Shake
2727
import Development.IDE.Graph (alwaysRerun)
2828
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
2929
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
30+
import qualified Distribution.Fields as Syntax
31+
import qualified Distribution.Parsec.Position as Syntax
3032
import GHC.Generics
3133
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
3234
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
35+
import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..),
36+
ParseCabalFile (..))
3337
import qualified Ide.Plugin.Cabal.Completion.Types as Types
3438
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
3539
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
40+
import Ide.Plugin.Cabal.Orphans ()
3641
import qualified Ide.Plugin.Cabal.Parse as Parse
3742
import Ide.Types
3843
import qualified Language.LSP.Protocol.Lens as JL
@@ -70,7 +75,7 @@ instance Pretty Log where
7075
"Set files of interest to:" <+> viaShow files
7176
LogCompletionContext context position ->
7277
"Determined completion context:"
73-
<+> viaShow context
78+
<+> pretty context
7479
<+> "for cursor position:"
7580
<+> pretty position
7681
LogCompletions logs -> pretty logs
@@ -144,30 +149,51 @@ cabalRules recorder plId = do
144149
-- Make sure we initialise the cabal files-of-interest.
145150
ofInterestRules recorder
146151
-- Rule to produce diagnostics for cabal files.
147-
define (cmapWithPrio LogShake recorder) $ \Types.GetCabalDiagnostics file -> do
152+
define (cmapWithPrio LogShake recorder) $ \ParseCabalFields file -> do
148153
config <- getPluginConfigAction plId
149154
if not (plcGlobalOn config && plcDiagnosticsOn config)
150-
then pure ([], Nothing)
151-
else do
152-
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
153-
-- we rerun this rule because this rule *depends* on GetModificationTime.
154-
(t, mCabalSource) <- use_ GetFileContents file
155-
log' Debug $ LogModificationTime file t
156-
contents <- case mCabalSource of
157-
Just sources ->
158-
pure $ Encoding.encodeUtf8 sources
159-
Nothing -> do
160-
liftIO $ BS.readFile $ fromNormalizedFilePath file
161-
162-
(pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
163-
let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
164-
case pm of
165-
Left (_cabalVersion, pErrorNE) -> do
166-
let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
167-
allDiags = errorDiags <> warningDiags
168-
pure (allDiags, Nothing)
169-
Right gpd -> do
170-
pure (warningDiags, Just gpd)
155+
then pure ([], Nothing)
156+
else do
157+
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
158+
-- we rerun this rule because this rule *depends* on GetModificationTime.
159+
(t, mCabalSource) <- use_ GetFileContents file
160+
log' Debug $ LogModificationTime file t
161+
contents <- case mCabalSource of
162+
Just sources ->
163+
pure $ Encoding.encodeUtf8 sources
164+
Nothing -> do
165+
liftIO $ BS.readFile $ fromNormalizedFilePath file
166+
167+
case Parse.readCabalFields file contents of
168+
Left _ ->
169+
pure ([], Nothing)
170+
Right fields ->
171+
pure ([], Just fields)
172+
173+
define (cmapWithPrio LogShake recorder) $ \ParseCabalFile file -> do
174+
config <- getPluginConfigAction plId
175+
if not (plcGlobalOn config && plcDiagnosticsOn config)
176+
then pure ([], Nothing)
177+
else do
178+
-- whenever this key is marked as dirty (e.g., when a user writes stuff to it),
179+
-- we rerun this rule because this rule *depends* on GetModificationTime.
180+
(t, mCabalSource) <- use_ GetFileContents file
181+
log' Debug $ LogModificationTime file t
182+
contents <- case mCabalSource of
183+
Just sources ->
184+
pure $ Encoding.encodeUtf8 sources
185+
Nothing -> do
186+
liftIO $ BS.readFile $ fromNormalizedFilePath file
187+
188+
(pWarnings, pm) <- liftIO $ Parse.parseCabalFileContents contents
189+
let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings
190+
case pm of
191+
Left (_cabalVersion, pErrorNE) -> do
192+
let errorDiags = NE.toList $ NE.map (Diagnostics.errorDiagnostic file) pErrorNE
193+
allDiags = errorDiags <> warningDiags
194+
pure (allDiags, Nothing)
195+
Right gpd -> do
196+
pure (warningDiags, Just gpd)
171197

172198
action $ do
173199
-- Run the cabal kick. This code always runs when 'shakeRestart' is run.
@@ -187,7 +213,7 @@ function invocation.
187213
kick :: Action ()
188214
kick = do
189215
files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
190-
void $ uses Types.GetCabalDiagnostics files
216+
void $ uses Types.ParseCabalFile files
191217

192218
-- ----------------------------------------------------------------
193219
-- Code Actions
@@ -278,24 +304,31 @@ completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.M
278304
completion recorder ide _ complParams = do
279305
let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument
280306
position = complParams ^. JL.position
281-
contents <- lift $ getVirtualFile $ toNormalizedUri uri
282-
case (contents, uriToFilePath' uri) of
283-
(Just cnts, Just path) -> do
284-
let pref = Ghcide.getCompletionPrefix position cnts
285-
let res = result pref path cnts
286-
liftIO $ fmap InL res
287-
_ -> pure . InR $ InR Null
307+
mVf <- lift $ getVirtualFile $ toNormalizedUri uri
308+
case (,) <$> mVf <*> uriToFilePath' uri of
309+
Just (cnts, path) -> do
310+
mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ide) $ useWithStaleFast ParseCabalFields $ toNormalizedFilePath path
311+
case mFields of
312+
Nothing ->
313+
pure . InR $ InR Null
314+
Just (fields, _) -> do
315+
let pref = Ghcide.getCompletionPrefix position cnts
316+
let res = produceCompletions pref path fields
317+
liftIO $ fmap InL res
318+
Nothing -> pure . InR $ InR Null
288319
where
289-
result :: Ghcide.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem]
290-
result prefix fp cnts = do
291-
runMaybeT context >>= \case
320+
completerRecorder = cmapWithPrio LogCompletions recorder
321+
322+
produceCompletions :: Ghcide.PosPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem]
323+
produceCompletions prefix fp fields = do
324+
runMaybeT (context fields) >>= \case
292325
Nothing -> pure []
293326
Just ctx -> do
294327
logWith recorder Debug $ LogCompletionContext ctx pos
295328
let completer = Completions.contextToCompleter ctx
296329
let completerData = CompleterTypes.CompleterData
297330
{ getLatestGPD = do
298-
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.GetCabalDiagnostics $ toNormalizedFilePath fp
331+
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp
299332
pure $ fmap fst mGPD
300333
, cabalPrefixInfo = prefInfo
301334
, stanzaName =
@@ -306,7 +339,6 @@ completion recorder ide _ complParams = do
306339
completions <- completer completerRecorder completerData
307340
pure completions
308341
where
309-
completerRecorder = cmapWithPrio LogCompletions recorder
310342
pos = Ghcide.cursorPos prefix
311-
context = Completions.getContext completerRecorder prefInfo (cnts ^. VFS.file_text)
343+
context fields = Completions.getContext completerRecorder prefInfo fields
312344
prefInfo = Completions.getCabalPrefixInfo fp prefix

0 commit comments

Comments
 (0)