Skip to content

Commit 8f88d3d

Browse files
dyniecfendor
dyniec
authored and
fendor
committed
Use context in code actions for cabal files
1 parent e058a35 commit 8f88d3d

File tree

3 files changed

+95
-72
lines changed

3 files changed

+95
-72
lines changed

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

Lines changed: 57 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -18,22 +18,24 @@ import Data.Hashable
1818
import Data.HashMap.Strict (HashMap)
1919
import qualified Data.HashMap.Strict as HashMap
2020
import qualified Data.List.NonEmpty as NE
21+
import Data.Maybe (mapMaybe)
22+
import qualified Data.Text as T
2123
import qualified Data.Text.Encoding as Encoding
24+
import Data.Text.Utf16.Rope.Mixed (Rope)
2225
import Data.Typeable
2326
import Development.IDE as D
2427
import Development.IDE.Core.Shake (restartShakeSession)
2528
import qualified Development.IDE.Core.Shake as Shake
2629
import Development.IDE.Graph (Key, alwaysRerun)
2730
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
28-
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
2931
import Development.IDE.Types.Shake (toKey)
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
3335
import qualified Ide.Plugin.Cabal.Completion.Types as Types
3436
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
35-
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
3637
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
38+
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
3739
import qualified Ide.Plugin.Cabal.Parse as Parse
3840
import Ide.Types
3941
import qualified Language.LSP.Protocol.Lens as JL
@@ -84,7 +86,7 @@ descriptor recorder plId =
8486
mconcat
8587
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
8688
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
87-
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction fieldSuggestCodeAction
89+
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
8890
]
8991
, pluginNotificationHandlers =
9092
mconcat
@@ -200,9 +202,30 @@ licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumen
200202
licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) =
201203
pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction uri)
202204

203-
fieldSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
204-
fieldSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) =
205-
pure $ InL $ diags >>= (fmap InR . FieldSuggest.fieldErrorAction uri)
205+
-- | CodeActions for correcting field names with typos in them.
206+
--
207+
-- Provides CodeActions that fix typos in field names, in both stanzas and top-level field names.
208+
-- The suggestions are computed based on the completion context, where we "move" a fake cursor
209+
-- to the end of the field name and trigger cabal file completions. The completions are then
210+
-- suggested to the user.
211+
fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
212+
fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
213+
vfileM <- lift (getVirtualFile $ toNormalizedUri uri)
214+
case (,) <$> vfileM <*> uriToFilePath' uri of
215+
Nothing -> pure $ InL []
216+
Just (vfile, path) -> do
217+
let fields = mapMaybe FieldSuggest.fieldErrorName diags
218+
results <- forM fields (getSuggestion vfile path)
219+
pure $ InL $ map InR $ concat results
220+
where
221+
getSuggestion vfile fp (field,Diagnostic{ _range=_range@(Range (Position lineNr col) _) })= do
222+
let -- Compute where we would anticipate the cursor to be.
223+
fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length field))
224+
lspPrefixInfo = Ghcide.getCompletionPrefix fakeLspCursorPosition vfile
225+
cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo
226+
completions <- liftIO $ computeCompletionsAt recorder cabalPrefixInfo fp (vfile ^. VFS.file_text) (shakeExtras ide)
227+
let completionTexts = (fmap (^. JL.label) completions)
228+
pure $ FieldSuggest.fieldErrorAction uri field completionTexts _range
206229

207230
-- ----------------------------------------------------------------
208231
-- Cabal file of Interest rules and global variable
@@ -290,32 +313,32 @@ completion recorder ide _ complParams = do
290313
contents <- lift $ getVirtualFile $ toNormalizedUri uri
291314
case (contents, uriToFilePath' uri) of
292315
(Just cnts, Just path) -> do
293-
let pref = Ghcide.getCompletionPrefix position cnts
294-
let res = result pref path cnts
295-
liftIO $ fmap InL res
316+
let lspPrefixInfo = Ghcide.getCompletionPrefix position cnts
317+
cabalPrefixInfo = Completions.getCabalPrefixInfo path lspPrefixInfo
318+
let compls = computeCompletionsAt recorder cabalPrefixInfo path (cnts ^. VFS.file_text) (shakeExtras ide)
319+
liftIO $ fmap InL compls
296320
_ -> pure . InR $ InR Null
297-
where
298-
result :: Ghcide.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem]
299-
result prefix fp cnts = do
300-
runMaybeT context >>= \case
301-
Nothing -> pure []
302-
Just ctx -> do
303-
logWith recorder Debug $ LogCompletionContext ctx pos
304-
let completer = Completions.contextToCompleter ctx
305-
let completerData = CompleterTypes.CompleterData
306-
{ getLatestGPD = do
307-
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast Types.GetCabalDiagnostics $ toNormalizedFilePath fp
308-
pure $ fmap fst mGPD
309-
, cabalPrefixInfo = prefInfo
310-
, stanzaName =
311-
case fst ctx of
312-
Types.Stanza _ name -> name
313-
_ -> Nothing
314-
}
315-
completions <- completer completerRecorder completerData
316-
pure completions
317-
where
318-
completerRecorder = cmapWithPrio LogCompletions recorder
319-
pos = Ghcide.cursorPos prefix
320-
context = Completions.getContext completerRecorder prefInfo (cnts ^. VFS.file_text)
321-
prefInfo = Completions.getCabalPrefixInfo fp prefix
321+
322+
computeCompletionsAt :: Recorder (WithPriority Log) -> Types.CabalPrefixInfo -> FilePath -> Rope -> ShakeExtras -> IO [CompletionItem]
323+
computeCompletionsAt recorder cabalPrefixInfo fp fileRope extras = do
324+
runMaybeT context >>= \case
325+
Nothing -> pure []
326+
Just ctx -> do
327+
logWith recorder Debug $ LogCompletionContext ctx pos
328+
let completer = Completions.contextToCompleter ctx
329+
let completerData = CompleterTypes.CompleterData
330+
{ getLatestGPD = do
331+
mGPD <- runIdeAction "computeCompletionsAt.gpd" extras $ useWithStaleFast Types.GetCabalDiagnostics $ toNormalizedFilePath fp
332+
pure $ fmap fst mGPD
333+
, cabalPrefixInfo = cabalPrefixInfo
334+
, stanzaName =
335+
case fst ctx of
336+
Types.Stanza _ name -> name
337+
_ -> Nothing
338+
}
339+
completions <- completer completerRecorder completerData
340+
pure completions
341+
where
342+
completerRecorder = cmapWithPrio LogCompletions recorder
343+
pos = Types.completionCursorPosition cabalPrefixInfo
344+
context = Completions.getContext completerRecorder cabalPrefixInfo fileRope

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

