diff --git a/hls-hlint-plugin.cabal b/hls-hlint-plugin.cabal --- a/hls-hlint-plugin.cabal +++ b/hls-hlint-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-hlint-plugin -version: 1.0.4.0 +version: 1.1.0.0 synopsis: Hlint integration plugin with Haskell Language Server description: Please see the README on GitHub at @@ -25,25 +25,15 @@ default: False manual: True -flag ghc-lib - default: False - manual: True - description: - Force dependency on ghc-lib-parser even if GHC API in the ghc package is supported - -flag hlint33 - default: True - manual: False - description: - Hlint-3.3 doesn't support versions ghc-lib < 9.0.1 nor ghc <= 8.6, so we can use hlint-3.2 for backwards compat - This flag can be removed when all dependencies support ghc-lib-9.0.* and we drop support for ghc-8.6 - library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Hlint hs-source-dirs: src build-depends: , aeson - , apply-refact >=0.9.3.0 , base >=4.12 && <5 , binary , bytestring @@ -55,10 +45,10 @@ , extra , filepath , ghc-exactprint >=0.6.3.4 - , ghcide ^>=1.7 + , ghcide ^>=1.8 , hashable - , hlint - , hls-plugin-api ^>=1.4 + , hlint < 3.5 + , hls-plugin-api ^>=1.5 , hslogger , lens , lsp @@ -69,40 +59,11 @@ , text , transformers , unordered-containers - -- can be removed if https://github.com/ndmitchell/hlint/pull/1325#issue-1077062712 is merged - -- and https://github.com/haskell/haskell-language-server/pull/2464#issue-1077133441 is updated - -- accordingly + , apply-refact >=0.9.0.0 + , ghc-lib-parser , ghc-lib-parser-ex - if (flag(hlint33)) - -- This mirrors the logic in hlint.cabal for hlint-3.3 - -- https://github.com/ndmitchell/hlint/blob/d3576de4529d8df6cca5a345f5b7e04474ff7bff/hlint.cabal#L79-L88 - -- so we can make sure that we do the same thing as hlint - build-depends: hlint ^>=3.3 - if (!flag(ghc-lib) && impl(ghc >=9.0.1) && impl(ghc <9.1.0)) - build-depends: ghc ==9.0.* - else - build-depends: - , ghc - , ghc-lib ^>=9.0 - , ghc-lib-parser-ex ^>=9.0 - - cpp-options: -DHLINT_ON_GHC_LIB - - else - -- This mirrors the logic in hlint.cabal for hlint-3.2 - -- https://github.com/ndmitchell/hlint/blob/c7354e473c7d09213c8adc3dc94bf50a6eb4a42d/hlint.cabal#L79-L88 - build-depends: hlint ^>=3.2 - if (!flag(ghc-lib) && impl(ghc >=8.10.1) && impl(ghc < 8.11.0)) - build-depends: ghc >=8.10 && <9.0 - else - build-depends: - , ghc - , ghc-lib ^>=8.10.7.20210828 - , ghc-lib-parser-ex ^>=8.10 - - cpp-options: -DHLINT_ON_GHC_LIB - + cpp-options: -DHLINT_ON_GHC_LIB ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing -Wno-unticked-promoted-constructors @@ -116,6 +77,10 @@ TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test @@ -128,7 +93,7 @@ , filepath , hls-hlint-plugin , hls-plugin-api - , hls-test-utils ^>=1.3 + , hls-test-utils ^>=1.4 , lens , lsp-types , text diff --git a/src/Ide/Plugin/Hlint.hs b/src/Ide/Plugin/Hlint.hs --- a/src/Ide/Plugin/Hlint.hs +++ b/src/Ide/Plugin/Hlint.hs @@ -4,24 +4,24 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE StrictData #-} {-# OPTIONS_GHC -Wno-orphans #-} #ifdef HLINT_ON_GHC_LIB -#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib(x,y,z) +#define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc_lib_parser(x,y,z) #else #define MIN_GHC_API_VERSION(x,y,z) MIN_VERSION_ghc(x,y,z) #endif @@ -44,8 +44,8 @@ Value (..)) import qualified Data.ByteString as BS import Data.Default -import qualified Data.HashMap.Strict as Map import Data.Hashable +import qualified Data.HashMap.Strict as Map import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -60,19 +60,23 @@ import qualified Refact.Types as Refact #ifdef HLINT_ON_GHC_LIB -import Development.IDE.GHC.Compat (BufSpan, - DynFlags, +import Development.IDE.GHC.Compat (DynFlags, WarningFlag (Opt_WarnUnrecognisedPragmas), extensionFlags, ms_hspp_opts, topDir, wopt) import qualified Development.IDE.GHC.Compat.Util as EnumSet -import "ghc-lib" GHC hiding - (DynFlags (..), - RealSrcSpan, - ms_hspp_opts) -import qualified "ghc-lib" GHC + +#if MIN_GHC_API_VERSION(9,0,0) +import "ghc-lib-parser" GHC.Types.SrcLoc hiding + (RealSrcSpan) +import qualified "ghc-lib-parser" GHC.Types.SrcLoc as GHC +#else +import "ghc-lib-parser" SrcLoc hiding + (RealSrcSpan) +import qualified "ghc-lib-parser" SrcLoc as GHC +#endif import "ghc-lib-parser" GHC.LanguageExtensions (Extension) import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension) import System.FilePath (takeFileName) @@ -87,9 +91,14 @@ import System.IO.Temp #else import Development.IDE.GHC.Compat hiding - (setEnv, (<+>)) + (setEnv, + (<+>)) import GHC.Generics (Associativity (LeftAssociative, NotAssociative, RightAssociative)) +#if MIN_GHC_API_VERSION(9,2,0) +import Language.Haskell.GHC.ExactPrint.ExactPrint (deltaOptions) +#else import Language.Haskell.GHC.ExactPrint.Delta (deltaOptions) +#endif import Language.Haskell.GHC.ExactPrint.Parsers (postParseTransform) import Language.Haskell.GHC.ExactPrint.Types (Rigidity (..)) import Language.Haskell.GhclibParserEx.Fixity as GhclibParserEx (applyFixities) @@ -141,12 +150,15 @@ LogApplying fp res -> "Applying hint(s) for" <+> viaShow fp <> ":" <+> viaShow res LogGeneratedIdeas fp ideas -> "Generated hlint ideas for for" <+> viaShow fp <> ":" <+> viaShow ideas LogUsingExtensions fp exts -> "Using extensions for " <+> viaShow fp <> ":" <+> pretty exts - LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp + LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp #ifdef HLINT_ON_GHC_LIB -- Reimplementing this, since the one in Development.IDE.GHC.Compat isn't for ghc-lib +#if !MIN_GHC_API_VERSION(9,0,0) +type BufSpan = () +#endif pattern RealSrcSpan :: GHC.RealSrcSpan -> Maybe BufSpan -> GHC.SrcSpan -#if MIN_VERSION_ghc(9,0,0) +#if MIN_GHC_API_VERSION(9,0,0) pattern RealSrcSpan x y = GHC.RealSrcSpan x y #else pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y)) @@ -323,8 +335,7 @@ dflags <- getFlags let hscExts = EnumSet.toList (extensionFlags dflags) let hscExts' = mapMaybe (GhclibParserEx.readExtension . show) hscExts - let hlintExts = hscExts' - return hlintExts + return hscExts' where getFlags :: Action DynFlags getFlags = do modsum <- use_ GetModSummary nfp @@ -435,23 +446,25 @@ Nothing Nothing = catMaybes + -- Applying the hint is marked preferred because it addresses the underlying error. + -- Disabling the rule isn't, because less often used and configuration can be adapted. [ if | isHintApplicable , let applyHintTitle = "Apply hint \"" <> hint <> "\"" applyHintArguments = [toJSON (AOP (documentId ^. LSP.uri) start hint)] applyHintCommand = mkLspCommand pluginId "applyOne" applyHintTitle (Just applyHintArguments) -> - Just (mkCodeAction applyHintTitle diagnostic Nothing (Just applyHintCommand)) + Just (mkCodeAction applyHintTitle diagnostic Nothing (Just applyHintCommand) True) | otherwise -> Nothing - , Just (mkCodeAction suppressHintTitle diagnostic (Just suppressHintWorkspaceEdit) Nothing) + , Just (mkCodeAction suppressHintTitle diagnostic (Just suppressHintWorkspaceEdit) Nothing False) ] | otherwise = [] -mkCodeAction :: T.Text -> LSP.Diagnostic -> Maybe LSP.WorkspaceEdit -> Maybe LSP.Command -> LSP.CodeAction -mkCodeAction title diagnostic workspaceEdit command = +mkCodeAction :: T.Text -> LSP.Diagnostic -> Maybe LSP.WorkspaceEdit -> Maybe LSP.Command -> Bool -> LSP.CodeAction +mkCodeAction title diagnostic workspaceEdit command isPreferred = LSP.CodeAction { _title = title , _kind = Just LSP.CodeActionQuickFix , _diagnostics = Just (LSP.List [diagnostic]) - , _isPreferred = Nothing + , _isPreferred = Just isPreferred , _disabled = Nothing , _edit = workspaceEdit , _command = command diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -181,9 +181,14 @@ doc <- openDoc "IgnoreAnnHlint.hs" "haskell" expectNoMoreDiagnostics 3 doc "hlint" - , testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do + , knownBrokenForGhcVersions [GHC92] "apply-refact has different behavior on v0.10" $ + testCase "apply-refact preserve regular comments" $ runHlintSession "" $ do testRefactor "Comments.hs" "Redundant bracket" expectedComments + , onlyRunForGhcVersions [GHC92] "only run test for apply-refact-0.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 testRefactor "TwoHintsAndComment.hs" "Apply all hints" expectedComments2 @@ -257,6 +262,14 @@ , "f = {- inline comment -}{- inline comment inside refactored code -} 1 -- ending comment", "" , "-- final comment" ] + expectedComments' = [ "-- comment before header" + , "module Comments where", "" + , "{-# standalone annotation #-}", "" + , "-- standalone comment", "" + , "-- | haddock comment" + , "f = {- inline comment -} {- inline comment inside refactored code -}1 -- ending comment", "" + , "-- final comment" + ] expectedComments2 = [ "module TwoHintsAndComment where" , "biggest = foldr1 max -- the line above will show two hlint hints, \"eta reduce\" and \"use maximum\"" ] @@ -358,10 +371,7 @@ -- Although a given hlint version supports one direct ghc, we could use several versions of hlint -- each one supporting a different ghc version. It should be a temporary situation though. knownBrokenForHlintOnGhcLib :: String -> TestTree -> TestTree -knownBrokenForHlintOnGhcLib = knownBrokenForGhcVersions [GHC88, GHC86] - -knownBrokenForHlintOnRawGhc :: String -> TestTree -> TestTree -knownBrokenForHlintOnRawGhc = knownBrokenForGhcVersions [GHC810, GHC90] +knownBrokenForHlintOnGhcLib = expectFailBecause -- 1's based data Point = Point {