Skip to content

Commit ce486f7

Browse files
dyniecfendorVeryMilkyJoe
authored
Add codeactions for cabal field names (#3273)
Add code action for incorrect field names in cabal files The codeactions will suggest possible corrections for unknown field names in a cabal file. --------- Co-authored-by: Fendor <[email protected]> Co-authored-by: Jana Chadt <[email protected]>
1 parent d331019 commit ce486f7

File tree

7 files changed

+296
-85
lines changed

7 files changed

+296
-85
lines changed

‎haskell-language-server.cabal

+2
Original file line numberDiff line numberDiff line change
@@ -242,6 +242,7 @@ library hls-cabal-plugin
242242
Ide.Plugin.Cabal.Completion.Completions
243243
Ide.Plugin.Cabal.Completion.Data
244244
Ide.Plugin.Cabal.Completion.Types
245+
Ide.Plugin.Cabal.FieldSuggest
245246
Ide.Plugin.Cabal.LicenseSuggest
246247
Ide.Plugin.Cabal.Orphans
247248
Ide.Plugin.Cabal.Parse
@@ -285,6 +286,7 @@ test-suite hls-cabal-plugin-tests
285286
, base
286287
, bytestring
287288
, Cabal-syntax >= 3.7
289+
, extra
288290
, filepath
289291
, ghcide
290292
, haskell-language-server:hls-cabal-plugin

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

+69-35
Original file line numberDiff line numberDiff line change
@@ -19,14 +19,14 @@ import Data.HashMap.Strict (HashMap)
1919
import qualified Data.HashMap.Strict as HashMap
2020
import qualified Data.List.NonEmpty as NE
2121
import qualified Data.Maybe as Maybe
22+
import qualified Data.Text as T
2223
import qualified Data.Text.Encoding as Encoding
2324
import Data.Typeable
2425
import Development.IDE as D
2526
import Development.IDE.Core.Shake (restartShakeSession)
2627
import qualified Development.IDE.Core.Shake as Shake
2728
import Development.IDE.Graph (Key, alwaysRerun)
2829
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
29-
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
3030
import Development.IDE.Types.Shake (toKey)
3131
import qualified Distribution.Fields as Syntax
3232
import qualified Distribution.Parsec.Position as Syntax
@@ -38,6 +38,7 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSe
3838
ParseCabalFile (..))
3939
import qualified Ide.Plugin.Cabal.Completion.Types as Types
4040
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
41+
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
4142
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
4243
import Ide.Plugin.Cabal.Orphans ()
4344
import qualified Ide.Plugin.Cabal.Parse as Parse
@@ -89,6 +90,7 @@ descriptor recorder plId =
8990
mconcat
9091
[ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
9192
, mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
93+
, mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
9294
]
9395
, pluginNotificationHandlers =
9496
mconcat
@@ -238,6 +240,41 @@ licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifie
238240
maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.suggestLicense" ideState getClientConfigAction
239241
pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction maxCompls uri)
240242

243+
-- | CodeActions for correcting field names with typos in them.
244+
--
245+
-- Provides CodeActions that fix typos in both stanzas and top-level field names.
246+
-- The suggestions are computed based on the completion context, where we "move" a fake cursor
247+
-- to the end of the field name and trigger cabal file completions. The completions are then
248+
-- suggested to the user.
249+
--
250+
-- TODO: Relying on completions here often does not produce the desired results, we should
251+
-- use some sort of fuzzy matching in the future, see issue #4357.
252+
fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
253+
fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
254+
vfileM <- lift (pluginGetVirtualFile $ toNormalizedUri uri)
255+
case (,) <$> vfileM <*> uriToFilePath' uri of
256+
Nothing -> pure $ InL []
257+
Just (vfile, path) -> do
258+
-- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested.
259+
-- In case it fails, we still will get some completion results instead of an error.
260+
mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields $ toNormalizedFilePath path
261+
case mFields of
262+
Nothing ->
263+
pure $ InL []
264+
Just (cabalFields, _) -> do
265+
let fields = Maybe.mapMaybe FieldSuggest.fieldErrorName diags
266+
results <- forM fields (getSuggestion vfile path cabalFields)
267+
pure $ InL $ map InR $ concat results
268+
where
269+
getSuggestion vfile fp cabalFields (fieldName,Diagnostic{ _range=_range@(Range (Position lineNr col) _) }) = do
270+
let -- Compute where we would anticipate the cursor to be.
271+
fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName))
272+
lspPrefixInfo = Ghcide.getCompletionPrefix fakeLspCursorPosition vfile
273+
cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo
274+
completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields
275+
let completionTexts = fmap (^. JL.label) completions
276+
pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
277+
241278
-- ----------------------------------------------------------------
242279
-- Cabal file of Interest rules and global variable
243280
-- ----------------------------------------------------------------
@@ -319,7 +356,7 @@ deleteFileOfInterest recorder state f = do
319356

