Skip to content

Commit e2456f0

Browse files
michaelpjmichaelpj
committed
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.
1 parent d9aaa01 commit e2456f0

File tree

4 files changed

+47
-23
lines changed

4 files changed

+47
-23
lines changed

‎docs/support/plugin-support.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has
5555
| `hls-explicit-record-fields-plugin` | 2 | |
5656
| `hls-fourmolu-plugin` | 2 | |
5757
| `hls-gadt-plugin` | 2 | |
58-
| `hls-hlint-plugin` | 2 | 9.10.1 |
58+
| `hls-hlint-plugin` | 2 | |
5959
| `hls-module-name-plugin` | 2 | |
6060
| `hls-notes-plugin` | 2 | |
6161
| `hls-qualify-imported-names-plugin` | 2 | |

‎haskell-language-server.cabal

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -703,14 +703,14 @@ flag hlint
703703
manual: True
704704

705705
common hlint
706-
if flag(hlint) && ((impl(ghc < 9.10) || impl(ghc > 9.11)) || flag(ignore-plugins-ghc-bounds))
706+
if flag(hlint)
707707
build-depends: haskell-language-server:hls-hlint-plugin
708708
cpp-options: -Dhls_hlint
709709

710710
library hls-hlint-plugin
711711
import: defaults, pedantic, warnings
712712
-- https://github.com/ndmitchell/hlint/pull/1594
713-
if !(flag(hlint)) || ((impl(ghc >= 9.10) && impl(ghc < 9.11)) && !flag(ignore-plugins-ghc-bounds))
713+
if !flag(hlint)
714714
buildable: False
715715
exposed-modules: Ide.Plugin.Hlint
716716
hs-source-dirs: plugins/hls-hlint-plugin/src
@@ -735,10 +735,14 @@ library hls-hlint-plugin
735735
, transformers
736736
, unordered-containers
737737
, ghc-lib-parser-ex
738-
, apply-refact
739-
--
740738
, lsp-types
741739

740+
-- apply-refact doesn't work on 9.10, or even have a buildable
741+
-- configuration
742+
if impl(ghc >= 9.11) || impl(ghc < 9.10)
743+
cpp-options: -DAPPLY_REFACT
744+
build-depends: apply-refact
745+
742746
if flag(ghc-lib)
743747
cpp-options: -DGHC_LIB
744748
build-depends:
@@ -753,14 +757,15 @@ library hls-hlint-plugin
753757

754758
test-suite hls-hlint-plugin-tests
755759
import: defaults, pedantic, test-defaults, warnings
756-
if !flag(hlint) || ((impl(ghc >= 9.10) && impl(ghc < 9.11)) && !flag(ignore-plugins-ghc-bounds))
760+
if !flag(hlint)
757761
buildable: False
758762
type: exitcode-stdio-1.0
759763
hs-source-dirs: plugins/hls-hlint-plugin/test
760764
main-is: Main.hs
761765
-- Work around https://gitlab.haskell.org/ghc/ghc/-/issues/24648
762766
if os(darwin)
763767
ghc-options: -optl-Wl,-ld_classic
768+
764769
build-depends:
765770
aeson
766771
, containers

‎plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

