From 74dd77dcf9aaec4560b9a82757e2dddf3fade045 Mon Sep 17 00:00:00 2001 From: Michael Peyton Jones Date: Sat, 7 Jun 2025 15:41:58 +0100 Subject: [PATCH] Support hlint on 9.10 apart from apply-refact This enables the hlint plugin on GHC 9.10, at the cost of disabling refactoring actions. `apply-refact` is not even buildable on 9.10, so we have to push this all the way to the cabal file and use CPP, alas. We have two lines of defense: we don't consider hints applicable if we don't have `apply-refact`, and if we somehow do get to trying to apply a hint, we fail. --- docs/support/plugin-support.md | 2 +- haskell-language-server.cabal | 15 +++++--- .../hls-hlint-plugin/src/Ide/Plugin/Hlint.hs | 35 ++++++++++++++----- plugins/hls-hlint-plugin/test/Main.hs | 18 +++++----- .../schema/ghc910/default-config.golden.json | 7 ++++ .../vscode-extension-schema.golden.json | 18 ++++++++++ 6 files changed, 72 insertions(+), 23 deletions(-) diff --git a/docs/support/plugin-support.md b/docs/support/plugin-support.md index 7e0d7220e8..4263f0d035 100644 --- a/docs/support/plugin-support.md +++ b/docs/support/plugin-support.md @@ -55,7 +55,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has | `hls-explicit-record-fields-plugin` | 2 | | | `hls-fourmolu-plugin` | 2 | | | `hls-gadt-plugin` | 2 | | -| `hls-hlint-plugin` | 2 | 9.10.1 | +| `hls-hlint-plugin` | 2 | | | `hls-module-name-plugin` | 2 | | | `hls-notes-plugin` | 2 | | | `hls-qualify-imported-names-plugin` | 2 | | diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 157f5703f2..a0cba05918 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -703,14 +703,14 @@ flag hlint manual: True common hlint - if flag(hlint) && ((impl(ghc < 9.10) || impl(ghc > 9.11)) || flag(ignore-plugins-ghc-bounds)) + if flag(hlint) build-depends: haskell-language-server:hls-hlint-plugin cpp-options: -Dhls_hlint library hls-hlint-plugin import: defaults, pedantic, warnings -- https://github.com/ndmitchell/hlint/pull/1594 - if !(flag(hlint)) || ((impl(ghc >= 9.10) && impl(ghc < 9.11)) && !flag(ignore-plugins-ghc-bounds)) + if !flag(hlint) buildable: False exposed-modules: Ide.Plugin.Hlint hs-source-dirs: plugins/hls-hlint-plugin/src @@ -735,10 +735,14 @@ library hls-hlint-plugin , transformers , unordered-containers , ghc-lib-parser-ex - , apply-refact - -- , lsp-types + -- apply-refact doesn't work on 9.10, or even have a buildable + -- configuration + if impl(ghc >= 9.11) || impl(ghc < 9.10) + cpp-options: -DAPPLY_REFACT + build-depends: apply-refact + if flag(ghc-lib) cpp-options: -DGHC_LIB build-depends: @@ -753,7 +757,7 @@ library hls-hlint-plugin test-suite hls-hlint-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(hlint) || ((impl(ghc >= 9.10) && impl(ghc < 9.11)) && !flag(ignore-plugins-ghc-bounds)) + if !flag(hlint) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-hlint-plugin/test @@ -761,6 +765,7 @@ test-suite hls-hlint-plugin-tests -- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/24648 if os(darwin) ghc-options: -optl-Wl,-ld_classic + build-depends: aeson , containers diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 9621f894e3..5a72455eb5 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -5,7 +5,6 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} @@ -54,8 +53,15 @@ import Development.IDE.Core.FileStore (getVersione import Development.IDE.Core.Rules (defineNoFile, getParsedModuleWithComments) import Development.IDE.Core.Shake (getDiagnostics) + +#if APPLY_REFACT import qualified Refact.Apply as Refact import qualified Refact.Types as Refact +#if !MIN_VERSION_apply_refact(0,12,0) +import System.Environment (setEnv, + unsetEnv) +#endif +#endif import Development.IDE.GHC.Compat (DynFlags, WarningFlag (Opt_WarnUnrecognisedPragmas), @@ -105,6 +111,7 @@ import Language.LSP.Protocol.Types hiding (Null) import qualified Language.LSP.Protocol.Types as LSP +import Development.IDE.Core.PluginUtils as PluginUtils import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Spans.Pragmas (LineSplitTextEdits (LineSplitTextEdits), NextPragmaInfo (NextPragmaInfo), @@ -114,11 +121,6 @@ import Development.IDE.Spans.Pragmas (LineSplitTe lineSplitTextEdits, nextPragmaLine) import GHC.Generics (Generic) -#if !MIN_VERSION_apply_refact(0,12,0) -import System.Environment (setEnv, - unsetEnv) -#endif -import Development.IDE.Core.PluginUtils as PluginUtils import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- @@ -126,7 +128,9 @@ import Text.Regex.TDFA.Text () data Log = LogShake Shake.Log | LogApplying NormalizedFilePath (Either String WorkspaceEdit) +#if APPLY_REFACT | LogGeneratedIdeas NormalizedFilePath [[Refact.Refactoring Refact.SrcSpan]] +#endif | LogGetIdeas NormalizedFilePath | LogUsingExtensions NormalizedFilePath [String] -- Extension is only imported conditionally, so we just stringify them | forall a. (Pretty a) => LogResolve a @@ -135,7 +139,9 @@ instance Pretty Log where pretty = \case LogShake log -> pretty log LogApplying fp res -> "Applying hint(s) for" <+> viaShow fp <> ":" <+> viaShow res +#if APPLY_REFACT LogGeneratedIdeas fp ideas -> "Generated hlint ideas for for" <+> viaShow fp <> ":" <+> viaShow ideas +#endif LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <> line <> indent 4 (pretty exts) LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp LogResolve msg -> pretty msg @@ -413,12 +419,19 @@ resolveProvider recorder ideState _plId ca uri resolveValue = do edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle pure $ ca & LSP.edit ?~ edit +applyRefactAvailable :: Bool +#if APPLY_REFACT +applyRefactAvailable = True +#else +applyRefactAvailable = False +#endif + -- | Convert a hlint diagnostic into an apply and an ignore code action -- if applicable diagnosticToCodeActions :: VersionedTextDocumentIdentifier -> LSP.Diagnostic -> [LSP.CodeAction] diagnosticToCodeActions verTxtDocId diagnostic | LSP.Diagnostic{ _source = Just "hlint", _code = Just (InR code), _range = LSP.Range start _ } <- diagnostic - , let isHintApplicable = "refact:" `T.isPrefixOf` code + , let isHintApplicable = "refact:" `T.isPrefixOf` code && applyRefactAvailable , let hint = T.replace "refact:" "" code , let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module" , let suppressHintArguments = IgnoreHint verTxtDocId hint @@ -506,6 +519,11 @@ data OneHint = } deriving (Generic, Eq, Show, ToJSON, FromJSON) applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either PluginError WorkspaceEdit) +#if !APPLY_REFACT +applyHint _ _ _ _ _ = + -- https://github.com/ndmitchell/hlint/pull/1594#issuecomment-2338898673 + evaluate $ error "Cannot apply refactoring: apply-refact does not work on GHC 9.10" +#else applyHint recorder ide nfp mhint verTxtDocId = runExceptT $ do let runAction' :: Action a -> IO a @@ -607,7 +625,7 @@ applyRefactorings :: -- with the @LANGUAGE@ pragmas, pragmas win. [String] -> IO String -applyRefactorings = +applyRefactorings = #if MIN_VERSION_apply_refact(0,12,0) Refact.applyRefactorings #else @@ -624,3 +642,4 @@ applyRefactorings = withRuntimeLibdir libdir = bracket_ (setEnv key libdir) (unsetEnv key) where key = "GHC_EXACTPRINT_GHC_LIBDIR" #endif +#endif diff --git a/plugins/hls-hlint-plugin/test/Main.hs b/plugins/hls-hlint-plugin/test/Main.hs index 7d92706051..4eea2a803a 100644 --- a/plugins/hls-hlint-plugin/test/Main.hs +++ b/plugins/hls-hlint-plugin/test/Main.hs @@ -45,7 +45,7 @@ getApplyHintText :: T.Text -> T.Text getApplyHintText name = "Apply hint \"" <> name <> "\"" resolveTests :: TestTree -resolveTests = testGroup "hlint resolve tests" +resolveTests = knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testGroup "hlint resolve tests" [ ignoreHintGoldenResolveTest "Resolve version of: Ignore hint in this module inserts -Wno-unrecognised-pragmas and hlint ignore pragma if warn unrecognized pragmas is off" @@ -76,7 +76,7 @@ ignoreHintTests = testGroup "hlint ignore hint tests" ] applyHintTests :: TestTree -applyHintTests = testGroup "hlint apply hint tests" +applyHintTests = knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testGroup "hlint apply hint tests" [ applyHintGoldenTest "[#2612] Apply hint works when operator fixities go right-to-left" @@ -88,7 +88,7 @@ applyHintTests = testGroup "hlint apply hint tests" suggestionsTests :: TestTree suggestionsTests = testGroup "hlint suggestions" [ - testCase "provides 3.8 code actions including apply all" $ runHlintSession "" $ do + knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "provides 3.8 code actions including apply all" $ runHlintSession "" $ do doc <- openDoc "Base.hs" "haskell" diags@(reduceDiag:_) <- hlintCaptureKick @@ -120,7 +120,7 @@ suggestionsTests = contents <- skipManyTill anyMessage $ getDocumentEdit doc liftIO $ contents @?= "main = undefined\nfoo x = x\n" - , testCase "falls back to pre 3.8 code actions" $ + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "falls back to pre 3.8 code actions" $ runSessionWithTestConfig def { testConfigCaps = noLiteralCaps , testDirLocation = Left testDir @@ -179,15 +179,15 @@ suggestionsTests = doc <- openDoc "CppHeader.hs" "haskell" testHlintDiagnostics doc - , testCase "[#590] apply-refact works with -XLambdaCase argument" $ runHlintSession "lambdacase" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#590] apply-refact works with -XLambdaCase argument" $ runHlintSession "lambdacase" $ do testRefactor "LambdaCase.hs" "Redundant bracket" expectedLambdaCase - , testCase "[#1242] apply-refact works with -XTypeApplications argument" $ runHlintSession "typeapps" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#1242] apply-refact works with -XTypeApplications argument" $ runHlintSession "typeapps" $ do testRefactor "TypeApplication.hs" "Redundant bracket" expectedTypeApp - , testCase "apply hints works with LambdaCase via language pragma" $ runHlintSession "" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "apply hints works with LambdaCase via language pragma" $ runHlintSession "" $ do testRefactor "LambdaCase.hs" "Redundant bracket" ("{-# LANGUAGE LambdaCase #-}" : expectedLambdaCase) @@ -213,10 +213,10 @@ suggestionsTests = doc <- openDoc "IgnoreAnnHlint.hs" "haskell" testNoHlintDiagnostics doc - , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do testRefactor "Comments.hs" "Redundant bracket" expectedComments - , testCase "[#2290] apply all hints works with a trailing comment" $ runHlintSession "" $ do + , knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#2290] apply all hints works with a trailing comment" $ runHlintSession "" $ do testRefactor "TwoHintsAndComment.hs" "Apply all hints" expectedComments2 , testCase "applyAll is shown only when there is at least one diagnostic in range" $ runHlintSession "" $ do diff --git a/test/testdata/schema/ghc910/default-config.golden.json b/test/testdata/schema/ghc910/default-config.golden.json index 186a90aa3e..3b4e687ef9 100644 --- a/test/testdata/schema/ghc910/default-config.golden.json +++ b/test/testdata/schema/ghc910/default-config.golden.json @@ -91,6 +91,13 @@ }, "globalOn": true }, + "hlint": { + "codeActionsOn": true, + "config": { + "flags": [] + }, + "diagnosticsOn": true + }, "importLens": { "codeActionsOn": true, "codeLensOn": true, diff --git a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json index 3220003494..4ca08f296c 100644 --- a/test/testdata/schema/ghc910/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc910/vscode-extension-schema.golden.json @@ -213,6 +213,24 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.hlint.codeActionsOn": { + "default": true, + "description": "Enables hlint code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.hlint.config.flags": { + "default": [], + "markdownDescription": "Flags used by hlint", + "scope": "resource", + "type": "array" + }, + "haskell.plugin.hlint.diagnosticsOn": { + "default": true, + "description": "Enables hlint diagnostics", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.importLens.codeActionsOn": { "default": true, "description": "Enables importLens code actions",