320357
completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion
321358
completion recorder ide _ complParams = do
322-
let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument
359+
let TextDocumentIdentifier uri = complParams ^. JL.textDocument
323360
position = complParams ^. JL.position
324361
mVf <- lift $ pluginGetVirtualFile $ toNormalizedUri uri
325362
case (,) <$> mVf <*> uriToFilePath' uri of
@@ -331,39 +368,36 @@ completion recorder ide _ complParams = do
331368
Nothing ->
332369
pure . InR $ InR Null
333370
Just (fields, _) -> do
334-
let pref = Ghcide.getCompletionPrefix position cnts
335-
let res = produceCompletions pref path fields
371+
let lspPrefInfo = Ghcide.getCompletionPrefix position cnts
372+
cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo
373+
let res = computeCompletionsAt recorder ide cabalPrefInfo path fields
336374
liftIO $ fmap InL res
337375
Nothing -> pure . InR $ InR Null
338-
where
339-
completerRecorder = cmapWithPrio LogCompletions recorder
340-
341-
produceCompletions :: Ghcide.PosPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem]
342-
produceCompletions prefix fp fields = do
343-
runMaybeT (context fields) >>= \case
344-
Nothing -> pure []
345-
Just ctx -> do
346-
logWith recorder Debug $ LogCompletionContext ctx pos
347-
let completer = Completions.contextToCompleter ctx
348-
let completerData = CompleterTypes.CompleterData
349-
{ getLatestGPD = do
350-
-- We decide on useWithStaleFast here, since we mostly care about the file's meta information,
351-
-- thus, a quick response gives us the desired result most of the time.
352-
-- The `withStale` option is very important here, since we often call this rule with invalid cabal files.
353-
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp
354-
pure $ fmap fst mGPD
355-
, getCabalCommonSections = do
356-
mSections <- runIdeAction "cabal-plugin.modulesCompleter.commonsections" (shakeExtras ide) $ useWithStaleFast ParseCabalCommonSections $ toNormalizedFilePath fp
357-
pure $ fmap fst mSections
358-
, cabalPrefixInfo = prefInfo
359-
, stanzaName =
360-
case fst ctx of
361-
Types.Stanza _ name -> name
362-
_ -> Nothing
363-
}
364-
completions <- completer completerRecorder completerData
365-
pure completions
366-
where
367-
pos = Ghcide.cursorPos prefix
376+
377+
computeCompletionsAt :: Recorder (WithPriority Log) -> IdeState -> Types.CabalPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem]
378+
computeCompletionsAt recorder ide prefInfo fp fields = do
379+
runMaybeT (context fields) >>= \case
380+
Nothing -> pure []
381+
Just ctx -> do
382+
logWith recorder Debug $ LogCompletionContext ctx pos
383+
let completer = Completions.contextToCompleter ctx
384+
let completerData = CompleterTypes.CompleterData
385+
{ getLatestGPD = do
386+
-- We decide on useWithStaleFast here, since we mostly care about the file's meta information,
387+
-- thus, a quick response gives us the desired result most of the time.
388+
-- The `withStale` option is very important here, since we often call this rule with invalid cabal files.
389+
mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp
390+
pure $ fmap fst mGPD
391+
, getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections $ toNormalizedFilePath fp
392+
, cabalPrefixInfo = prefInfo
393+
, stanzaName =
394+
case fst ctx of
395+
Types.Stanza _ name -> name
396+
_ -> Nothing
397+
}
398+
completions <- completer completerRecorder completerData
399+
pure completions
400+
where
401+
pos = Types.completionCursorPosition prefInfo
368402
context fields = Completions.getContext completerRecorder prefInfo fields
369-
prefInfo = Completions.getCabalPrefixInfo fp prefix
403+
completerRecorder = cmapWithPrio LogCompletions recorder

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

+70
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE ExplicitNamespaces #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE LambdaCase #-}
5+
{-# LANGUAGE OverloadedStrings #-}
6+
7+
module Ide.Plugin.Cabal.FieldSuggest
8+
( fieldErrorName,
9+
fieldErrorAction,
10+
-- * Re-exports
11+
T.Text,
12+
Diagnostic (..),
13+
)
14+
where
15+
16+
import qualified Data.Map.Strict as Map
17+
import qualified Data.Text as T
18+
import Language.LSP.Protocol.Types (CodeAction (..),
19+
CodeActionKind (..),
20+
Diagnostic (..), Position (..),
21+
Range (..), TextEdit (..), Uri,
22+
WorkspaceEdit (..))
23+
import Text.Regex.TDFA
24+
25+
-- | Generate all code actions for given file, erroneous/unknown field and suggestions
26+
fieldErrorAction
27+
:: Uri
28+
-- ^ File for which the diagnostic was generated
29+
-> T.Text
30+
-- ^ Original (unknown) field
31+
-> [T.Text]
32+
-- ^ Suggestions for the given file
33+
-> Range
34+
-- ^ Location of diagnostic
35+
-> [CodeAction]
36+
fieldErrorAction uri original suggestions range =
37+
fmap mkCodeAction suggestions
38+
where
39+
mkCodeAction suggestion =
40+
let
41+
-- Range returned by cabal here represents fragment from start of offending identifier
42+
-- to end of line, we modify this range to be to the end of the identifier
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']
47+
edit = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing
48+
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
52+
53+
-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
54+
-- if it represents an "Unknown field"-error with incorrect identifier
55+
-- then return the incorrect identifier together with original diagnostics.
56+
fieldErrorName ::
57+
Diagnostic ->
58+
-- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
59+
Maybe (T.Text, Diagnostic)
60+
-- ^ Original (incorrect) field name with the suggested replacement
61+
fieldErrorName diag =
62+
mSuggestion (_message diag) >>= \case
63+
[original] -> Just (original, diag)
64+
_ -> Nothing
65+
where
66+
regex :: T.Text
67+
regex = "Unknown field: \"(.*)\""
68+
mSuggestion msg = getMatch <$> (msg :: T.Text) =~~ regex
69+
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text]
70+
getMatch (_, _, _, results) = results

0 commit comments

Comments
 (0)