Lines changed: 27 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@
55
{-# LANGUAGE MultiWayIf #-}
66
{-# LANGUAGE OverloadedLabels #-}
77
{-# LANGUAGE OverloadedStrings #-}
8-
{-# LANGUAGE PackageImports #-}
98
{-# LANGUAGE PatternSynonyms #-}
109
{-# LANGUAGE RecordWildCards #-}
1110
{-# LANGUAGE StrictData #-}
@@ -54,8 +53,15 @@ import Development.IDE.Core.FileStore (getVersione
5453
import Development.IDE.Core.Rules (defineNoFile,
5554
getParsedModuleWithComments)
5655
import Development.IDE.Core.Shake (getDiagnostics)
56+
57+
#if APPLY_REFACT
5758
import qualified Refact.Apply as Refact
5859
import qualified Refact.Types as Refact
60+
#if !MIN_VERSION_apply_refact(0,12,0)
61+
import System.Environment (setEnv,
62+
unsetEnv)
63+
#endif
64+
#endif
5965

6066
import Development.IDE.GHC.Compat (DynFlags,
6167
WarningFlag (Opt_WarnUnrecognisedPragmas),
@@ -105,6 +111,7 @@ import Language.LSP.Protocol.Types hiding
105111
(Null)
106112
import qualified Language.LSP.Protocol.Types as LSP
107113

114+
import Development.IDE.Core.PluginUtils as PluginUtils
108115
import qualified Development.IDE.Core.Shake as Shake
109116
import Development.IDE.Spans.Pragmas (LineSplitTextEdits (LineSplitTextEdits),
110117
NextPragmaInfo (NextPragmaInfo),
@@ -114,19 +121,16 @@ import Development.IDE.Spans.Pragmas (LineSplitTe
114121
lineSplitTextEdits,
115122
nextPragmaLine)
116123
import GHC.Generics (Generic)
117-
#if !MIN_VERSION_apply_refact(0,12,0)
118-
import System.Environment (setEnv,
119-
unsetEnv)
120-
#endif
121-
import Development.IDE.Core.PluginUtils as PluginUtils
122124
import Text.Regex.TDFA.Text ()
123125

124126
-- ---------------------------------------------------------------------
125127

126128
data Log
127129
= LogShake Shake.Log
128130
| LogApplying NormalizedFilePath (Either String WorkspaceEdit)
131+
#if APPLY_REFACT
129132
| LogGeneratedIdeas NormalizedFilePath [[Refact.Refactoring Refact.SrcSpan]]
133+
#endif
130134
| LogGetIdeas NormalizedFilePath
131135
| LogUsingExtensions NormalizedFilePath [String] -- Extension is only imported conditionally, so we just stringify them
132136
| forall a. (Pretty a) => LogResolve a
@@ -135,7 +139,9 @@ instance Pretty Log where
135139
pretty = \case
136140
LogShake log -> pretty log
137141
LogApplying fp res -> "Applying hint(s) for" <+> viaShow fp <> ":" <+> viaShow res
142+
#if APPLY_REFACT
138143
LogGeneratedIdeas fp ideas -> "Generated hlint ideas for for" <+> viaShow fp <> ":" <+> viaShow ideas
144+
#endif
139145
LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <> line <> indent 4 (pretty exts)
140146
LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp
141147
LogResolve msg -> pretty msg
@@ -413,12 +419,19 @@ resolveProvider recorder ideState _plId ca uri resolveValue = do
413419
edit <- ExceptT $ liftIO $ ignoreHint recorder ideState file verTxtDocId hintTitle
414420
pure $ ca & LSP.edit ?~ edit
415421

422+
applyRefactAvailable :: Bool
423+
#if APPLY_REFACT
424+
applyRefactAvailable = True
425+
#else
426+
applyRefactAvailable = False
427+
#endif
428+
416429
-- | Convert a hlint diagnostic into an apply and an ignore code action
417430
-- if applicable
418431
diagnosticToCodeActions :: VersionedTextDocumentIdentifier -> LSP.Diagnostic -> [LSP.CodeAction]
419432
diagnosticToCodeActions verTxtDocId diagnostic
420433
| LSP.Diagnostic{ _source = Just "hlint", _code = Just (InR code), _range = LSP.Range start _ } <- diagnostic
421-
, let isHintApplicable = "refact:" `T.isPrefixOf` code
434+
, let isHintApplicable = "refact:" `T.isPrefixOf` code && applyRefactAvailable
422435
, let hint = T.replace "refact:" "" code
423436
, let suppressHintTitle = "Ignore hint \"" <> hint <> "\" in this module"
424437
, let suppressHintArguments = IgnoreHint verTxtDocId hint
@@ -506,6 +519,11 @@ data OneHint =
506519
} deriving (Generic, Eq, Show, ToJSON, FromJSON)
507520

508521
applyHint :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> Maybe OneHint -> VersionedTextDocumentIdentifier -> IO (Either PluginError WorkspaceEdit)
522+
#if !APPLY_REFACT
523+
applyHint _ _ _ _ _ =
524+
-- https://github.com/ndmitchell/hlint/pull/1594#issuecomment-2338898673
525+
evaluate $ error "Cannot apply refactoring: apply-refact does not work on GHC 9.10"
526+
#else
509527
applyHint recorder ide nfp mhint verTxtDocId =
510528
runExceptT $ do
511529
let runAction' :: Action a -> IO a
@@ -607,7 +625,7 @@ applyRefactorings ::
607625
-- with the @LANGUAGE@ pragmas, pragmas win.
608626
[String] ->
609627
IO String
610-
applyRefactorings =
628+
applyRefactorings =
611629
#if MIN_VERSION_apply_refact(0,12,0)
612630
Refact.applyRefactorings
613631
#else
@@ -624,3 +642,4 @@ applyRefactorings =
624642
withRuntimeLibdir libdir = bracket_ (setEnv key libdir) (unsetEnv key)
625643
where key = "GHC_EXACTPRINT_GHC_LIBDIR"
626644
#endif
645+
#endif

‎plugins/hls-hlint-plugin/test/Main.hs

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ getApplyHintText :: T.Text -> T.Text
4545
getApplyHintText name = "Apply hint \"" <> name <> "\""
4646

4747
resolveTests :: TestTree
48-
resolveTests = testGroup "hlint resolve tests"
48+
resolveTests = knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testGroup "hlint resolve tests"
4949
[
5050
ignoreHintGoldenResolveTest
5151
"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"
7676
]
7777

7878
applyHintTests :: TestTree
79-
applyHintTests = testGroup "hlint apply hint tests"
79+
applyHintTests = knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testGroup "hlint apply hint tests"
8080
[
8181
applyHintGoldenTest
8282
"[#2612] Apply hint works when operator fixities go right-to-left"
@@ -88,7 +88,7 @@ applyHintTests = testGroup "hlint apply hint tests"
8888
suggestionsTests :: TestTree
8989
suggestionsTests =
9090
testGroup "hlint suggestions" [
91-
testCase "provides 3.8 code actions including apply all" $ runHlintSession "" $ do
91+
knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "provides 3.8 code actions including apply all" $ runHlintSession "" $ do
9292
doc <- openDoc "Base.hs" "haskell"
9393
diags@(reduceDiag:_) <- hlintCaptureKick
9494

@@ -120,7 +120,7 @@ suggestionsTests =
120120
contents <- skipManyTill anyMessage $ getDocumentEdit doc
121121
liftIO $ contents @?= "main = undefined\nfoo x = x\n"
122122

123-
, testCase "falls back to pre 3.8 code actions" $
123+
, knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "falls back to pre 3.8 code actions" $
124124
runSessionWithTestConfig def
125125
{ testConfigCaps = noLiteralCaps
126126
, testDirLocation = Left testDir
@@ -179,15 +179,15 @@ suggestionsTests =
179179
doc <- openDoc "CppHeader.hs" "haskell"
180180
testHlintDiagnostics doc
181181

182-
, testCase "[#590] apply-refact works with -XLambdaCase argument" $ runHlintSession "lambdacase" $ do
182+
, knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#590] apply-refact works with -XLambdaCase argument" $ runHlintSession "lambdacase" $ do
183183
testRefactor "LambdaCase.hs" "Redundant bracket"
184184
expectedLambdaCase
185185

186-
, testCase "[#1242] apply-refact works with -XTypeApplications argument" $ runHlintSession "typeapps" $ do
186+
, knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#1242] apply-refact works with -XTypeApplications argument" $ runHlintSession "typeapps" $ do
187187
testRefactor "TypeApplication.hs" "Redundant bracket"
188188
expectedTypeApp
189189

190-
, testCase "apply hints works with LambdaCase via language pragma" $ runHlintSession "" $ do
190+
, knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "apply hints works with LambdaCase via language pragma" $ runHlintSession "" $ do
191191
testRefactor "LambdaCase.hs" "Redundant bracket"
192192
("{-# LANGUAGE LambdaCase #-}" : expectedLambdaCase)
193193

@@ -213,10 +213,10 @@ suggestionsTests =
213213
doc <- openDoc "IgnoreAnnHlint.hs" "haskell"
214214
testNoHlintDiagnostics doc
215215

216-
, testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do
216+
, knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do
217217
testRefactor "Comments.hs" "Redundant bracket" expectedComments
218218

219-
, testCase "[#2290] apply all hints works with a trailing comment" $ runHlintSession "" $ do
219+
, knownBrokenForGhcVersions [GHC910] "apply-refact doesn't work on 9.10" $ testCase "[#2290] apply all hints works with a trailing comment" $ runHlintSession "" $ do
220220
testRefactor "TwoHintsAndComment.hs" "Apply all hints" expectedComments2
221221

222222
, testCase "applyAll is shown only when there is at least one diagnostic in range" $ runHlintSession "" $ do

0 commit comments

Comments
 (0)