From 881bcc8dbc24918565c00ec33df53126ae3e7a1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Dybiec?= Date: Sat, 8 Oct 2022 10:57:56 +0200 Subject: [PATCH 1/4] Add code action for incorrect field names --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 6 ++ .../src/Ide/Plugin/Cabal/FieldSuggest.hs | 70 +++++++++++++++++++ 3 files changed, 77 insertions(+) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 8aac08c0ab..dccd2ed6b3 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -242,6 +242,7 @@ library hls-cabal-plugin Ide.Plugin.Cabal.Completion.Completions Ide.Plugin.Cabal.Completion.Data Ide.Plugin.Cabal.Completion.Types + Ide.Plugin.Cabal.FieldSuggest Ide.Plugin.Cabal.LicenseSuggest Ide.Plugin.Cabal.Orphans Ide.Plugin.Cabal.Parse diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 3c471a21b7..67e2043f5c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -40,6 +40,7 @@ import qualified Ide.Plugin.Cabal.Completion.Types as Types import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () +import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest import qualified Ide.Plugin.Cabal.Parse as Parse import Ide.Types import qualified Language.LSP.Protocol.Lens as JL @@ -89,6 +90,7 @@ descriptor recorder plId = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder + , mkPluginHandler LSP.SMethod_TextDocumentCodeAction fieldSuggestCodeAction ] , pluginNotificationHandlers = mconcat @@ -238,6 +240,10 @@ licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifie maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.suggestLicense" ideState getClientConfigAction pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction maxCompls uri) +fieldSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction +fieldSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = + pure $ InL $ diags >>= (fmap InR . FieldSuggest.fieldErrorAction uri) + -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable -- ---------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs new file mode 100644 index 0000000000..fd9472e702 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +module Ide.Plugin.Cabal.FieldSuggest +( fieldErrorSuggestion +, fieldErrorAction + -- * Re-exports +, T.Text +, Diagnostic(..) +) +where + +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import Language.LSP.Protocol.Types (CodeAction (CodeAction), + CodeActionKind (..), + Diagnostic (..), + Position (Position), + Range (Range), + TextEdit (TextEdit), Uri, + WorkspaceEdit (WorkspaceEdit)) +import Text.Regex.TDFA + +-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', +-- if it represents an "Unknown field"-error along +-- with a incorrect field, then return a 'CodeAction' for replacing the +-- the incorrect field with the suggestion. +-- It should be context sensitive, but for now it isn't +fieldErrorAction + :: Uri + -- ^ File for which the diagnostic was generated + -> Diagnostic + -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' + -> [CodeAction] +fieldErrorAction uri diag = + mkCodeAction <$> fieldErrorSuggestion diag + where + mkCodeAction (original, suggestion) = + let + -- Range returned by cabal here represents fragment from start of + -- offending identifier to end of line, we modify it to the end of identifier + adjustRange (Range rangeFrom@(Position line col) _) = + Range rangeFrom (Position line (col + fromIntegral (T.length original))) + title = "Replace with " <> suggestion + tedit = [TextEdit (adjustRange $ _range diag) suggestion] + edit = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing + in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Just edit) Nothing Nothing + +-- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', +-- if it represents an "Unknown field"- error with incorrect identifier +-- then return the suggestion (for now placeholder "name") +-- along with the incorrect identifier. +-- +fieldErrorSuggestion + :: Diagnostic + -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' + -> [(T.Text, T.Text)] + -- ^ (Original (incorrect) license identifier, suggested replacement) +fieldErrorSuggestion diag = + mSuggestion (_message diag) >>= \case + [original] -> [(original, "name")] + _ -> [] + where + regex :: T.Text + regex = "Unknown field: \"(.*)\"" + mSuggestion msg = getMatch <$> (msg :: T.Text) =~~ regex + getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> [T.Text] + getMatch (_, _, _, results) = results From b0e9815e16aefc1663ad1711a2334a07273023b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Dybiec?= Date: Sat, 8 Oct 2022 15:50:57 +0200 Subject: [PATCH 2/4] Use context in code actions for cabal files --- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 102 +++++++++++------- .../src/Ide/Plugin/Cabal/FieldSuggest.hs | 74 ++++++------- 2 files changed, 100 insertions(+), 76 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 67e2043f5c..d711b67019 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -19,6 +19,7 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe +import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding import Data.Typeable import Development.IDE as D @@ -26,7 +27,6 @@ import Development.IDE.Core.Shake (restartShakeSessio import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph (Key, alwaysRerun) import qualified Development.IDE.Plugin.Completions.Logic as Ghcide -import qualified Development.IDE.Plugin.Completions.Types as Ghcide import Development.IDE.Types.Shake (toKey) import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax @@ -90,7 +90,7 @@ descriptor recorder plId = mconcat [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder - , mkPluginHandler LSP.SMethod_TextDocumentCodeAction fieldSuggestCodeAction + , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder ] , pluginNotificationHandlers = mconcat @@ -240,9 +240,37 @@ licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifie maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal-plugin.suggestLicense" ideState getClientConfigAction pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction maxCompls uri) -fieldSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction -fieldSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) = - pure $ InL $ diags >>= (fmap InR . FieldSuggest.fieldErrorAction uri) +-- | CodeActions for correcting field names with typos in them. +-- +-- Provides CodeActions that fix typos in field names, in both stanzas and top-level field names. +-- The suggestions are computed based on the completion context, where we "move" a fake cursor +-- to the end of the field name and trigger cabal file completions. The completions are then +-- suggested to the user. +fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction +fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do + vfileM <- lift (pluginGetVirtualFile $ toNormalizedUri uri) + case (,) <$> vfileM <*> uriToFilePath' uri of + Nothing -> pure $ InL [] + Just (vfile, path) -> do + -- We decide on `useWithStale` here, since `useWithStaleFast` often leads to the wrong completions being suggested. + -- In case it fails, we still will get some completion results instead of an error. + mFields <- liftIO $ runAction "cabal-plugin.fields" ide $ useWithStale ParseCabalFields $ toNormalizedFilePath path + case mFields of + Nothing -> + pure $ InL [] + Just (cabalFields, _) -> do + let fields = Maybe.mapMaybe FieldSuggest.fieldErrorName diags + results <- forM fields (getSuggestion vfile path cabalFields) + pure $ InL $ map InR $ concat results + where + getSuggestion vfile fp cabalFields (fieldName,Diagnostic{ _range=_range@(Range (Position lineNr col) _) }) = do + let -- Compute where we would anticipate the cursor to be. + fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length fieldName)) + lspPrefixInfo = Ghcide.getCompletionPrefix fakeLspCursorPosition vfile + cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo + completions <- liftIO $ computeCompletionsAt recorder ide cabalPrefixInfo fp cabalFields + let completionTexts = fmap (^. JL.label) completions + pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range -- ---------------------------------------------------------------- -- Cabal file of Interest rules and global variable @@ -325,7 +353,7 @@ deleteFileOfInterest recorder state f = do completion :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCompletion completion recorder ide _ complParams = do - let (TextDocumentIdentifier uri) = complParams ^. JL.textDocument + let TextDocumentIdentifier uri = complParams ^. JL.textDocument position = complParams ^. JL.position mVf <- lift $ pluginGetVirtualFile $ toNormalizedUri uri case (,) <$> mVf <*> uriToFilePath' uri of @@ -337,39 +365,35 @@ completion recorder ide _ complParams = do Nothing -> pure . InR $ InR Null Just (fields, _) -> do - let pref = Ghcide.getCompletionPrefix position cnts - let res = produceCompletions pref path fields + let lspPrefInfo = Ghcide.getCompletionPrefix position cnts + cabalPrefInfo = Completions.getCabalPrefixInfo path lspPrefInfo + let res = computeCompletionsAt recorder ide cabalPrefInfo path fields liftIO $ fmap InL res Nothing -> pure . InR $ InR Null - where - completerRecorder = cmapWithPrio LogCompletions recorder - - produceCompletions :: Ghcide.PosPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem] - produceCompletions prefix fp fields = do - runMaybeT (context fields) >>= \case - Nothing -> pure [] - Just ctx -> do - logWith recorder Debug $ LogCompletionContext ctx pos - let completer = Completions.contextToCompleter ctx - let completerData = CompleterTypes.CompleterData - { getLatestGPD = do - -- We decide on useWithStaleFast here, since we mostly care about the file's meta information, - -- thus, a quick response gives us the desired result most of the time. - -- The `withStale` option is very important here, since we often call this rule with invalid cabal files. - mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp - pure $ fmap fst mGPD - , getCabalCommonSections = do - mSections <- runIdeAction "cabal-plugin.modulesCompleter.commonsections" (shakeExtras ide) $ useWithStaleFast ParseCabalCommonSections $ toNormalizedFilePath fp - pure $ fmap fst mSections - , cabalPrefixInfo = prefInfo - , stanzaName = - case fst ctx of - Types.Stanza _ name -> name - _ -> Nothing - } - completions <- completer completerRecorder completerData - pure completions - where - pos = Ghcide.cursorPos prefix + +computeCompletionsAt :: Recorder (WithPriority Log) -> IdeState -> Types.CabalPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem] +computeCompletionsAt recorder ide prefInfo fp fields = do + runMaybeT (context fields) >>= \case + Nothing -> pure [] + Just ctx -> do + logWith recorder Debug $ LogCompletionContext ctx pos + let completer = Completions.contextToCompleter ctx + let completerData = CompleterTypes.CompleterData + { getLatestGPD = do + -- We decide on useWithStaleFast here, since we mostly care about the file's meta information, + -- thus, a quick response gives us the desired result most of the time. + -- The `withStale` option is very important here, since we often call this rule with invalid cabal files. + mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp + pure $ fmap fst mGPD + , cabalPrefixInfo = prefInfo + , stanzaName = + case fst ctx of + Types.Stanza _ name -> name + _ -> Nothing + } + completions <- completer completerRecorder completerData + pure completions + where + pos = Types.completionCursorPosition prefInfo context fields = Completions.getContext completerRecorder prefInfo fields - prefInfo = Completions.getCabalPrefixInfo fp prefix + completerRecorder = cmapWithPrio LogCompletions recorder diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs index fd9472e702..5d2909b3c6 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs @@ -3,65 +3,65 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} + module Ide.Plugin.Cabal.FieldSuggest -( fieldErrorSuggestion -, fieldErrorAction - -- * Re-exports -, T.Text -, Diagnostic(..) -) + ( fieldErrorName, + fieldErrorAction, + -- * Re-exports + T.Text, + Diagnostic (..), + ) where import qualified Data.Map.Strict as Map import qualified Data.Text as T -import Language.LSP.Protocol.Types (CodeAction (CodeAction), +import Language.LSP.Protocol.Types (CodeAction (..), CodeActionKind (..), - Diagnostic (..), - Position (Position), - Range (Range), - TextEdit (TextEdit), Uri, - WorkspaceEdit (WorkspaceEdit)) + Diagnostic (..), Position (..), + Range (..), TextEdit (..), Uri, + WorkspaceEdit (..)) import Text.Regex.TDFA --- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', --- if it represents an "Unknown field"-error along --- with a incorrect field, then return a 'CodeAction' for replacing the --- the incorrect field with the suggestion. --- It should be context sensitive, but for now it isn't +-- | Generate all code action for given file, error field in position and suggestions fieldErrorAction :: Uri -- ^ File for which the diagnostic was generated - -> Diagnostic - -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' - -> [CodeAction] -fieldErrorAction uri diag = - mkCodeAction <$> fieldErrorSuggestion diag + -> T.Text + -- ^ Original field + -> [T.Text] + -- ^ Suggestions + -> Range + -- ^ Location of diagnostic + -> [CodeAction] +fieldErrorAction uri original suggestions range = + fmap mkCodeAction suggestions where - mkCodeAction (original, suggestion) = + mkCodeAction suggestion = let -- Range returned by cabal here represents fragment from start of -- offending identifier to end of line, we modify it to the end of identifier - adjustRange (Range rangeFrom@(Position line col) _) = - Range rangeFrom (Position line (col + fromIntegral (T.length original))) - title = "Replace with " <> suggestion - tedit = [TextEdit (adjustRange $ _range diag) suggestion] + adjustRange (Range rangeFrom@(Position lineNr col) _) = + Range rangeFrom (Position lineNr (col + fromIntegral (T.length original))) + title = "Replace with " <> suggestion' + tedit = [TextEdit (adjustRange range ) suggestion'] edit = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Just edit) Nothing Nothing + where + -- dropping colon from the end of suggestion + suggestion' = T.dropEnd 1 suggestion -- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', -- if it represents an "Unknown field"- error with incorrect identifier --- then return the suggestion (for now placeholder "name") --- along with the incorrect identifier. --- -fieldErrorSuggestion - :: Diagnostic +-- then return the incorrect identifier together with original diagnostics. +fieldErrorName :: + Diagnostic -> -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic' - -> [(T.Text, T.Text)] - -- ^ (Original (incorrect) license identifier, suggested replacement) -fieldErrorSuggestion diag = + Maybe (T.Text, Diagnostic) + -- ^ Original (incorrect) field name with the suggested replacement +fieldErrorName diag = mSuggestion (_message diag) >>= \case - [original] -> [(original, "name")] - _ -> [] + [original] -> Just (original, diag) + _ -> Nothing where regex :: T.Text regex = "Unknown field: \"(.*)\"" From 26d3622363fc18d01277942e4544dce4f458f35a Mon Sep 17 00:00:00 2001 From: Fendor Date: Mon, 27 May 2024 16:34:16 +0200 Subject: [PATCH 3/4] Add integration tests for field name code action fixes --- haskell-language-server.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 3 +- plugins/hls-cabal-plugin/test/Main.hs | 130 +++++++++++------- plugins/hls-cabal-plugin/test/Utils.hs | 3 + .../code-actions/FieldSuggestions.cabal | 37 +++++ .../FieldSuggestions.golden.cabal | 37 +++++ 6 files changed, 160 insertions(+), 51 deletions(-) create mode 100644 plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal create mode 100644 plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index dccd2ed6b3..24f7c9b8ba 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -286,6 +286,7 @@ test-suite hls-cabal-plugin-tests , base , bytestring , Cabal-syntax >= 3.7 + , extra , filepath , ghcide , haskell-language-server:hls-cabal-plugin diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index d711b67019..530273c3d5 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -38,9 +38,9 @@ import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSe ParseCabalFile (..)) import qualified Ide.Plugin.Cabal.Completion.Types as Types import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics +import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import Ide.Plugin.Cabal.Orphans () -import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest import qualified Ide.Plugin.Cabal.Parse as Parse import Ide.Types import qualified Language.LSP.Protocol.Lens as JL @@ -385,6 +385,7 @@ computeCompletionsAt recorder ide prefInfo fp fields = do -- The `withStale` option is very important here, since we often call this rule with invalid cabal files. mGPD <- runAction "cabal-plugin.modulesCompleter.gpd" ide $ useWithStale ParseCabalFile $ toNormalizedFilePath fp pure $ fmap fst mGPD + , getCabalCommonSections = runAction "cabal-plugin.commonSections" ide $ use ParseCabalCommonSections $ toNormalizedFilePath fp , cabalPrefixInfo = prefInfo , stanzaName = case fst ctx of diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 6488e71e16..734c3a3ca4 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -9,9 +9,12 @@ module Main ( import Completer (completerTests) import Context (contextTests) import Control.Lens ((^.)) +import Control.Lens.Fold ((^?)) import Control.Monad (guard) import qualified Data.ByteString as BS import Data.Either (isRight) +import Data.List.Extra (nubOrdOn) +import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Text as Text import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) @@ -30,6 +33,7 @@ main = do , pluginTests , completerTests , contextTests + , codeActionTests ] -- ------------------------------------------------------------------------ @@ -137,57 +141,83 @@ pluginTests = unknownLicenseDiag ^. L.range @?= Range (Position 3 24) (Position 4 0) unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error ] - , testGroup - "Code Actions" - [ runCabalTestCaseSession "BSD-3" "" $ do - doc <- openDoc "licenseCodeAction.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "cabal" - reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] - liftIO $ do - length diags @?= 1 - reduceDiag ^. L.range @?= Range (Position 3 24) (Position 4 0) - reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error - [codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) - executeCodeAction codeAction - contents <- documentContents doc - liftIO $ - contents - @?= Text.unlines - [ "cabal-version: 3.0" - , "name: licenseCodeAction" - , "version: 0.1.0.0" - , "license: BSD-3-Clause" - , "" - , "library" - , " build-depends: base" - , " default-language: Haskell2010" - ] - , runCabalTestCaseSession "Apache-2.0" "" $ do - doc <- openDoc "licenseCodeAction2.cabal" "cabal" - diags <- waitForDiagnosticsFromSource doc "cabal" - -- test if it supports typos in license name, here 'apahe' - reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"] - liftIO $ do - length diags @?= 1 - reduceDiag ^. L.range @?= Range (Position 3 25) (Position 4 0) - reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error - [codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) - executeCodeAction codeAction - contents <- documentContents doc - liftIO $ - contents - @?= Text.unlines - [ "cabal-version: 3.0" - , "name: licenseCodeAction2" - , "version: 0.1.0.0" - , "license: Apache-2.0" - , "" - , "library" - , " build-depends: base" - , " default-language: Haskell2010" - ] - ] ] +-- ---------------------------------------------------------------------------- +-- Code Action Tests +-- ---------------------------------------------------------------------------- + +codeActionTests :: TestTree +codeActionTests = testGroup "Code Actions" + [ runCabalTestCaseSession "BSD-3" "" $ do + doc <- openDoc "licenseCodeAction.cabal" "cabal" + diags <- waitForDiagnosticsFromSource doc "cabal" + reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"] + liftIO $ do + length diags @?= 1 + reduceDiag ^. L.range @?= Range (Position 3 24) (Position 4 0) + reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error + [codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) + executeCodeAction codeAction + contents <- documentContents doc + liftIO $ + contents + @?= Text.unlines + [ "cabal-version: 3.0" + , "name: licenseCodeAction" + , "version: 0.1.0.0" + , "license: BSD-3-Clause" + , "" + , "library" + , " build-depends: base" + , " default-language: Haskell2010" + ] + , runCabalTestCaseSession "Apache-2.0" "" $ do + doc <- openDoc "licenseCodeAction2.cabal" "cabal" + diags <- waitForDiagnosticsFromSource doc "cabal" + -- test if it supports typos in license name, here 'apahe' + reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"] + liftIO $ do + length diags @?= 1 + reduceDiag ^. L.range @?= Range (Position 3 25) (Position 4 0) + reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error + [codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0)) + executeCodeAction codeAction + contents <- documentContents doc + liftIO $ + contents + @?= Text.unlines + [ "cabal-version: 3.0" + , "name: licenseCodeAction2" + , "version: 0.1.0.0" + , "license: Apache-2.0" + , "" + , "library" + , " build-depends: base" + , " default-language: Haskell2010" + ] + , runCabalGoldenSession "Code Actions - Can fix field names" "code-actions" "FieldSuggestions" $ \doc -> do + _ <- waitForDiagnosticsFrom doc + cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions doc + -- Filter out the code actions we want to invoke. + -- We only want to invoke Code Actions with certain titles, and + -- we want to invoke them only once, not once for each cursor request. + -- 'getAllCodeActions' iterates over each cursor position and requests code actions. + let selectedCas = nubOrdOn (^. L.title) $ filter + (\ca -> (ca ^. L.title) `elem` + [ "Replace with license" + , "Replace with build-type" + , "Replace with extra-doc-files" + , "Replace with ghc-options" + , "Replace with location" + , "Replace with default-language" + , "Replace with import" + , "Replace with build-depends" + , "Replace with main-is" + , "Replace with hs-source-dirs" + ]) cas + mapM_ executeCodeAction selectedCas + pure () + ] where getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction] getLicenseAction license codeActions = do diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs index cd83ba623e..c69b229c09 100644 --- a/plugins/hls-cabal-plugin/test/Utils.hs +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -46,6 +46,9 @@ runCabalSession :: FilePath -> Session a -> IO a runCabalSession subdir = failIfSessionTimeout . runSessionWithServer def cabalPlugin (testDataDir subdir) +runCabalGoldenSession :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree +runCabalGoldenSession title subdir fp act = goldenWithCabalDoc def cabalPlugin title testDataDir (subdir fp) "golden" "cabal" act + testDataDir :: FilePath testDataDir = "plugins" "hls-cabal-plugin" "test" "testdata" diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal new file mode 100644 index 0000000000..d3d19a64dc --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal @@ -0,0 +1,37 @@ +cabal-version: 3.0 +name: FieldSuggestions +version: 0.1.0 +licens: BSD-3-Clause + +buil-type: Simple + +extra-doc-fils: + ChangeLog + +-- Default warnings in HLS +common warnings + -- Common sections are currently not supported. So, ignore! + ghc-option: -Wall + -Wredundant-constraints + -Wunused-packages + -Wno-name-shadowing + -Wno-unticked-promoted-constructors + +source-repository head + type: git + loc: fake + +library + default-lang: Haskell2010 + -- Import isn't supported right now. + impor: warnings + build-dep: base + +executable my-exe + mains: Main.hs + +test-suite Test + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-drs: + diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal new file mode 100644 index 0000000000..6ebffc1eb2 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal @@ -0,0 +1,37 @@ +cabal-version: 3.0 +name: FieldSuggestions +version: 0.1.0 +license: BSD-3-Clause + +build-type: Simple + +extra-doc-files: + ChangeLog + +-- Default warnings in HLS +common warnings + -- Common sections are currently not supported. So, ignore! + ghc-options: -Wall + -Wredundant-constraints + -Wunused-packages + -Wno-name-shadowing + -Wno-unticked-promoted-constructors + +source-repository head + type: git + location: fake + +library + default-language: Haskell2010 + -- Import isn't supported right now. + import: warnings + build-depends: base + +executable my-exe + main-is: Main.hs + +test-suite Test + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: + From eb1923f35706febabbf37df8881d0c10e657362b Mon Sep 17 00:00:00 2001 From: Jana Chadt Date: Thu, 11 Jul 2024 16:13:03 +0200 Subject: [PATCH 4/4] Cleanup PR --- plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 5 ++++- .../src/Ide/Plugin/Cabal/FieldSuggest.hs | 12 ++++++------ .../testdata/code-actions/FieldSuggestions.cabal | 1 - .../code-actions/FieldSuggestions.golden.cabal | 1 - 4 files changed, 10 insertions(+), 9 deletions(-) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 530273c3d5..3f9eac0fd4 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -242,10 +242,13 @@ licenseSuggestCodeAction ideState _ (CodeActionParams _ _ (TextDocumentIdentifie -- | CodeActions for correcting field names with typos in them. -- --- Provides CodeActions that fix typos in field names, in both stanzas and top-level field names. +-- Provides CodeActions that fix typos in both stanzas and top-level field names. -- The suggestions are computed based on the completion context, where we "move" a fake cursor -- to the end of the field name and trigger cabal file completions. The completions are then -- suggested to the user. +-- +-- TODO: Relying on completions here often does not produce the desired results, we should +-- use some sort of fuzzy matching in the future, see issue #4357. fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do vfileM <- lift (pluginGetVirtualFile $ toNormalizedUri uri) diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs index 5d2909b3c6..2e77ccb193 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs @@ -22,14 +22,14 @@ import Language.LSP.Protocol.Types (CodeAction (..), WorkspaceEdit (..)) import Text.Regex.TDFA --- | Generate all code action for given file, error field in position and suggestions +-- | Generate all code actions for given file, erroneous/unknown field and suggestions fieldErrorAction :: Uri -- ^ File for which the diagnostic was generated -> T.Text - -- ^ Original field + -- ^ Original (unknown) field -> [T.Text] - -- ^ Suggestions + -- ^ Suggestions for the given file -> Range -- ^ Location of diagnostic -> [CodeAction] @@ -38,8 +38,8 @@ fieldErrorAction uri original suggestions range = where mkCodeAction suggestion = let - -- Range returned by cabal here represents fragment from start of - -- offending identifier to end of line, we modify it to the end of identifier + -- Range returned by cabal here represents fragment from start of offending identifier + -- to end of line, we modify this range to be to the end of the identifier adjustRange (Range rangeFrom@(Position lineNr col) _) = Range rangeFrom (Position lineNr (col + fromIntegral (T.length original))) title = "Replace with " <> suggestion' @@ -51,7 +51,7 @@ fieldErrorAction uri original suggestions range = suggestion' = T.dropEnd 1 suggestion -- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic', --- if it represents an "Unknown field"- error with incorrect identifier +-- if it represents an "Unknown field"-error with incorrect identifier -- then return the incorrect identifier together with original diagnostics. fieldErrorName :: Diagnostic -> diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal index d3d19a64dc..e32f77b614 100644 --- a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.cabal @@ -10,7 +10,6 @@ extra-doc-fils: -- Default warnings in HLS common warnings - -- Common sections are currently not supported. So, ignore! ghc-option: -Wall -Wredundant-constraints -Wunused-packages diff --git a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal index 6ebffc1eb2..99bf84dfd7 100644 --- a/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal +++ b/plugins/hls-cabal-plugin/test/testdata/code-actions/FieldSuggestions.golden.cabal @@ -10,7 +10,6 @@ extra-doc-files: -- Default warnings in HLS common warnings - -- Common sections are currently not supported. So, ignore! ghc-options: -Wall -Wredundant-constraints -Wunused-packages