Lines changed: 37 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -3,65 +3,65 @@
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE LambdaCase #-}
55
{-# LANGUAGE OverloadedStrings #-}
6+
67
module Ide.Plugin.Cabal.FieldSuggest
7-
( fieldErrorSuggestion
8-
, fieldErrorAction
9-
-- * Re-exports
10-
, T.Text
11-
, Diagnostic(..)
12-
)
8+
( fieldErrorName,
9+
fieldErrorAction,
10+
-- * Re-exports
11+
T.Text,
12+
Diagnostic (..),
13+
)
1314
where
1415

1516
import qualified Data.Map.Strict as Map
1617
import qualified Data.Text as T
17-
import Language.LSP.Protocol.Types (CodeAction (CodeAction),
18+
import Language.LSP.Protocol.Types (CodeAction (..),
1819
CodeActionKind (..),
19-
Diagnostic (..),
20-
Position (Position),
21-
Range (Range),
22-
TextEdit (TextEdit), Uri,
23-
WorkspaceEdit (WorkspaceEdit))
20+
Diagnostic (..), Position (..),
21+
Range (..), TextEdit (..), Uri,
22+
WorkspaceEdit (..))
2423
import Text.Regex.TDFA
2524

26-
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
27-
-- if it represents an "Unknown field"-error along
28-
-- with a incorrect field, then return a 'CodeAction' for replacing the
29-
-- the incorrect field with the suggestion.
30-
-- It should be context sensitive, but for now it isn't
25+
-- | Generate all code action for given file, error field in position and suggestions
3126
fieldErrorAction
3227
:: Uri
3328
-- ^ File for which the diagnostic was generated
34-
-> Diagnostic
35-
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
36-
-> [CodeAction]
37-
fieldErrorAction uri diag =
38-
mkCodeAction <$> fieldErrorSuggestion diag
29+
-> T.Text
30+
-- ^ Original field
31+
-> [T.Text]
32+
-- ^ Suggestions
33+
-> Range
34+
-- ^ Location of diagnostic
35+
-> [CodeAction]
36+
fieldErrorAction uri original suggestions range =
37+
fmap mkCodeAction suggestions
3938
where
40-
mkCodeAction (original, suggestion) =
39+
mkCodeAction suggestion =
4140
let
4241
-- Range returned by cabal here represents fragment from start of
4342
-- offending identifier to end of line, we modify it to the end of identifier
44-
adjustRange (Range rangeFrom@(Position line col) _) =
45-
Range rangeFrom (Position line (col + fromIntegral (T.length original)))
46-
title = "Replace with " <> suggestion
47-
tedit = [TextEdit (adjustRange $ _range diag) suggestion]
43+
adjustRange (Range rangeFrom@(Position lineNr col) _) =
44+
Range rangeFrom (Position lineNr (col + fromIntegral (T.length original)))
45+
title = "Replace with " <> suggestion'
46+
tedit = [TextEdit (adjustRange range ) suggestion']
4847
edit = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing
4948
in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Just edit) Nothing Nothing
49+
where
50+
-- dropping colon from the end of suggestion
51+
suggestion' = T.dropEnd 1 suggestion
5052

5153
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
5254
-- if it represents an "Unknown field"- error with incorrect identifier
53-
-- then return the suggestion (for now placeholder "name")
54-
-- along with the incorrect identifier.
55-
--
56-
fieldErrorSuggestion
57-
:: Diagnostic
55+
-- then return the incorrect identifier together with original diagnostics.
56+
fieldErrorName ::
57+
Diagnostic ->
5858
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
59-
-> [(T.Text, T.Text)]
60-
-- ^ (Original (incorrect) license identifier, suggested replacement)
61-
fieldErrorSuggestion diag =
59+
Maybe (T.Text, Diagnostic)
60+
-- ^ Original (incorrect) field name with the suggested replacement
61+
fieldErrorName diag =
6262
mSuggestion (_message diag) >>= \case
63-
[original] -> [(original, "name")]
64-
_ -> []
63+
[original] -> Just (original, diag)
64+
_ -> Nothing
6565
where
6666
regex :: T.Text
6767
regex = "Unknown field: \"(.*)\""

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ licenseErrorSuggestion ::
7272
T.Text
7373
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
7474
-> [(T.Text, T.Text)]
75-
-- ^ (Original (incorrect) license identifier, suggested replacement)
75+
-- ^ Original (incorrect) license identifier with the suggested replacement
7676
licenseErrorSuggestion msg =
7777
(getMatch <$> msg =~~ regex) >>= \case
7878
[original] ->

0 commit comments

Comments
 (0)