Skip to content

Commit b6282fb

Browse files
dyniecfendor
dyniec
authored and
fendor
committed
Use context in code actions for cabal files
1 parent 6932df5 commit b6282fb

File tree

2 files changed

+95
-78
lines changed

2 files changed

+95
-78
lines changed

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

Lines changed: 52 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ import Development.IDE.Core.Shake (restartShakeSessio
2626
import qualified Development.IDE.Core.Shake as Shake
2727
import Development.IDE.Graph (alwaysRerun)
2828
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
29-
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
3029
import GHC.Generics
3130
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
3231
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
@@ -41,6 +40,9 @@ import qualified Language.LSP.Protocol.Message as LSP
4140
import Language.LSP.Protocol.Types
4241
import Language.LSP.Server (getVirtualFile)
4342
import qualified Language.LSP.VFS as VFS
43+
import qualified Data.Text as T
44+
import Data.Maybe (mapMaybe)
45+
import Data.Text.Utf16.Rope.Mixed (Rope)
4446

4547
data Log
4648
= LogModificationTime NormalizedFilePath FileVersion
@@ -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
@@ -199,9 +201,26 @@ licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumen
199201
licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) =
200202
pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction uri)
201203

202-
fieldSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
203-
fieldSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) =
204-
pure $ InL $ diags >>= (fmap InR . FieldSuggest.fieldErrorAction uri)
204+
-- | CodeActions for misspelled fields in cabal files
205+
-- both for toplevel fields, and fields in stanzas.
206+
-- uses same logic as completions but reacts on diagnostics from cabal
207+
fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
208+
fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
209+
vfileM <- lift (getVirtualFile $ toNormalizedUri uri)
210+
case liftA2 (,) vfileM (uriToFilePath' uri) of
211+
Nothing -> pure $ InL []
212+
Just (vfile, path) -> do
213+
let fields = mapMaybe FieldSuggest.fieldErrorName diags
214+
results <- forM fields (getSuggestion vfile path)
215+
pure $ InL $ map InR $ concat results
216+
where
217+
getSuggestion vfile fp (field,Diagnostic{ _range=_range@(Range (Position lineNr col) _) })= do
218+
let fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length field))
219+
lspPrefixInfo = Ghcide.getCompletionPrefix fakeLspCursorPosition vfile
220+
cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo
221+
completions <- liftIO $ computeCompletionsAt recorder cabalPrefixInfo (vfile ^. VFS.file_text) (shakeExtras ide)
222+
let completionTexts = (fmap (^. JL.label) completions)
223+
pure $ FieldSuggest.fieldErrorAction uri field completionTexts _range
205224

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

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

Lines changed: 43 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -1,67 +1,65 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2-
{-# LANGUAGE ExplicitNamespaces #-}
3-
{-# LANGUAGE FlexibleContexts #-}
4-
{-# LANGUAGE LambdaCase #-}
5-
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE ExplicitNamespaces #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE LambdaCase #-}
5+
{-# 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

15-
import qualified Data.Map.Strict as Map
16-
import qualified Data.Text as T
17-
import Language.LSP.Protocol.Types (CodeAction (CodeAction),
18-
CodeActionKind (..),
19-
Diagnostic (..),
20-
Position (Position),
21-
Range (Range),
22-
TextEdit (TextEdit), Uri,
23-
WorkspaceEdit (WorkspaceEdit))
24-
import Text.Regex.TDFA
16+
import qualified Data.Text as T
17+
import Language.LSP.Protocol.Types
18+
( Diagnostic (..), CodeAction(..), Range(..), Uri, Position (..), WorkspaceEdit (..), TextEdit (..), CodeActionKind (..),
19+
)
20+
import Text.Regex.TDFA
21+
import qualified Data.Map.Strict as Map
2522

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
23+
-- | Generate all code action for given file, error field in position and suggestions
3124
fieldErrorAction
3225
:: Uri
3326
-- ^ File for which the diagnostic was generated
34-
-> Diagnostic
35-
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
27+
-> T.Text
28+
-- ^ Original field
29+
-> [T.Text]
30+
-- ^ Suggestions
31+
-> Range
32+
-- ^ location of diagnostic
3633
-> [CodeAction]
37-
fieldErrorAction uri diag =
38-
mkCodeAction <$> fieldErrorSuggestion diag
34+
fieldErrorAction uri original suggestions range =
35+
fmap mkCodeAction suggestions
3936
where
40-
mkCodeAction (original, suggestion) =
37+
mkCodeAction suggestion =
4138
let
4239
-- Range returned by cabal here represents fragment from start of
4340
-- 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]
41+
adjustRange (Range rangeFrom@(Position lineNr col) _) =
42+
Range rangeFrom (Position lineNr (col + fromIntegral (T.length original)))
43+
title = "Replace with " <> suggestion'
44+
tedit = [TextEdit (adjustRange range ) suggestion']
4845
edit = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing
4946
in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Just edit) Nothing Nothing
47+
where
48+
-- dropping colon from the end of suggestion
49+
suggestion' = T.dropEnd 1 suggestion
5050

5151
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
5252
-- 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
58-
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
59-
-> [(T.Text, T.Text)]
60-
-- ^ (Original (incorrect) license identifier, suggested replacement)
61-
fieldErrorSuggestion diag =
53+
-- then return the incorrect identifier together with original diagnostics.
54+
fieldErrorName ::
55+
-- | Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
56+
Diagnostic ->
57+
-- | (Original (incorrect) license identifier, suggested replacement)
58+
Maybe (T.Text, Diagnostic)
59+
fieldErrorName diag =
6260
mSuggestion (_message diag) >>= \case
63-
[original] -> [(original, "name")]
64-
_ -> []
61+
[original] -> Just (original, diag)
62+
_ -> Nothing
6563
where
6664
regex :: T.Text
6765
regex = "Unknown field: \"(.*)\""

0 commit comments

Comments
 (0)