diff --git a/configuration-ghc-94.nix b/configuration-ghc-94.nix index e561496955f..5e7f5e1aee8 100644 --- a/configuration-ghc-94.nix +++ b/configuration-ghc-94.nix @@ -17,7 +17,14 @@ let fourmolu = dontCheck (hself.callCabal2nix "fourmolu" inputs.fourmolu-011 {}); - stylish-haskell = appendConfigureFlag hsuper.stylish-haskell "-fghc-lib"; + stylish-haskell = appendConfigureFlag hsuper.stylish-haskell "-f-ghc-lib"; + + ghc-lib-parser-ex = appendConfigureFlag hsuper.ghc-lib-parser-ex "-fno-ghc-lib"; + hlint = hself.callCabal2nixWithOptions "hlint" inputs.hlint-35 "-f-ghc-lib" {}; + + hls-hlint-plugin = (hself.callCabal2nixWithOptions "hls-hlint-plugin" + ./plugins/hls-hlint-plugin "-f-ghc-lib" {}) + .overrideAttrs (_: { doCheck = false; }); lsp = hself.callCabal2nix "lsp" inputs.lsp {}; lsp-types = hself.callCabal2nix "lsp-types" inputs.lsp-types {}; @@ -25,10 +32,10 @@ let # Re-generate HLS drv excluding some plugins haskell-language-server = - hself.callCabal2nixWithOptions "haskell-language-server" ./. + (hself.callCabal2nixWithOptions "haskell-language-server" ./. # Pedantic cannot be used due to -Werror=unused-top-binds # Check must be disabled due to some missing required files - (pkgs.lib.concatStringsSep " " [ "--no-check" "-f-pedantic" "-f-hlint" ]) { }; + (pkgs.lib.concatStringsSep " " [ "--no-check" "-f-pedantic" ]) { }); }); in { inherit disabledPlugins; diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 0035934ef2e..586a2aa46b5 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -29,6 +29,13 @@ flag pedantic default: False manual: True +flag ghc-lib + description: + Use ghc-lib-parser rather than the ghc library (requires hlint and + ghc-lib-parser-ex to also be built with it) + default: True + manual: False + library exposed-modules: Ide.Plugin.Hlint hs-source-dirs: src @@ -59,11 +66,19 @@ library , text , transformers , unordered-containers - , ghc-lib-parser , ghc-lib-parser-ex , apply-refact - cpp-options: -DHLINT_ON_GHC_LIB + if flag(ghc-lib) + cpp-options: -DGHC_LIB + build-depends: + ghc-lib-parser + else + build-depends: + ghc + , ghc-boot + , ghc-boot-th + ghc-options: -Wall -Wredundant-constraints -Wno-name-shadowing -Wno-unticked-promoted-constructors diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 2c02c6c6e09..5415e83a5ed 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -10,7 +10,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -26,7 +25,7 @@ -- lots of CPP, we just disable the warning until later. {-# OPTIONS_GHC -Wno-redundant-constraints #-} -#ifdef HLINT_ON_GHC_LIB +#ifdef GHC_LIB #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) @@ -69,7 +68,6 @@ import Development.IDE.Core.Shake (getDiagnost import qualified Refact.Apply as Refact import qualified Refact.Types as Refact -#ifdef HLINT_ON_GHC_LIB import Development.IDE.GHC.Compat (DynFlags, WarningFlag (Opt_WarnUnrecognisedPragmas), extensionFlags, @@ -79,18 +77,18 @@ import Development.IDE.GHC.Compat (DynFlags, import qualified Development.IDE.GHC.Compat.Util as EnumSet #if MIN_GHC_API_VERSION(9,4,0) -import qualified "ghc-lib-parser" GHC.Data.Strict as Strict +import qualified GHC.Data.Strict as Strict #endif #if MIN_GHC_API_VERSION(9,0,0) -import "ghc-lib-parser" GHC.Types.SrcLoc hiding +import GHC.Types.SrcLoc hiding (RealSrcSpan) -import qualified "ghc-lib-parser" GHC.Types.SrcLoc as GHC +import qualified GHC.Types.SrcLoc as GHC #else -import "ghc-lib-parser" SrcLoc hiding +import qualified SrcLoc as GHC +import SrcLoc hiding (RealSrcSpan) -import qualified "ghc-lib-parser" SrcLoc as GHC #endif -import "ghc-lib-parser" GHC.LanguageExtensions (Extension) +import GHC.LanguageExtensions (Extension) import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx (readExtension) import System.FilePath (takeFileName) import System.IO (IOMode (WriteMode), @@ -102,21 +100,7 @@ import System.IO (IOMode (Wri utf8, withFile) import System.IO.Temp -#else -import Development.IDE.GHC.Compat hiding - (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) -import qualified Refact.Fixity as Refact -#endif + import Ide.Plugin.Config hiding (Config) import Ide.Plugin.Error @@ -169,7 +153,6 @@ instance Pretty Log where LogGetIdeas fp -> "Getting hlint ideas for " <+> viaShow fp LogResolve msg -> pretty msg -#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 = () @@ -183,7 +166,6 @@ pattern RealSrcSpan x y = GHC.RealSrcSpan x y pattern RealSrcSpan x y <- ((,Nothing) -> (GHC.RealSrcSpan x, y)) #endif {-# COMPLETE RealSrcSpan, UnhelpfulSpan #-} -#endif #if MIN_GHC_API_VERSION(9,4,0) fromStrictMaybe :: Strict.Maybe a -> Maybe a @@ -310,28 +292,6 @@ getIdeas recorder nfp = do fmap applyHints' (moduleEx flags) where moduleEx :: ParseFlags -> Action (Maybe (Either ParseError ModuleEx)) -#ifndef HLINT_ON_GHC_LIB - moduleEx _flags = do - mbpm <- getParsedModuleWithComments nfp - return $ createModule <$> mbpm - where - createModule pm = Right (createModuleEx anns (applyParseFlagsFixities modu)) - where anns = pm_annotations pm - modu = pm_parsed_source pm - - applyParseFlagsFixities :: ParsedSource -> ParsedSource - applyParseFlagsFixities modul = GhclibParserEx.applyFixities (parseFlagsToFixities _flags) modul - - parseFlagsToFixities :: ParseFlags -> [(String, Fixity)] - parseFlagsToFixities = map toFixity . Hlint.fixities - - toFixity :: FixityInfo -> (String, Fixity) - toFixity (name, dir, i) = (name, Fixity NoSourceText i $ f dir) - where - f LeftAssociative = InfixL - f RightAssociative = InfixR - f NotAssociative = InfixN -#else moduleEx flags = do mbpm <- getParsedModuleWithComments nfp -- If ghc was not able to parse the module, we disable hlint diagnostics @@ -354,11 +314,6 @@ getIdeas recorder nfp = do -- and the ModSummary dynflags. However using the parsedFlags extensions -- can sometimes interfere with the hlint parsing of the file. -- See https://github.com/haskell/haskell-language-server/issues/1279 --- --- Note: this is used when HLINT_ON_GHC_LIB is defined. We seem to need --- these extensions to construct dynflags to parse the file again. Therefore --- using hlint default extensions doesn't seem to be a problem when --- HLINT_ON_GHC_LIB is not defined because we don't parse the file again. getExtensions :: NormalizedFilePath -> Action [Extension] getExtensions nfp = do dflags <- getFlags @@ -369,7 +324,6 @@ getExtensions nfp = do getFlags = do modsum <- use_ GetModSummary nfp return $ ms_hspp_opts $ msrModSummary modsum -#endif -- --------------------------------------------------------------------- @@ -567,7 +521,6 @@ applyHint recorder ide nfp mhint verTxtDocId = -- But "Idea"s returned by HLint point to starting position of the expressions -- that contain refactorings, so they are often outside the refactorings' boundaries. let position = Nothing -#ifdef HLINT_ON_GHC_LIB let writeFileUTF8NoNewLineTranslation file txt = withFile file WriteMode $ \h -> do hSetEncoding h utf8 @@ -583,22 +536,6 @@ applyHint recorder ide nfp mhint verTxtDocId = let refactExts = map show $ enabled ++ disabled (Right <$> applyRefactorings (topDir dflags) position commands temp refactExts) `catches` errorHandlers -#else - mbParsedModule <- liftIO $ runAction' $ getParsedModuleWithComments nfp - res <- - case mbParsedModule of - Nothing -> throwError "Apply hint: error parsing the module" - Just pm -> do - let anns = pm_annotations pm - let modu = pm_parsed_source pm - -- apply-refact uses RigidLayout - let rigidLayout = deltaOptions RigidLayout - (anns', modu') <- - ExceptT $ mapM (uncurry Refact.applyFixities) - $ postParseTransform (Right (anns, [], dflags, modu)) rigidLayout - liftIO $ (Right <$> Refact.applyRefactorings' position commands anns' modu') - `catches` errorHandlers -#endif case res of Right appliedFile -> do let wsEdit = diffText' True (verTxtDocId, oldContent) (T.pack appliedFile) IncludeDeletions