diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index af56dc7727..90c00d94b7 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -30,7 +30,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8", "9.0.2"] + ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8"] platform: [ { image: "debian:9" , installCmd: "sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && sed -i 's|security.debian.org|archive.debian.org/|g' /etc/apt/sources.list && sed -i /-updates/d /etc/apt/sources.list && apt-get update && apt-get install -y" , toolRequirements: "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" @@ -118,15 +118,6 @@ jobs: # Perhaps we can migrate *all* unknown linux builds to a uniform # image. include: - - ghc: 9.0.2 - platform: - { image: "rockylinux:8" - , installCmd: "yum -y install epel-release && yum install -y --allowerasing" - , toolRequirements: "autoconf automake binutils bzip2 coreutils curl elfutils-devel elfutils-libs findutils gcc gcc-c++ git gmp gmp-devel jq lbzip2 make ncurses ncurses-compat-libs ncurses-devel openssh-clients patch perl pxz python3 sqlite sudo wget which xz zlib-devel patchelf" - , DISTRO: "Unknown" - , ARTIFACT: "x86_64-linux-unknown" - , ADD_CABAL_ARGS: "--enable-split-sections" - } - ghc: 9.2.8 platform: { image: "rockylinux:8" @@ -222,7 +213,7 @@ jobs: strategy: fail-fast: true matrix: - ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8", "9.0.2"] + ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8" ] steps: - uses: docker://arm64v8/ubuntu:focal name: Cleanup (aarch64 linux) @@ -282,7 +273,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8", "9.0.2"] + ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8"] steps: - name: Checkout code uses: actions/checkout@v3 @@ -372,7 +363,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8", "9.0.2"] + ghc: ["9.8.1", "9.6.3", "9.4.7", "9.2.8"] steps: - name: install windows deps shell: pwsh diff --git a/.github/workflows/supported-ghc-versions.json b/.github/workflows/supported-ghc-versions.json index eee26fd884..5a59fdc0a7 100644 --- a/.github/workflows/supported-ghc-versions.json +++ b/.github/workflows/supported-ghc-versions.json @@ -1 +1 @@ -[ "9.8", "9.6", "9.4" , "9.2" , "9.0" ] +[ "9.8", "9.6", "9.4" , "9.2" ] diff --git a/docs/support/ghc-version-support.md b/docs/support/ghc-version-support.md index 27b4c2626f..cad8bf2481 100644 --- a/docs/support/ghc-version-support.md +++ b/docs/support/ghc-version-support.md @@ -32,7 +32,7 @@ Support status (see the support policy below for more details): | 9.2.(5,6) | [1.9.1.0](https://github.com/haskell/haskell-language-server/releases/tag/1.9.1.0) | deprecated | | 9.2.(3,4) | [1.8.0.0](https://github.com/haskell/haskell-language-server/releases/tag/1.8.0.0) | deprecated | | 9.2.(1,2) | [1.7.0.0](https://github.com/haskell/haskell-language-server/releases/tag/1.7.0.0) | deprecated | -| 9.0.2 | [latest](https://github.com/haskell/haskell-language-server/releases/latest) | full support | +| 9.0.2 | [2.4.0.0](https://github.com/haskell/haskell-language-server/releases/tag/2.4.0.0) | deprecated | | 9.0.1 | [1.6.1.0](https://github.com/haskell/haskell-language-server/releases/tag/1.6.1.0) | deprecated | | 8.10.7 | [2.2.0.0](https://github.com/haskell/haskell-language-server/releases/tag/2.2.0.0) | deprecated | | 8.10.6 | [1.6.1.0](https://github.com/haskell/haskell-language-server/releases/tag/1.6.1.0) | deprecated | diff --git a/docs/support/plugin-support.md b/docs/support/plugin-support.md index 42118574fb..553fa7c901 100644 --- a/docs/support/plugin-support.md +++ b/docs/support/plugin-support.md @@ -60,7 +60,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has | `hls-ormolu-plugin` | 2 | 9.8 | | `hls-rename-plugin` | 2 | 9.8 | | `hls-stylish-haskell-plugin` | 2 | 9.8 | -| `hls-overloaded-record-dot-plugin` | 2 | 9.0 | +| `hls-overloaded-record-dot-plugin` | 2 | | | `hls-floskell-plugin` | 3 | 9.6, 9.8 | | `hls-stan-plugin` | 3 | 9.2.(4-8) | | `hls-retrie-plugin` | 3 | 9.8 | diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 5e475da931..03cc575c78 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -28,13 +28,6 @@ source-repository head type: git location: https://github.com/haskell/haskell-language-server.git -flag ghc-patched-unboxed-bytecode - description: - The GHC version we link against supports unboxed sums and tuples in bytecode - - default: False - manual: True - flag ekg description: Enable EKG monitoring of the build graph and other metrics on port 8999 @@ -232,9 +225,6 @@ library -Wall -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors -Wunused-packages -fno-ignore-asserts - if flag(ghc-patched-unboxed-bytecode) - cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE - if flag(pedantic) -- We eventually want to build with Werror fully, but we haven't -- finished purging the warnings, so some are set to not be errors diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 4f0dc3bbb5..9ae787a30e 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -40,8 +40,8 @@ import Data.Function import Data.Hashable hiding (hash) import qualified Data.HashMap.Strict as HM import Data.List +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE -import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Proxy @@ -826,7 +826,7 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do #if MIN_VERSION_ghc(9,3,0) -- Set up a multi component session with the other units on GHC 9.4 Compat.initUnits (map snd uids) (hscSetFlags df hsc_env) -#elif MIN_VERSION_ghc(9,2,0) +#else -- This initializes the units for GHC 9.2 -- Add the options for the current component to the HscEnv -- We want to call `setSessionDynFlags` instead of `hscSetFlags` @@ -837,9 +837,6 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do evalGhcEnv hsc_env $ do _ <- setSessionDynFlags $ df getSession -#else - -- getOptions is enough to initialize units on GHC <9.2 - pure $ hscSetFlags df hsc_env { hsc_IC = (hsc_IC hsc_env) { ic_dflags = df } } #endif let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index bbaf3d036e..eba9cd6ec1 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -110,27 +110,17 @@ import System.IO.Extra (fixIO, newTempFileWithin) import GHC.Tc.Gen.Splice -#if !MIN_VERSION_ghc(9,2,1) -import GHC.Driver.Types -#endif -#if !MIN_VERSION_ghc(9,2,0) -import qualified Data.IntMap.Strict as IntMap -#endif -#if MIN_VERSION_ghc(9,2,0) import qualified GHC as G -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import GHC (ModuleGraph) #endif -#if MIN_VERSION_ghc(9,2,1) import GHC.Types.ForeignStubs import GHC.Types.HpcInfo import GHC.Types.TypeEnv -#endif #if !MIN_VERSION_ghc(9,3,0) import Data.Map (Map) @@ -265,7 +255,6 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr -#if MIN_VERSION_ghc(9,2,0) ; let iNTERACTIVELoc = G.ModLocation{ ml_hs_file = Nothing, ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", @@ -293,11 +282,6 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do (icInteractiveModule ictxt) stg_expr [] Nothing -#else - {- Convert to BCOs -} - ; bcos <- coreExprToBCOs hsc_env - (icInteractiveModule (hsc_IC hsc_env)) prepd_expr -#endif -- Exclude wired-in names because we may not have read -- their interface files, so getLinkDeps will fail @@ -312,11 +296,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do moduleName mod -- On <= 9.2, just the name is enough because all unit ids will be the same #endif -#if MIN_VERSION_ghc(9,2,0) | n <- concatMap (uniqDSetToList . bcoFreeNames) $ bc_bcos bcos -#else - | n <- uniqDSetToList (bcoFreeNames bcos) -#endif , Just mod <- [nameModule_maybe n] -- Names from other modules , not (isWiredInName n) -- Exclude wired-in names , moduleUnitId mod `elem` home_unit_ids -- Only care about stuff from the home package set @@ -357,13 +337,10 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do {- load it -} ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos ; let hval = ((expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs), lbss, pkgs) -#elif MIN_VERSION_ghc(9,2,0) +#else {- load it -} ; fv_hvs <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs) -#else - {- link it -} - ; hval <- linkExpr hsc_env' srcspan bcos #endif ; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb]) @@ -881,7 +858,7 @@ generateHieAsts hscEnv tcm = where dflags = hsc_dflags hscEnv run _ts = -- ts is only used in GHC 9.2 -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) fmap (join . snd) . liftIO . initDs hscEnv _ts #else id @@ -1189,7 +1166,7 @@ getModSummaryFromImports env fp _modTime mContents = do convImport (L _ i) = ( -#if !MIN_VERSION_ghc (9,3,0) +#if !MIN_VERSION_ghc(9,3,0) fmap sl_fs #endif (ideclPkgQual i) @@ -1197,7 +1174,7 @@ getModSummaryFromImports env fp _modTime mContents = do msrImports = implicit_imports ++ imps -#if MIN_VERSION_ghc (9,3,0) +#if MIN_VERSION_ghc(9,3,0) rn_pkg_qual = renameRawPkgQual (hsc_unit_env ppEnv) rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn)) srcImports = rn_imps $ map convImport src_idecls @@ -1714,9 +1691,6 @@ getDocsBatch hsc_env _names = do #else Map.lookup name dmap , #endif -#if !MIN_VERSION_ghc(9,2,0) - IntMap.fromAscList $ Map.toAscList $ -#endif #if MIN_VERSION_ghc(9,3,0) lookupWithDefaultUniqMap amap mempty name)) #else @@ -1739,12 +1713,7 @@ lookupName :: HscEnv lookupName _ name | Nothing <- nameModule_maybe name = pure Nothing lookupName hsc_env name = exceptionHandle $ do -#if MIN_VERSION_ghc(9,2,0) mb_thing <- liftIO $ lookupType hsc_env name -#else - eps <- liftIO $ readIORef (hsc_EPS hsc_env) - let mb_thing = lookupType (hsc_dflags hsc_env) (hsc_HPT hsc_env) (eps_PTE eps) name -#endif case mb_thing of x@(Just _) -> return x Nothing diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index ae4e6a44bd..7cc89ce170 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -697,12 +697,10 @@ dependencyInfoForFiles fs = do mg = mkModuleGraph mns #else let mg = mkModuleGraph $ -#if MIN_VERSION_ghc(9,2,0) -- We don't do any instantiation for backpack at this point of time, so it is OK to use -- 'extendModSummaryNoDeps'. -- This may have to change in the future. map extendModSummaryNoDeps $ -#endif (catMaybes mss) #endif pure (fingerprintToBS $ Util.fingerprintFingerprints $ map (maybe fingerprint0 msrFingerprint) msrs, processDependencyInformation rawDepInfo bm mg) @@ -822,12 +820,10 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs) #else let module_graph_nodes = -#if MIN_VERSION_ghc(9,2,0) -- We don't do any instantiation for backpack at this point of time, so it is OK to use -- 'extendModSummaryNoDeps'. -- This may have to change in the future. map extendModSummaryNoDeps $ -#endif nubOrdOn ms_mod (ms : concatMap mgModSummaries mgs) #endif liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes @@ -1219,12 +1215,7 @@ uses_th_qq (ms_hspp_opts -> dflags) = -- Depends on whether it uses unboxed tuples or sums computeLinkableTypeForDynFlags :: DynFlags -> LinkableType computeLinkableTypeForDynFlags d -#if defined(GHC_PATCHED_UNBOXED_BYTECODE) || MIN_VERSION_ghc(9,2,0) = BCOLinkable -#else - | _unboxed_tuples_or_sums = ObjectLinkable - | otherwise = BCOLinkable -#endif where -- unboxed_tuples_or_sums is only used in GHC < 9.2 _unboxed_tuples_or_sums = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 2d816a562c..b65fa8e89a 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -63,9 +63,5 @@ doCpp env input_fn output_fn = let cpp_opts = True in #endif -#if MIN_VERSION_ghc(9,2,0) Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) cpp_opts input_fn output_fn -#else - Pipeline.doCpp (hsc_dflags env) cpp_opts input_fn output_fn -#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 2b2392af32..fd5e0c01d5 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -31,13 +31,11 @@ module Development.IDE.GHC.Compat( pattern PFailedWithErrorMessages, isObjectLinkable, -#if MIN_VERSION_ghc(9,2,0) #if !MIN_VERSION_ghc(9,3,0) extendModSummaryNoDeps, emsModSummary, #endif myCoreToStgExpr, -#endif Usage(..), @@ -123,17 +121,12 @@ module Development.IDE.GHC.Compat( emptyInScopeSet, Unfolding(..), noUnfolding, -#if MIN_VERSION_ghc(9,2,0) loadExpr, byteCodeGen, bc_bcos, loadDecls, hscInterp, expectJust, -#else - coreExprToBCOs, - linkExpr, -#endif extract_cons, recDotDot, #if MIN_VERSION_ghc(9,5,0) @@ -191,27 +184,17 @@ import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) import GHC.Types.Var.Env import GHC.Iface.Make (mkIfaceExports) -import qualified GHC.SysTools.Tasks as SysTools +import GHC.SysTools.Tasks (runUnlit, runPp) import qualified GHC.Types.Avail as Avail -#if !MIN_VERSION_ghc(9,2,0) -import GHC.Utils.Error -import GHC.CoreToByteCode (coreExprToBCOs) -import GHC.Runtime.Linker (linkExpr) -import GHC.Driver.Types -#endif #if !MIN_VERSION_ghc(9,5,0) import GHC.Core.Lint (lintInteractiveExpr) #endif -#if !MIN_VERSION_ghc(9,2,0) -import Data.Bifunctor -#endif -#if MIN_VERSION_ghc(9,2,0) import GHC.Iface.Env -import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Types.SrcLoc (combineRealSrcSpans) import GHC.Linker.Loader (loadExpr) import GHC.Runtime.Context (icInteractiveModule) import GHC.Unit.Home.ModInfo (HomePackageTable, @@ -228,9 +211,8 @@ import GHC.Stg.Syntax import GHC.StgToByteCode import GHC.Types.CostCentre import GHC.Types.IPE -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..)) import GHC.Linker.Types (isObjectLinkable) import GHC.Unit.Module.ModSummary @@ -276,7 +258,6 @@ nameEnvElts :: NameEnv a -> [a] nameEnvElts = nonDetNameEnvElts #endif -#if MIN_VERSION_ghc(9,2,0) myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext #if MIN_VERSION_ghc(9,3,0) -> Bool @@ -365,16 +346,8 @@ myCoreToStg logger dflags ictxt #endif return (stg_binds2, denv, cost_centre_info) -#endif -#if !MIN_VERSION_ghc(9,2,0) -reLoc :: Located a -> Located a -reLoc = id - -reLocA :: Located a -> Located a -reLocA = id -#endif getDependentMods :: ModIface -> [ModuleName] #if MIN_VERSION_ghc(9,3,0) @@ -408,7 +381,6 @@ renderMessages msgs = msgs #endif -#if MIN_VERSION_ghc(9,2,0) pattern PFailedWithErrorMessages :: forall a b. (b -> Bag (MsgEnvelope DecoratedSDoc)) -> ParseResult a pattern PFailedWithErrorMessages msgs #if MIN_VERSION_ghc(9,3,0) @@ -416,11 +388,6 @@ pattern PFailedWithErrorMessages msgs #else <- PFailed (const . fmap pprError . getErrorMessages -> msgs) #endif -#else -pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a -pattern PFailedWithErrorMessages msgs - <- PFailed (getErrorMessages -> msgs) -#endif {-# COMPLETE POk, PFailedWithErrorMessages #-} hieExportNames :: HieFile -> [(SrcSpan, Name)] @@ -570,26 +537,6 @@ ghcVersion = GHC96 ghcVersion = GHC94 #elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0) ghcVersion = GHC92 -#elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) -ghcVersion = GHC90 -#elif MIN_VERSION_GLASGOW_HASKELL(8,10,0,0) -ghcVersion = GHC810 -#endif - -runUnlit :: Logger -> DynFlags -> [Option] -> IO () -runUnlit = -#if MIN_VERSION_ghc(9,2,0) - SysTools.runUnlit -#else - const SysTools.runUnlit -#endif - -runPp :: Logger -> DynFlags -> [Option] -> IO () -runPp = -#if MIN_VERSION_ghc(9,2,0) - SysTools.runPp -#else - const SysTools.runPp #endif simpleNodeInfoCompat :: FastStringCompat -> FastStringCompat -> NodeInfo a @@ -599,43 +546,17 @@ isAnnotationInNodeInfo :: (FastStringCompat, FastStringCompat) -> NodeInfo a -> isAnnotationInNodeInfo p = S.member p . nodeAnnotations nodeAnnotations :: NodeInfo a -> S.Set (FastStringCompat, FastStringCompat) -#if MIN_VERSION_ghc(9,2,0) nodeAnnotations = S.map (\(NodeAnnotation ctor typ) -> (coerce ctor, coerce typ)) . GHC.nodeAnnotations -#else -nodeAnnotations = S.map (bimap coerce coerce) . GHC.nodeAnnotations -#endif -#if MIN_VERSION_ghc(9,2,0) newtype FastStringCompat = FastStringCompat LexicalFastString -#else -newtype FastStringCompat = FastStringCompat FastString -#endif deriving (Show, Eq, Ord) instance IsString FastStringCompat where -#if MIN_VERSION_ghc(9,2,0) fromString = FastStringCompat . LexicalFastString . fromString -#else - fromString = FastStringCompat . fromString -#endif mkAstNode :: NodeInfo a -> Span -> [HieAST a] -> HieAST a mkAstNode n = Node (SourcedNodeInfo $ Map.singleton GeneratedInfo n) -combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan -#if MIN_VERSION_ghc(9,2,0) -combineRealSrcSpans = SrcLoc.combineRealSrcSpans -#else -combineRealSrcSpans span1 span2 - = mkRealSrcSpan (mkRealSrcLoc file line_start col_start) (mkRealSrcLoc file line_end col_end) - where - (line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1) - (srcSpanStartLine span2, srcSpanStartCol span2) - (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1) - (srcSpanEndLine span2, srcSpanEndCol span2) - file = srcSpanFile span1 -#endif - -- | Load modules, quickly. Input doesn't need to be desugared. -- A module must be loaded before dependent modules can be typechecked. -- This variant of loadModuleHome will *never* cause recompilation, it just diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 70619e5081..767d23ef35 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -41,9 +41,6 @@ module Development.IDE.GHC.Compat.Core ( loadSysInterface, importDecl, CommandLineOption, -#if !MIN_VERSION_ghc(9,2,0) - staticPlugins, -#endif sPgm_F, settings, gopt, @@ -106,10 +103,6 @@ module Development.IDE.GHC.Compat.Core ( -- * ModDetails ModDetails(..), -- * HsExpr, -#if !MIN_VERSION_ghc(9,2,0) - pattern HsLet, - pattern LetStmt, -#endif -- * Var Type ( TyCoRep.TyVarTy, @@ -127,18 +120,12 @@ module Development.IDE.GHC.Compat.Core ( pattern ConPatIn, conPatDetails, mapConPatDetail, -#if !MIN_VERSION_ghc(9,2,0) - Development.IDE.GHC.Compat.Core.splitForAllTyCoVars, -#endif mkVisFunTys, -- * Specs ImpDeclSpec(..), ImportSpec(..), -- * SourceText SourceText(..), -#if !MIN_VERSION_ghc(9,2,0) - rationalFromFractionalLit, -#endif -- * Name tyThingParent_maybe, -- * Ways @@ -183,8 +170,8 @@ module Development.IDE.GHC.Compat.Core ( hscTypecheckRename, Development.IDE.GHC.Compat.Core.makeSimpleDetails, -- * Typecheck utils - Development.IDE.GHC.Compat.Core.tcSplitForAllTyVars, - Development.IDE.GHC.Compat.Core.tcSplitForAllTyVarBinder_maybe, + tcSplitForAllTyVars, + tcSplitForAllTyVarBinder_maybe, typecheckIface, Development.IDE.GHC.Compat.Core.mkIfaceTc, Development.IDE.GHC.Compat.Core.mkBootModDetailsTc, @@ -200,19 +187,14 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.Located, SrcLoc.unLoc, getLoc, - getLocA, - locA, - noLocA, + GHC.getLocA, + GHC.locA, + GHC.noLocA, unLocA, LocatedAn, - LocatedA, -#if MIN_VERSION_ghc(9,2,0) + GHC.LocatedA, GHC.AnnListItem(..), GHC.NameAnn(..), -#else - AnnListItem, - NameAnn, -#endif SrcLoc.RealLocated, SrcLoc.GenLocated(..), SrcLoc.SrcSpan(SrcLoc.UnhelpfulSpan), @@ -222,10 +204,8 @@ module Development.IDE.GHC.Compat.Core ( pattern RealSrcLoc, SrcLoc.SrcLoc(SrcLoc.UnhelpfulLoc), BufSpan, -#if MIN_VERSION_ghc(9,2,0) SrcSpanAnn', GHC.SrcAnn, -#endif SrcLoc.leftmost_smallest, SrcLoc.containsSpan, SrcLoc.mkGeneralSrcSpan, @@ -314,9 +294,7 @@ module Development.IDE.GHC.Compat.Core ( gre_imp, gre_lcl, gre_par, -#if MIN_VERSION_ghc(9,2,0) collectHsBindsBinders, -#endif -- * Util Module re-exports module GHC.Builtin.Names, module GHC.Builtin.Types, @@ -329,9 +307,6 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Core.FamInstEnv, module GHC.Core.InstEnv, module GHC.Types.Unique.FM, -#if !MIN_VERSION_ghc(9,2,0) - module GHC.Core.Ppr.TyThing, -#endif module GHC.Core.PatSyn, module GHC.Core.Predicate, module GHC.Core.TyCon, @@ -346,7 +321,6 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Iface.Syntax, -#if MIN_VERSION_ghc(9,2,0) module GHC.Hs.Decls, module GHC.Hs.Expr, module GHC.Hs.Doc, @@ -356,7 +330,6 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Hs.Type, module GHC.Hs.Utils, module Language.Haskell.Syntax, -#endif module GHC.Rename.Names, module GHC.Rename.Splice, @@ -377,7 +350,6 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Types.Name.Env, module GHC.Types.Name.Reader, module GHC.Utils.Error, -#if MIN_VERSION_ghc(9,2,0) #if !MIN_VERSION_ghc(9,7,0) module GHC.Types.Avail, #endif @@ -385,7 +357,6 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Types.SourceText, module GHC.Types.TyThing, module GHC.Types.TyThing.Ppr, -#endif module GHC.Types.Unique.Supply, module GHC.Types.Var, module GHC.Unit.Module, @@ -519,7 +490,7 @@ import GHC.Types.Var (Var (varName), setTyVarUnique, setVarUnique) import GHC.Unit.Info (PackageName (..)) import GHC.Unit.Module hiding (ModLocation (..), UnitId, - addBootSuffixLocnOut, moduleUnit, + moduleUnit, toUnitId) import qualified GHC.Unit.Module as Module import GHC.Unit.State (ModuleOrigin (..)) @@ -527,20 +498,7 @@ import GHC.Utils.Error (Severity (..), emptyMessages) import GHC.Utils.Panic hiding (try) import qualified GHC.Utils.Panic.Plain as Plain -#if !MIN_VERSION_ghc(9,2,0) -import GHC.Core.Ppr.TyThing hiding (pprFamInst) -import GHC.Core.TyCo.Rep (scaledThing) -import GHC.Driver.Finder hiding (mkHomeModLocation) -import GHC.Driver.Types -import GHC.Driver.Ways -import GHC.Hs hiding (HsLet, LetStmt) -import GHC.Parser.Lexer -import qualified GHC.Runtime.Linker as Linker -import GHC.Types.Name.Set -import qualified GHC.Driver.Finder as GHC -#endif -#if MIN_VERSION_ghc(9,2,0) import Data.Foldable (toList) import GHC.Data.Bag import GHC.Core.Multiplicity (scaledThing) @@ -580,9 +538,8 @@ import GHC.Unit.Module.ModIface (IfaceExport, ModIface (..), ModIface_ (..), mi_fix) import GHC.Unit.Module.ModSummary (ModSummary (..)) import Language.Haskell.Syntax hiding (FunDep) -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import GHC.Types.SourceFile (SourceModified(..)) import GHC.Unit.Module.Graph (mkModuleGraph) import qualified GHC.Unit.Finder as GHC @@ -639,31 +596,24 @@ pattern RealSrcLoc x y = SrcLoc.RealSrcLoc x y pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo #if __GLASGOW_HASKELL__ >= 907 pattern AvailTC n names pieces <- Avail.AvailTC n ((,[]) -> (names,pieces)) -#elif __GLASGOW_HASKELL__ >= 902 +#else pattern AvailTC n names pieces <- Avail.AvailTC n ((\gres -> foldr (\gre (names, pieces) -> case gre of Avail.NormalGreName name -> (name: names, pieces) Avail.FieldGreName label -> (names, label:pieces)) ([], []) gres) -> (names, pieces)) -#else -pattern AvailTC n names pieces <- Avail.AvailTC n names pieces #endif pattern AvailName :: Name -> Avail.AvailInfo #if __GLASGOW_HASKELL__ >= 907 pattern AvailName n <- Avail.Avail n -#elif __GLASGOW_HASKELL__ >= 902 +#else pattern AvailName n <- Avail.Avail (Avail.NormalGreName n) -#else -pattern AvailName n <- Avail.Avail n #endif pattern AvailFL :: FieldLabel -> Avail.AvailInfo #if __GLASGOW_HASKELL__ >= 907 pattern AvailFL fl <- (const Nothing -> Just fl) -- this pattern always fails as this field was removed in 9.7 -#elif __GLASGOW_HASKELL__ >= 902 +#else pattern AvailFL fl <- Avail.Avail (Avail.FieldGreName fl) -#else --- pattern synonym that is never populated -pattern AvailFL x <- Avail.Avail (const (True, undefined) -> (False, x)) #endif {-# COMPLETE AvailTC, AvailName, AvailFL #-} @@ -694,54 +644,20 @@ instance HasSrcSpan SrcSpan where instance HasSrcSpan (SrcLoc.GenLocated SrcSpan a) where getLoc = GHC.getLoc -#if MIN_VERSION_ghc(9,2,0) instance HasSrcSpan (SrcSpanAnn' ann) where - getLoc = locA + getLoc = GHC.locA instance HasSrcSpan (SrcLoc.GenLocated (SrcSpanAnn' ann) a) where getLoc (L l _) = l pattern L :: HasSrcSpan a => SrcSpan -> e -> SrcLoc.GenLocated a e pattern L l a <- GHC.L (getLoc -> l) a {-# COMPLETE L #-} -#endif - --- | Add the @-boot@ suffix to all output file paths associated with the --- module, not including the input file itself -addBootSuffixLocnOut :: GHC.ModLocation -> GHC.ModLocation -addBootSuffixLocnOut = Module.addBootSuffixLocnOut - -#if !MIN_VERSION_ghc(9,2,0) -splitForAllTyCoVars :: Type -> ([TyCoVar], Type) -splitForAllTyCoVars = - splitForAllTys -#endif - -tcSplitForAllTyVars :: Type -> ([TyVar], Type) -tcSplitForAllTyVars = -#if MIN_VERSION_ghc(9,2,0) - TcType.tcSplitForAllTyVars -#else - tcSplitForAllTys -#endif - - -tcSplitForAllTyVarBinder_maybe :: Type -> Maybe (TyVarBinder, Type) -tcSplitForAllTyVarBinder_maybe = -#if MIN_VERSION_ghc(9,2,0) - TcType.tcSplitForAllTyVarBinder_maybe -#else - tcSplitForAllTy_maybe -#endif -- This is from the old api, but it still simplifies pattern ConPatIn :: SrcLoc.Located (ConLikeP GhcPs) -> HsConPatDetails GhcPs -> Pat GhcPs -#if MIN_VERSION_ghc(9,2,0) pattern ConPatIn con args <- ConPat EpAnnNotUsed (L _ (SrcLoc.noLoc -> con)) args where ConPatIn con args = ConPat EpAnnNotUsed (GHC.noLocA $ SrcLoc.unLoc con) args -#else -pattern ConPatIn con args = ConPat NoExtField con args -#endif conPatDetails :: Pat p -> Maybe (HsConPatDetails p) conPatDetails (ConPat _ _ args) = Just args @@ -754,98 +670,36 @@ mapConPatDetail _ _ = Nothing initObjLinker :: HscEnv -> IO () initObjLinker env = -#if !MIN_VERSION_ghc(9,2,0) - GHCi.initObjLinker env -#else GHCi.initObjLinker (GHCi.hscInterp env) -#endif loadDLL :: HscEnv -> String -> IO (Maybe String) loadDLL env = -#if !MIN_VERSION_ghc(9,2,0) - GHCi.loadDLL env -#else GHCi.loadDLL (GHCi.hscInterp env) -#endif unload :: HscEnv -> [Linkable] -> IO () unload hsc_env linkables = Linker.unload -#if MIN_VERSION_ghc(9,2,0) (GHCi.hscInterp hsc_env) -#endif hsc_env linkables #if !MIN_VERSION_ghc(9,3,0) setOutputFile :: FilePath -> DynFlags -> DynFlags setOutputFile f d = d { -#if MIN_VERSION_ghc(9,2,0) outputFile_ = Just f -#else - outputFile = Just f -#endif } #endif isSubspanOfA :: LocatedAn la a -> LocatedAn lb b -> Bool -#if MIN_VERSION_ghc(9,2,0) isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLocA a) (GHC.getLocA b) -#else -isSubspanOfA a b = SrcLoc.isSubspanOf (GHC.getLoc a) (GHC.getLoc b) -#endif -#if MIN_VERSION_ghc(9,2,0) type LocatedAn a = GHC.LocatedAn a -#else -type LocatedAn a = GHC.Located -#endif - -#if MIN_VERSION_ghc(9,2,0) -type LocatedA = GHC.LocatedA -#else -type LocatedA = GHC.Located -#endif -#if MIN_VERSION_ghc(9,2,0) -locA :: SrcSpanAnn' a -> SrcSpan -locA = GHC.locA -#else -locA = id -#endif - -#if MIN_VERSION_ghc(9,2,0) unLocA :: forall pass a. XRec (GhcPass pass) a -> a unLocA = unXRec @(GhcPass pass) -#else -unLocA = id -#endif - -#if MIN_VERSION_ghc(9,2,0) -getLocA :: SrcLoc.GenLocated (SrcSpanAnn' a) e -> SrcSpan -getLocA = GHC.getLocA -#else --- getLocA :: HasSrcSpan a => a -> SrcSpan -getLocA x = GHC.getLoc x -#endif - -noLocA :: a -> LocatedAn an a -#if MIN_VERSION_ghc(9,2,0) -noLocA = GHC.noLocA -#else -noLocA = GHC.noLoc -#endif - -#if !MIN_VERSION_ghc(9,2,0) -type AnnListItem = SrcLoc.SrcSpan -#endif -#if !MIN_VERSION_ghc(9,2,0) -type NameAnn = SrcLoc.SrcSpan -#endif pattern GRE :: Name -> Parent -> Bool -> [ImportSpec] -> RdrName.GlobalRdrElt {-# COMPLETE GRE #-} -#if MIN_VERSION_ghc(9,2,0) pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE #if MIN_VERSION_ghc(9,7,0) {gre_name = gre_name @@ -853,24 +707,11 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE {gre_name = (greNamePrintableName -> gre_name) #endif ,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)} -#else -pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} = RdrName.GRE{..} -#endif -#if MIN_VERSION_ghc(9,2,0) collectHsBindsBinders :: CollectPass p => Bag (XRec p (HsBindLR p idR)) -> [IdP p] collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x -#endif -#if !MIN_VERSION_ghc(9,2,0) -pattern HsLet xlet localBinds expr <- GHC.HsLet xlet (SrcLoc.unLoc -> localBinds) expr -pattern LetStmt xlet localBinds <- GHC.LetStmt xlet (SrcLoc.unLoc -> localBinds) -#endif -#if !MIN_VERSION_ghc(9,2,0) -rationalFromFractionalLit :: FractionalLit -> Rational -rationalFromFractionalLit = fl_value -#endif makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails makeSimpleDetails hsc_env = @@ -920,14 +761,7 @@ hscUpdateHPT :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv hscUpdateHPT k session = session { hsc_HPT = k (hsc_HPT session) } #endif -#if !MIN_VERSION_ghc(9,2,0) -match :: HsRecField' id arg -> ((), id, arg, Bool) -match (HsRecField lhs rhs pun) = ((), SrcLoc.unLoc lhs, rhs, pun) - -pattern HsFieldBind :: () -> id -> arg -> Bool -> HsRecField' id arg -pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- (match -> (hfbAnn, hfbLHS, hfbRHS, hfbPun)) where - HsFieldBind _ lhs rhs pun = HsRecField (SrcLoc.noLoc lhs) rhs pun -#elif !MIN_VERSION_ghc(9,4,0) +#if !MIN_VERSION_ghc(9,4,0) pattern HsFieldBind :: XHsRecField id -> id -> arg -> Bool -> HsRecField' id arg pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- HsRecField hfbAnn (SrcLoc.unLoc -> hfbLHS) hfbRHS hfbPun where HsFieldBind ann lhs rhs pun = HsRecField ann (SrcLoc.noLoc lhs) rhs pun diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index c1bb5a6aab..b7b268b5b0 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -16,17 +16,17 @@ module Development.IDE.GHC.Compat.Env ( setInteractiveDynFlags, Env.hsc_dflags, hsc_EPS, - hsc_logger, - hsc_tmpfs, - hsc_unit_env, - hsc_hooks, + Env.hsc_logger, + Env.hsc_tmpfs, + Env.hsc_unit_env, + Env.hsc_hooks, hscSetHooks, TmpFs, -- * HomeUnit hscHomeUnit, HomeUnit, setHomeUnitId_, - Development.IDE.GHC.Compat.Env.mkHomeModule, + Home.mkHomeModule, -- * Provide backwards Compatible -- types and helper functions. Logger(..), @@ -35,11 +35,11 @@ module Development.IDE.GHC.Compat.Env ( hscSetFlags, initTempFs, -- * Home Unit - Development.IDE.GHC.Compat.Env.homeUnitId_, + Session.homeUnitId_, -- * DynFlags Helper setBytecodeLinkerOptions, setInterpreterLinkerOptions, - Development.IDE.GHC.Compat.Env.safeImportsOn, + Session.safeImportsOn, -- * Ways Ways, Way, @@ -54,173 +54,58 @@ module Development.IDE.GHC.Compat.Env ( Development.IDE.GHC.Compat.Env.platformDefaultBackend, ) where -import GHC (setInteractiveDynFlags) +import GHC (setInteractiveDynFlags) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -import GHC.Driver.Hooks (Hooks) -import GHC.Driver.Session hiding (mkHomeModule) -import GHC.Unit.Types (Module, UnitId) - -#if !MIN_VERSION_ghc(9,2,0) -import qualified Data.Set as Set -import qualified GHC.Driver.Session as DynFlags -import GHC.Driver.Types (HscEnv, - InteractiveContext (..), - hsc_EPS, - setInteractivePrintName) -import qualified GHC.Driver.Types as Env -import GHC.Driver.Ways -import GHC.Unit.Types (Unit, mkModule) -#endif - -#if !MIN_VERSION_ghc(9,5,0) -import GHC.Unit.Module.Name -#endif - -#if !MIN_VERSION_ghc(9,2,0) -import Data.IORef -#endif - -#if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Backend as Backend -import qualified GHC.Driver.Env as Env -import qualified GHC.Driver.Session as Session +import GHC.Driver.Backend as Backend +import qualified GHC.Driver.Env as Env +import GHC.Driver.Hooks (Hooks) +import GHC.Driver.Session +import qualified GHC.Driver.Session as Session import GHC.Platform.Ways import GHC.Runtime.Context -import GHC.Unit.Env (UnitEnv) -import GHC.Unit.Home as Home +import GHC.Unit.Env (UnitEnv) +import GHC.Unit.Home as Home +import GHC.Unit.Types (UnitId) import GHC.Utils.Logger import GHC.Utils.TmpFs -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env (HscEnv, hsc_EPS) +#if !MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Env (HscEnv, hsc_EPS) #endif #if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env (HscEnv) -#endif - -#if MIN_VERSION_ghc(9,5,0) -import Language.Haskell.Syntax.Module.Name +import GHC.Driver.Env (HscEnv) #endif #if MIN_VERSION_ghc(9,3,0) hsc_EPS :: HscEnv -> UnitEnv -hsc_EPS = hsc_unit_env +hsc_EPS = Env.hsc_unit_env #endif -#if !MIN_VERSION_ghc(9,2,0) -type UnitEnv = () -newtype Logger = Logger { log_action :: LogAction } -type TmpFs = () -#endif setHomeUnitId_ :: UnitId -> DynFlags -> DynFlags -#if MIN_VERSION_ghc(9,2,0) setHomeUnitId_ uid df = df { Session.homeUnitId_ = uid } -#else -setHomeUnitId_ uid df = df { homeUnitId = uid } -#endif hscSetFlags :: DynFlags -> HscEnv -> HscEnv hscSetFlags df env = env { Env.hsc_dflags = df } initTempFs :: HscEnv -> IO HscEnv initTempFs env = do -#if MIN_VERSION_ghc(9,2,0) tmpFs <- initTmpFs pure env { Env.hsc_tmpfs = tmpFs } -#else - filesToClean <- newIORef emptyFilesToClean - dirsToClean <- newIORef mempty - let dflags = (Env.hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean, useUnicode=True} - pure $ hscSetFlags dflags env -#endif hscSetUnitEnv :: UnitEnv -> HscEnv -> HscEnv -#if MIN_VERSION_ghc(9,2,0) hscSetUnitEnv ue env = env { Env.hsc_unit_env = ue } -#else -hscSetUnitEnv _ env = env -#endif - -hsc_unit_env :: HscEnv -> UnitEnv -hsc_unit_env = -#if MIN_VERSION_ghc(9,2,0) - Env.hsc_unit_env -#else - const () -#endif - -hsc_tmpfs :: HscEnv -> TmpFs -hsc_tmpfs = -#if MIN_VERSION_ghc(9,2,0) - Env.hsc_tmpfs -#else - const () -#endif - -hsc_logger :: HscEnv -> Logger -hsc_logger = -#if MIN_VERSION_ghc(9,2,0) - Env.hsc_logger -#else - Logger . DynFlags.log_action . Env.hsc_dflags -#endif - -hsc_hooks :: HscEnv -> Hooks -hsc_hooks = -#if MIN_VERSION_ghc(9,2,0) - Env.hsc_hooks -#else - hooks . Env.hsc_dflags -#endif hscSetHooks :: Hooks -> HscEnv -> HscEnv hscSetHooks hooks env = -#if MIN_VERSION_ghc(9,2,0) env { Env.hsc_hooks = hooks } -#else - hscSetFlags ((Env.hsc_dflags env) { hooks = hooks}) env -#endif - -homeUnitId_ :: DynFlags -> UnitId -homeUnitId_ = -#if MIN_VERSION_ghc(9,2,0) - Session.homeUnitId_ -#else - homeUnitId -#endif - -safeImportsOn :: DynFlags -> Bool -safeImportsOn = -#if MIN_VERSION_ghc(9,2,0) - Session.safeImportsOn -#else - DynFlags.safeImportsOn -#endif - -#if !MIN_VERSION_ghc(9,2,0) -type HomeUnit = Unit -#endif hscHomeUnit :: HscEnv -> HomeUnit hscHomeUnit = -#if MIN_VERSION_ghc(9,2,0) Env.hsc_home_unit -#else - homeUnit . Env.hsc_dflags -#endif - -mkHomeModule :: HomeUnit -> ModuleName -> Module -mkHomeModule = -#if MIN_VERSION_ghc(9,2,0) - Home.mkHomeModule -#else - mkModule -#endif -- | We don't want to generate object code so we compile to bytecode -- (HscInterpreted) which implies LinkInMemory @@ -230,10 +115,8 @@ setBytecodeLinkerOptions df = df { ghcLink = LinkInMemory #if MIN_VERSION_ghc(9,5,0) , backend = noBackend -#elif MIN_VERSION_ghc(9,2,0) - , backend = NoBackend #else - , hscTarget = HscNothing + , backend = NoBackend #endif , ghcMode = CompManager } @@ -243,10 +126,8 @@ setInterpreterLinkerOptions df = df { ghcLink = LinkInMemory #if MIN_VERSION_ghc(9,5,0) , backend = interpreterBackend -#elif MIN_VERSION_ghc(9,2,0) - , backend = Interpreter #else - , hscTarget = HscInterpreted + , backend = Interpreter #endif , ghcMode = CompManager } @@ -255,50 +136,28 @@ setInterpreterLinkerOptions df = df { -- Ways helpers -- ------------------------------------------------------- -#if !MIN_VERSION_ghc(9,2,0) -type Ways = Set.Set Way -#endif setWays :: Ways -> DynFlags -> DynFlags setWays newWays flags = -#if MIN_VERSION_ghc(9,2,0) flags { Session.targetWays_ = newWays} -#else - flags {ways = newWays} -#endif -- ------------------------------------------------------- -- Backend helpers -- ------------------------------------------------------- -#if !MIN_VERSION_ghc(9,2,0) -type Backend = HscTarget -#endif ghciBackend :: Backend #if MIN_VERSION_ghc(9,6,0) ghciBackend = interpreterBackend -#elif MIN_VERSION_ghc(9,2,0) -ghciBackend = Interpreter #else -ghciBackend = HscInterpreted +ghciBackend = Interpreter #endif platformDefaultBackend :: DynFlags -> Backend platformDefaultBackend = -#if MIN_VERSION_ghc(9,2,0) Backend.platformDefaultBackend . targetPlatform -#elif MIN_VERSION_ghc(8,10,0) - defaultObjectTarget -#else - defaultObjectTarget . DynFlags.targetPlatform -#endif setBackend :: Backend -> DynFlags -> DynFlags setBackend backend flags = -#if MIN_VERSION_ghc(9,2,0) flags { backend = backend } -#else - flags { hscTarget = backend } -#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index 1feeafa8b4..d848083a4b 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -17,16 +17,9 @@ import GHC.Iface.Errors.Ppr (missingInterfaceErrorDia import GHC.Iface.Errors.Types (IfaceMessage) #endif -#if !MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Finder as Finder -import GHC.Driver.Types (FindResult) -import qualified GHC.Iface.Load as Iface -#endif -#if MIN_VERSION_ghc(9,2,0) import qualified GHC.Iface.Load as Iface import GHC.Unit.Finder.Types (FindResult) -#endif #if MIN_VERSION_ghc(9,3,0) import GHC.Driver.Session (targetProfile) @@ -35,18 +28,14 @@ import GHC.Driver.Session (targetProfile) writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () #if MIN_VERSION_ghc(9,3,0) writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) fp iface -#elif MIN_VERSION_ghc(9,2,0) -writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (hsc_dflags env) fp iface #else -writeIfaceFile env = Iface.writeIface (hsc_dflags env) +writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (hsc_dflags env) fp iface #endif cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc cannotFindModule env modname fr = #if MIN_VERSION_ghc(9,7,0) missingInterfaceErrorDiagnostic (defaultDiagnosticOpts @IfaceMessage) $ Iface.cannotFindModule env modname fr -#elif MIN_VERSION_ghc(9,2,0) - Iface.cannotFindModule env modname fr #else - Finder.cannotFindModule (hsc_dflags env) modname fr + Iface.cannotFindModule env modname fr #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index a8ad157b77..b89dea0488 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -2,7 +2,7 @@ -- | Compat module for GHC 9.2 Logger infrastructure. module Development.IDE.GHC.Compat.Logger ( putLogHook, - Development.IDE.GHC.Compat.Logger.pushLogHook, + Logger.pushLogHook, -- * Logging stuff LogActionCompat, logActionCompat, @@ -17,14 +17,7 @@ import Development.IDE.GHC.Compat.Outputable import GHC.Utils.Outputable -#if !MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Session as DynFlags -#endif - -#if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Env (hsc_logger) import GHC.Utils.Logger as Logger -#endif #if MIN_VERSION_ghc(9,3,0) import GHC.Types.Error @@ -32,19 +25,7 @@ import GHC.Types.Error putLogHook :: Logger -> HscEnv -> HscEnv putLogHook logger env = -#if MIN_VERSION_ghc(9,2,0) env { hsc_logger = logger } -#else - hscSetFlags ((hsc_dflags env) { DynFlags.log_action = Env.log_action logger }) env -#endif - -pushLogHook :: (LogAction -> LogAction) -> Logger -> Logger -pushLogHook f logger = -#if MIN_VERSION_ghc(9,2,0) - Logger.pushLogHook f logger -#else - logger { Env.log_action = f (Env.log_action logger) } -#endif #if MIN_VERSION_ghc(9,3,0) type LogActionCompat = LogFlags -> Maybe DiagnosticReason -> Maybe Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO () diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 40810d5830..cd86f25e33 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -55,24 +55,13 @@ module Development.IDE.GHC.Compat.Outputable ( -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Session -import GHC.Driver.Types as HscTypes -import GHC.Types.Name.Reader (GlobalRdrEnv) -import GHC.Types.SrcLoc -import GHC.Utils.Error as Err hiding (mkWarnMsg) -import qualified GHC.Utils.Error as Err -import GHC.Utils.Outputable as Out -import qualified GHC.Utils.Outputable as Out -#endif -#if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Driver.Session import qualified GHC.Types.Error as Error #if MIN_VERSION_ghc(9,7,0) -import GHC.Types.Error (defaultDiagnosticOpts) +import GHC.Types.Error (defaultDiagnosticOpts) #endif import GHC.Types.Name.Ppr import GHC.Types.Name.Reader @@ -82,9 +71,8 @@ import GHC.Unit.State import GHC.Utils.Error hiding (mkWarnMsg) import GHC.Utils.Outputable as Out import GHC.Utils.Panic -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import GHC.Parser.Errors import qualified GHC.Parser.Errors.Ppr as Ppr #endif @@ -96,7 +84,7 @@ import GHC.Parser.Errors.Types #endif #if MIN_VERSION_ghc(9,5,0) -import GHC.Driver.Errors.Types (GhcMessage, DriverMessage) +import GHC.Driver.Errors.Types (DriverMessage, GhcMessage) #endif #if MIN_VERSION_ghc(9,5,0) @@ -109,64 +97,34 @@ type PrintUnqualified = NamePprCtx -- It print with a user-friendly style like: `a_a4ME` as `a`. printWithoutUniques :: Outputable a => a -> String printWithoutUniques = -#if MIN_VERSION_ghc(9,2,0) renderWithContext (defaultSDocContext { sdocStyle = defaultUserStyle , sdocSuppressUniques = True , sdocCanUseUnicode = True }) . ppr -#else - go . ppr - where - go sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags neverQualify AllTheWay) - dflags = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques -#endif printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String -#if MIN_VERSION_ghc(9,2,0) printSDocQualifiedUnsafe unqual doc = -- Taken from 'showSDocForUser' renderWithContext (defaultSDocContext { sdocStyle = sty }) doc' where sty = mkUserStyle unqual AllTheWay doc' = pprWithUnitState emptyUnitState doc -#else -printSDocQualifiedUnsafe unqual doc = - showSDocForUser unsafeGlobalDynFlags unqual doc -#endif - -#if !MIN_VERSION_ghc(9,2,0) -oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc -oldMkUserStyle _ = Out.mkUserStyle -oldMkErrStyle _ = Out.mkErrStyle -oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc -oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext - where dummySDocContext = initSDocContext dflags Out.defaultUserStyle -#endif #if !MIN_VERSION_ghc(9,3,0) pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc pprWarning = -#if MIN_VERSION_ghc(9,2,0) Ppr.pprWarning -#else - id -#endif pprError :: PsError -> MsgEnvelope DecoratedSDoc pprError = -#if MIN_VERSION_ghc(9,2,0) Ppr.pprError -#else - id -#endif #endif formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String formatErrorWithQual dflags e = -#if MIN_VERSION_ghc(9,2,0) showSDoc dflags (pprNoLocMsgEnvelope e) #if MIN_VERSION_ghc(9,3,0) @@ -186,24 +144,9 @@ pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e (formatBulleted _ctx $ Error.renderDiagnostic e) #endif -#else - Out.showSDoc dflags - $ Out.withPprStyle (oldMkErrStyle dflags $ errMsgContext e) - $ oldFormatErrDoc dflags - $ Err.errMsgDoc e -#endif - -#if !MIN_VERSION_ghc(9,2,0) -type DecoratedSDoc = () -type MsgEnvelope e = ErrMsg -type PsWarning = ErrMsg -type PsError = ErrMsg -#endif -#if MIN_VERSION_ghc(9,2,0) type ErrMsg = MsgEnvelope DecoratedSDoc -#endif #if MIN_VERSION_ghc(9,3,0) type WarnMsg = MsgEnvelope DecoratedSDoc #endif @@ -214,14 +157,11 @@ mkPrintUnqualifiedDefault env = mkNamePprCtx ptc (hsc_unit_env env) where ptc = initPromotionTickContext (hsc_dflags env) -#elif MIN_VERSION_ghc(9,2,0) +#else mkPrintUnqualifiedDefault env = -- GHC 9.2 version -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualified (hsc_unit_env env) -#else -mkPrintUnqualifiedDefault env = - HscTypes.mkPrintUnqualified (hsc_dflags env) #endif #if MIN_VERSION_ghc(9,3,0) @@ -240,11 +180,7 @@ mkWarnMsg df reason _logFlags l st doc = fmap renderDiagnosticMessageWithHints $ #else mkWarnMsg :: a -> b -> DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc mkWarnMsg _ _ = -#if MIN_VERSION_ghc(9,2,0) const Error.mkWarnMsg -#else - Err.mkWarnMsg -#endif #endif textDoc :: String -> SDoc diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index e1effb1a6e..3d87cc3a91 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -6,18 +6,8 @@ module Development.IDE.GHC.Compat.Parser ( initParserOpts, initParserState, -#if !MIN_VERSION_ghc(9,2,0) - -- in GHC == 9.2 the type doesn't exist - -- In GHC == 9.0 it is a data-type - -- and GHC < 9.0 it is type-def - -- - -- Export data-type here, otherwise only the simple type. - Anno.ApiAnns(..), -#else ApiAnns, -#endif PsSpan(..), -#if MIN_VERSION_ghc(9,2,0) pattern HsParsedModule, type GHC.HsParsedModule, Development.IDE.GHC.Compat.Parser.hpm_module, @@ -29,16 +19,9 @@ module Development.IDE.GHC.Compat.Parser ( Development.IDE.GHC.Compat.Parser.pm_mod_summary, Development.IDE.GHC.Compat.Parser.pm_extra_src_files, Development.IDE.GHC.Compat.Parser.pm_annotations, -#else - GHC.HsParsedModule(..), - GHC.ParsedModule(..), -#endif mkApiAnns, -- * API Annotations Anno.AnnKeywordId(..), -#if !MIN_VERSION_ghc(9,2,0) - Anno.AnnotationComment(..), -#endif pattern EpaLineComment, pattern EpaBlockComment ) where @@ -52,25 +35,16 @@ import qualified GHC.Parser.Annotation as Anno import qualified GHC.Parser.Lexer as Lexer import GHC.Types.SrcLoc (PsSpan (..)) -#if !MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Types as GHC -#endif -#if !MIN_VERSION_ghc(9,2,0) -import qualified Data.Map as Map -import qualified GHC -#endif -#if MIN_VERSION_ghc(9,2,0) import GHC (EpaCommentTok (..), pm_extra_src_files, pm_mod_summary, pm_parsed_source) import qualified GHC import GHC.Hs (hpm_module, hpm_src_files) -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import qualified GHC.Driver.Config as Config #endif @@ -79,35 +53,19 @@ import qualified GHC.Driver.Config.Parser as Config #endif -#if !MIN_VERSION_ghc(9,2,0) -type ParserOpts = Lexer.ParserFlags -#endif initParserOpts :: DynFlags -> ParserOpts initParserOpts = -#if MIN_VERSION_ghc(9,2,0) Config.initParserOpts -#else - Lexer.mkParserFlags -#endif initParserState :: ParserOpts -> StringBuffer -> RealSrcLoc -> PState initParserState = -#if MIN_VERSION_ghc(9,2,0) Lexer.initParserState -#else - Lexer.mkPStatePure -#endif -#if MIN_VERSION_ghc(9,2,0) -- GHC 9.2 does not have ApiAnns anymore packaged in ParsedModule. Now the -- annotations are found in the ast. type ApiAnns = () -#else -type ApiAnns = Anno.ApiAnns -#endif -#if MIN_VERSION_ghc(9,2,0) #if MIN_VERSION_ghc(9,5,0) pattern HsParsedModule :: Located (HsModule GhcPs) -> [FilePath] -> ApiAnns -> GHC.HsParsedModule #else @@ -121,10 +79,8 @@ pattern HsParsedModule where HsParsedModule hpm_module hpm_src_files _hpm_annotations = GHC.HsParsedModule hpm_module hpm_src_files -#endif -#if MIN_VERSION_ghc(9,2,0) pattern ParsedModule :: ModSummary -> ParsedSource -> [FilePath] -> ApiAnns -> GHC.ParsedModule pattern ParsedModule { pm_mod_summary @@ -140,23 +96,7 @@ pattern ParsedModule , pm_extra_src_files = extra_src_files } {-# COMPLETE ParsedModule :: GHC.ParsedModule #-} -#endif mkApiAnns :: PState -> ApiAnns -#if MIN_VERSION_ghc(9,2,0) mkApiAnns = const () -#else -mkApiAnns pst = - -- Copied from GHC.Driver.Main - Anno.ApiAnns { - apiAnnItems = Map.fromListWith (++) $ annotations pst, - apiAnnEofPos = eof_pos pst, - apiAnnComments = Map.fromList (annotations_comments pst), - apiAnnRogueComments = comment_q pst - } -#endif -#if !MIN_VERSION_ghc(9,2,0) -pattern EpaLineComment a = Anno.AnnLineComment a -pattern EpaBlockComment a = Anno.AnnBlockComment a -#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 0289b9d7fb..09c4ff720a 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -36,11 +36,9 @@ import qualified GHC.Runtime.Loader as Loader import Development.IDE.GHC.Compat.Outputable as Out #endif -#if MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Env as Env -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import Data.Bifunctor (bimap) #endif @@ -65,13 +63,8 @@ getPsMessages pst _dflags = --dfags is only used if GHC < 9.2 #if MIN_VERSION_ghc(9,3,0) uncurry PsMessages $ Lexer.getPsMessages pst #else -#if MIN_VERSION_ghc(9,2,0) bimap (fmap pprWarning) (fmap pprError) $ -#endif getMessages pst -#if !MIN_VERSION_ghc(9,2,0) - _dflags -#endif #endif applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> PsMessages -> IO (ParsedSource, PsMessages) @@ -86,10 +79,8 @@ applyPluginsParsedResultAction env _dflags ms hpm_annotations parsed msgs = do #endif #if MIN_VERSION_ghc(9,3,0) (Env.hsc_plugins env) -#elif MIN_VERSION_ghc(9,2,0) - env #else - _dflags + env #endif applyPluginAction #if MIN_VERSION_ghc(9,3,0) @@ -100,12 +91,7 @@ applyPluginsParsedResultAction env _dflags ms hpm_annotations parsed msgs = do initializePlugins :: HscEnv -> IO HscEnv initializePlugins env = do -#if MIN_VERSION_ghc(9,2,0) Loader.initializePlugins env -#else - newDf <- Loader.initializePlugins env (hsc_dflags env) - pure $ hscSetFlags newDf env -#endif -- | Plugins aren't stored in ModSummary anymore since GHC 9.2, but this -- function still returns it for compatibility with 8.10 @@ -117,8 +103,6 @@ initPlugins session modSummary = do hsc_static_plugins :: HscEnv -> [StaticPlugin] #if MIN_VERSION_ghc(9,3,0) hsc_static_plugins = staticPlugins . Env.hsc_plugins -#elif MIN_VERSION_ghc(9,2,0) -hsc_static_plugins = Env.hsc_static_plugins #else -hsc_static_plugins = staticPlugins . hsc_dflags +hsc_static_plugins = Env.hsc_static_plugins #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index cd890d855e..2082cf10d0 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -61,6 +61,7 @@ import Prelude hiding (mod) import GHC.Types.Unique.Set import qualified GHC.Unit.Info as UnitInfo import GHC.Unit.State (LookupResult, UnitInfo, + UnitInfoMap, UnitState (unitInfoMap), lookupUnit', mkUnit, unitDepends, @@ -71,25 +72,17 @@ import qualified GHC.Unit.State as State import GHC.Unit.Types import qualified GHC.Unit.Types as Unit -#if !MIN_VERSION_ghc(9,2,0) -import Data.Map (Map) -import qualified GHC.Driver.Finder as GHC -import qualified GHC.Driver.Session as DynFlags -import GHC.Driver.Types -#endif #if !MIN_VERSION_ghc(9,3,0) import GHC.Data.FastString #endif -#if MIN_VERSION_ghc(9,2,0) import qualified GHC.Data.ShortText as ST import GHC.Unit.External import qualified GHC.Unit.Finder as GHC -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import GHC.Unit.Env import GHC.Unit.Finder hiding (findImportedModule) @@ -107,18 +100,9 @@ import GHC.Unit.Home.ModInfo type PreloadUnitClosure = UniqSet UnitId -#if MIN_VERSION_ghc(9,2,0) -type UnitInfoMap = State.UnitInfoMap -#else -type UnitInfoMap = Map UnitId UnitInfo -#endif unitState :: HscEnv -> UnitState -#if MIN_VERSION_ghc(9,2,0) unitState = ue_units . hsc_unit_env -#else -unitState = DynFlags.unitState . hsc_dflags -#endif #if MIN_VERSION_ghc(9,3,0) createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> HomeUnitGraph @@ -166,13 +150,7 @@ initUnits unitDflags env = do -- For GHC >= 9.2, we need to set the hsc_unit_env also, that is -- done later by initUnits oldInitUnits :: DynFlags -> IO DynFlags -#if MIN_VERSION_ghc(9,2,0) oldInitUnits = pure -#else -oldInitUnits dflags = do - newFlags <- State.initUnits dflags - pure newFlags -#endif explicitUnits :: UnitState -> [Unit] explicitUnits ue = @@ -204,11 +182,7 @@ lookupModuleWithSuggestions env modname mpkg = getUnitInfoMap :: HscEnv -> UnitInfoMap getUnitInfoMap = -#if MIN_VERSION_ghc(9,2,0) unitInfoMap . ue_units . hsc_unit_env -#else - unitInfoMap . unitState -#endif lookupUnit :: HscEnv -> Unit -> Maybe UnitInfo lookupUnit env pid = State.lookupUnit (unitState env) pid @@ -218,11 +192,7 @@ preloadClosureUs = State.preloadClosure . unitState unitHaddockInterfaces :: UnitInfo -> [FilePath] unitHaddockInterfaces = -#if MIN_VERSION_ghc(9,2,0) fmap ST.unpack . UnitInfo.unitHaddockInterfaces -#else - UnitInfo.unitHaddockInterfaces -#endif -- ------------------------------------------------------------------ -- Backwards Compatible UnitState @@ -232,7 +202,6 @@ unitHaddockInterfaces = -- Patterns and helpful definitions -- ------------------------------------------------------------------ -#if MIN_VERSION_ghc(9,2,0) definiteUnitId :: Definite uid -> GenUnit uid definiteUnitId = RealUnit defUnitId :: unit -> Definite unit @@ -240,12 +209,6 @@ defUnitId = Definite installedModule :: unit -> ModuleName -> GenModule unit installedModule = Module -#else -definiteUnitId = RealUnit -defUnitId = Definite -installedModule = Module - -#endif moduleUnitId :: Module -> UnitId moduleUnitId = @@ -263,11 +226,7 @@ filterInplaceUnits us packageFlags = isInplace p = Right p showSDocForUser' :: HscEnv -> PrintUnqualified -> SDoc -> String -#if MIN_VERSION_ghc(9,2,0) showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env) -#else -showSDocForUser' env = showSDocForUser (hsc_dflags env) -#endif findImportedModule :: HscEnv -> ModuleName -> IO (Maybe Module) findImportedModule env mn = do diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index bdfaab9e77..f1f7d6937e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -35,10 +35,8 @@ module Development.IDE.GHC.Compat.Util ( toList, -- * FastString exports FastString, -#if MIN_VERSION_ghc(9,2,0) -- Export here, so we can coerce safely on consumer sites LexicalFastString(..), -#endif uniq, unpackFS, mkFastString, diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index f877a486f2..4fddbe75df 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -36,13 +36,8 @@ import GHC.IfaceToCore import GHC.Types.Id.Make import GHC.Utils.Binary -#if !MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Types -#endif -#if MIN_VERSION_ghc(9,2,0) import GHC.Types.TypeEnv -#endif -- | Initial ram buffer to allocate for writing interface files @@ -103,11 +98,7 @@ writeBinCoreFile core_path fat_iface = do bh <- openBinMem initBinMemSize let quietTrace = -#if MIN_VERSION_ghc(9,2,0) QuietBinIFace -#else - const $ pure () -#endif putWithUserData quietTrace bh fat_iface diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 61e13a855c..d8d16ca69f 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -31,10 +31,8 @@ import GHC (ModuleGraph) import GHC.Types.Unique (getKey) #endif -#if MIN_VERSION_ghc(9,2,0) import Data.Bifunctor (Bifunctor (..)) import GHC.Parser.Annotation -#endif #if MIN_VERSION_ghc(9,3,0) import GHC.Types.PkgQual @@ -94,7 +92,6 @@ instance Show ParsedModule where instance NFData ModSummary where rnf = rwhnf -#if MIN_VERSION_ghc(9,2,0) instance Ord FastString where compare a b = if a == b then EQ else compare (fs_sbs a) (fs_sbs b) @@ -105,7 +102,6 @@ instance Bifunctor (GenLocated) where bimap f g (L l x) = L (f l) (g x) deriving instance Functor SrcSpanAnn' -#endif instance NFData ParsedModule where rnf = rwhnf @@ -123,10 +119,6 @@ instance NFData SourceModified where rnf = rwhnf #endif -#if !MIN_VERSION_ghc(9,2,0) -instance Show ModuleName where - show = moduleNameString -#endif instance Hashable ModuleName where hashWithSalt salt = hashWithSalt salt . show diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 82fe9f29e6..0967e4e6fc 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -64,16 +64,11 @@ import System.FilePath -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,2,0) -import Development.IDE.GHC.Compat.Util -#endif -#if MIN_VERSION_ghc(9,2,0) import GHC.Data.EnumSet import GHC.Data.FastString import GHC.Data.StringBuffer import GHC.Utils.Fingerprint -#endif ---------------------------------------------------------------------- -- GHC setup diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 03260b1b51..c9c3de1540 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -30,10 +30,8 @@ import Language.LSP.Protocol.Message -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,2,0) import Data.List.NonEmpty (nonEmpty) import Data.Foldable (toList) -#endif #if !MIN_VERSION_ghc(9,3,0) import qualified Data.Text as T @@ -110,7 +108,6 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , _kind = SymbolKind_Struct , _children = Just $ -#if MIN_VERSION_ghc(9,2,0) [ (defDocumentSymbol l'' :: DocumentSymbol) { _name = printOutputable n , _kind = SymbolKind_Constructor @@ -141,29 +138,6 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , _kind = SymbolKind_Field } cvtFld _ = Nothing -#else - [ (defDocumentSymbol l'' :: DocumentSymbol) - { _name = printOutputable n - , _kind = SymbolKind_Constructor - , _selectionRange = realSrcSpanToRange l' - , _children = conArgRecordFields (con_args x) - } - | L (locA -> (RealSrcSpan l'' _ )) x <- dd_cons - , L (locA -> (RealSrcSpan l' _)) n <- getConNames' x - ] - } - where - -- | Extract the record fields of a constructor - conArgRecordFields (RecCon (L _ lcdfs)) = Just - [ (defDocumentSymbol l' :: DocumentSymbol) - { _name = printOutputable n - , _kind = SymbolKind_Field - } - | L _ cdf <- lcdfs - , L (locA -> (RealSrcSpan l' _)) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf - ] - conArgRecordFields _ = Nothing -#endif documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ SynDecl { tcdLName = L (locA -> (RealSrcSpan l' _)) n })) = Just (defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable n , _kind = SymbolKind_TypeParameter @@ -173,11 +147,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ ClsInstD { cid_ins = Just (defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable cid_poly_ty , _kind = SymbolKind_Interface } -#if MIN_VERSION_ghc(9,2,0) documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl FamEqn { feqn_tycon, feqn_pats } })) -#else -documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) -#endif = Just (defDocumentSymbol l :: DocumentSymbol) { _name = #if MIN_VERSION_ghc(9,3,0) @@ -188,11 +158,7 @@ documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = D #endif , _kind = SymbolKind_Interface } -#if MIN_VERSION_ghc(9,2,0) documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl _ FamEqn { feqn_tycon, feqn_pats } })) -#else -documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) -#endif = Just (defDocumentSymbol l :: DocumentSymbol) { _name = #if MIN_VERSION_ghc(9,3,0) @@ -276,11 +242,6 @@ defDocumentSymbol l = DocumentSymbol { .. } where _tags = Nothing -- the version of getConNames for ghc9 is restricted to only the renaming phase -#if !MIN_VERSION_ghc(9,2,0) -getConNames' :: ConDecl GhcPs -> [Located (IdP GhcPs)] -getConNames' ConDeclH98 {con_name = name} = [name] -getConNames' ConDeclGADT {con_names = names} = names -#else hsConDeclsBinders :: LConDecl GhcPs -> ([LIdP GhcPs], [LFieldOcc GhcPs]) -- See hsLTyClDeclBinders for what this does @@ -324,6 +285,5 @@ hsConDeclsBinders cons get_flds :: Located [LConDeclField GhcPs] -> ([LFieldOcc GhcPs]) get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) -#endif diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index e15655a3cc..a588f46f34 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -59,9 +59,7 @@ import qualified Ide.Plugin.Config as Config -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,2,0) import qualified GHC.LanguageExtensions as LangExt -#endif data Log = LogShake Shake.Log deriving Show @@ -198,11 +196,7 @@ getCompletionsLSP ide plId let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules -- get HieAst if OverloadedRecordDot is enabled -#if MIN_VERSION_ghc(9,2,0) let uses_overloaded_record_dot (ms_hspp_opts . msrModSummary -> dflags) = xopt LangExt.OverloadedRecordDot dflags -#else - let uses_overloaded_record_dot _ = False -#endif ms <- fmap fst <$> useWithStaleFast GetModSummaryWithoutTimestamps npath astres <- case ms of Just ms' | uses_overloaded_record_dot ms' diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index e8886c0c89..e3935e04e8 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -69,14 +69,12 @@ import Development.IDE.Spans.AtPoint (pointCommand) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if MIN_VERSION_ghc(9,2,0) import GHC.Plugins (Depth (AllTheWay), mkUserStyle, neverQualify, sdocStyle) -#endif -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) import GHC.Plugins (defaultSDocContext, renderWithContext) #endif @@ -285,13 +283,9 @@ mkNameCompItem doc thingParent origName provenance isInfix !imp mod = CI {..} } showForSnippet :: Outputable a => a -> T.Text -#if MIN_VERSION_ghc(9,2,0) showForSnippet x = T.pack $ renderWithContext ctxt $ GHC.ppr x -- FIXme where ctxt = defaultSDocContext{sdocStyle = mkUserStyle neverQualify AllTheWay} -#else -showForSnippet x = printOutputable x -#endif mkModCompl :: T.Text -> CompletionItem mkModCompl label = @@ -368,7 +362,6 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = -- construct a map from Parents(type) to their fields fieldMap = Map.fromListWith (++) $ flip mapMaybe rdrElts $ \elt -> do -#if MIN_VERSION_ghc(9,2,0) par <- greParent_maybe elt #if MIN_VERSION_ghc(9,7,0) flbl <- greFieldLabel_maybe elt @@ -376,13 +369,6 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = flbl <- greFieldLabel elt #endif Just (par,[flLabel flbl]) -#else - case gre_par elt of - FldParent n ml -> do - l <- ml - Just (n, [l]) - _ -> Nothing -#endif getCompls :: [GlobalRdrElt] -> ([CompItem],QualCompls) getCompls = foldMap getComplsForOne @@ -419,9 +405,6 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = let (mbParent, originName) = case par of NoParent -> (Nothing, nameOccName n) ParentIs n' -> (Just . T.pack $ printName n', nameOccName n) -#if !MIN_VERSION_ghc(9,2,0) - FldParent n' lbl -> (Just . T.pack $ printName n', maybe (nameOccName n) mkVarOccFS lbl) -#endif recordCompls = case par of ParentIs parent | isDataConName n diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 3a9b70eda2..7f74b936a0 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -44,10 +44,8 @@ mkDocMap env rm this_mod = do #if MIN_VERSION_ghc(9,3,0) (Just Docs{docs_decls = UniqMap this_docs}) <- extractDocs (hsc_dflags env) this_mod -#elif MIN_VERSION_ghc(9,2,0) - (_ , DeclDocMap this_docs, _) <- extractDocs this_mod #else - let (_ , DeclDocMap this_docs, _) = extractDocs this_mod + (_ , DeclDocMap this_docs, _) <- extractDocs this_mod #endif #if MIN_VERSION_ghc(9,3,0) d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names @@ -121,75 +119,7 @@ getDocumentation => [ParsedModule] -- ^ All of the possible modules it could be defined in. -> name -- ^ The name you want documentation for. -> [T.Text] -#if MIN_VERSION_ghc(9,2,0) getDocumentation _sources _targetName = [] -#else --- This finds any documentation between the name you want --- documentation for and the one before it. This is only an --- approximately correct algorithm and there are easily constructed --- cases where it will be wrong (if so then usually slightly but there --- may be edge cases where it is very wrong). --- TODO : Build a version of GHC exactprint to extract this information --- more accurately. --- TODO : Implement this for GHC 9.2 with in-tree annotations --- (alternatively, just remove it and rely solely on GHC's parsing) -getDocumentation sources targetName = fromMaybe [] $ do - -- Find the module the target is defined in. - targetNameSpan <- realSpan $ getLoc targetName - tc <- - find ((==) (Just $ srcSpanFile targetNameSpan) . annotationFileName) - $ reverse sources -- TODO : Is reversing the list here really necessary? - - -- Top level names bound by the module - let bs = [ n | let L _ HsModule{hsmodDecls} = pm_parsed_source tc - , L _ (ValD _ hsbind) <- hsmodDecls - , Just n <- [name_of_bind hsbind] - ] - -- Sort the names' source spans. - let sortedSpans = sortedNameSpans bs - -- Now go ahead and extract the docs. - let docs = ann tc - nameInd <- elemIndex targetNameSpan sortedSpans - let prevNameSpan = - if nameInd >= 1 - then sortedSpans !! (nameInd - 1) - else zeroSpan $ srcSpanFile targetNameSpan - -- Annoyingly "-- |" documentation isn't annotated with a location, - -- so you have to pull it out from the elements. - pure - $ docHeaders - $ filter (\(L target _) -> isBetween target prevNameSpan targetNameSpan) - $ fold - docs - where - -- Get the name bound by a binding. We only concern ourselves with - -- @FunBind@ (which covers functions and variables). - name_of_bind :: HsBind GhcPs -> Maybe (Located RdrName) - name_of_bind FunBind {fun_id} = Just fun_id - name_of_bind _ = Nothing - -- Get source spans from names, discard unhelpful spans, remove - -- duplicates and sort. - sortedNameSpans :: [Located RdrName] -> [RealSrcSpan] - sortedNameSpans ls = nubSort (mapMaybe (realSpan . getLoc) ls) - isBetween target before after = before <= target && target <= after - ann = apiAnnComments . pm_annotations - annotationFileName :: ParsedModule -> Maybe FastString - annotationFileName = fmap srcSpanFile . listToMaybe . map getRealSrcSpan . fold . ann - --- | Shows this part of the documentation -docHeaders :: [RealLocated AnnotationComment] - -> [T.Text] -docHeaders = mapMaybe (\(L _ x) -> wrk x) - where - wrk = \case - -- When `Opt_Haddock` is enabled. - AnnDocCommentNext s -> Just $ T.pack s - -- When `Opt_KeepRawTokenStream` enabled. - AnnLineComment s -> if "-- |" `isPrefixOf` s - then Just $ T.pack s - else Nothing - _ -> Nothing -#endif -- These are taken from haskell-ide-engine's Haddock plugin diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index c832b30449..a2b4981a38 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -152,21 +152,13 @@ updateParserState token range prevParserState ModeInitial -> case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } -#if !MIN_VERSION_ghc(9,2,0) - ITlineComment s -#else ITlineComment s _ -#endif | isDownwardLineHaddock s -> defaultParserState{ mode = ModeHaddock } | otherwise -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing , mode = ModeComment } -#if !MIN_VERSION_ghc(9,2,0) - ITblockComment s -#else ITblockComment s _ -#endif | isPragma s -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing @@ -182,11 +174,7 @@ updateParserState token range prevParserState ModeComment -> case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } -#if !MIN_VERSION_ghc(9,2,0) - ITlineComment s -#else ITlineComment s _ -#endif | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } @@ -198,11 +186,7 @@ updateParserState token range prevParserState , mode = ModeHaddock } | otherwise -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing } -#if !MIN_VERSION_ghc(9,2,0) - ITblockComment s -#else ITblockComment s _ -#endif | isPragma s -> defaultParserState { nextPragma = NextPragmaInfo (endLine + 1) Nothing @@ -226,21 +210,13 @@ updateParserState token range prevParserState case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } -#if !MIN_VERSION_ghc(9,2,0) - ITlineComment s -#else ITlineComment s _ -#endif | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } | otherwise -> defaultParserState -#if !MIN_VERSION_ghc(9,2,0) - ITblockComment s -#else ITblockComment s _ -#endif | isPragma s -> defaultParserState{ nextPragma = NextPragmaInfo (endLine + 1) Nothing, @@ -254,11 +230,7 @@ updateParserState token range prevParserState ModePragma -> case token of ITvarsym "#" -> defaultParserState{ isLastTokenHash = True } -#if !MIN_VERSION_ghc(9,2,0) - ITlineComment s -#else ITlineComment s _ -#endif | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits , let currLineSplitTextEdits = updateLineSplitTextEdits range s prevLineSplitTextEdits -> defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } @@ -268,11 +240,7 @@ updateParserState token range prevParserState defaultParserState{ nextPragma = prevNextPragma{ lineSplitTextEdits = Just currLineSplitTextEdits } } | otherwise -> defaultParserState -#if !MIN_VERSION_ghc(9,2,0) - ITblockComment s -#else ITblockComment s _ -#endif | isPragma s -> defaultParserState{ nextPragma = NextPragmaInfo (endLine + 1) Nothing, lastPragmaLine = endLine } | hasDeleteStartedOnSameLine startLine prevLineSplitTextEdits diff --git a/ghcide/test/data/hover/RecordDotSyntax.hs b/ghcide/test/data/hover/RecordDotSyntax.hs index 2f43b99977..3680d08a3c 100644 --- a/ghcide/test/data/hover/RecordDotSyntax.hs +++ b/ghcide/test/data/hover/RecordDotSyntax.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 902 {-# LANGUAGE OverloadedRecordDot, DuplicateRecordFields, NoFieldSelectors #-} module RecordDotSyntax ( module RecordDotSyntax) where @@ -18,4 +16,3 @@ newtype MyChild = MyChild x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } } y = x.a ++ show x.b ++ x.c.z -#endif diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index c44b1d56e0..9627546ac8 100644 --- a/ghcide/test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide/test/exe/FindDefinitionAndHoverTests.hs @@ -115,9 +115,9 @@ tests = let recordDotSyntaxTests | ghcVersion >= GHC92 = - [ tst (getHover, checkHover) (Position 19 24) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["x :: MyRecord"]]) "hover over parent" - , tst (getHover, checkHover) (Position 19 25) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over dot shows child" - , tst (getHover, checkHover) (Position 19 26) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over child" + [ tst (getHover, checkHover) (Position 17 24) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["x :: MyRecord"]]) "hover over parent" + , tst (getHover, checkHover) (Position 17 25) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over dot shows child" + , tst (getHover, checkHover) (Position 17 26) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over child" ] | otherwise = [] diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs index 90ccc6b578..fd4a5305d2 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} module Ide.Plugin.Class.ExactPrint where @@ -13,20 +12,11 @@ import Ide.Plugin.Class.Utils import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers -#if MIN_VERSION_ghc(9,2,0) import Data.Either.Extra (eitherToMaybe) import GHC.Parser.Annotation -#else -import Control.Monad (foldM) -import qualified Data.Map.Strict as Map -import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs) -import Language.Haskell.GHC.ExactPrint.Utils (rs) -import Language.LSP.Protocol.Types (Range) -#endif makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text) -- addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located HsModule) -#if MIN_VERSION_ghc(9,2,0) makeEditText pm df AddMinimalMethodsParams{..} = do mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup let ps = makeDeltaAst $ pm_parsed_source pm @@ -73,49 +63,3 @@ addMethodDecls ps mDecls range withSig let dp = deltaPos 1 defaultIndent in L (noAnnSrcSpanDP (getLoc l) dp <> l) e -#else - -makeEditText pm df AddMinimalMethodsParams{..} = do - (unzip -> (mAnns, mDecls)) <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup - let ps = pm_parsed_source pm - anns = relativiseApiAnns ps (pm_annotations pm) - old = T.pack $ exactPrint ps anns - (ps', (anns', _), _) = runTransform (mergeAnns (mergeAnnList mAnns) anns) (addMethodDecls ps mDecls range withSig) - new = T.pack $ exactPrint ps' anns' - pure (old, new) - -makeMethodDecl :: DynFlags -> (T.Text, T.Text) -> Maybe (Anns, (LHsDecl GhcPs, LHsDecl GhcPs)) -makeMethodDecl df (mName, sig) = do - (nameAnn, name) <- case parseDecl df (T.unpack mName) . T.unpack $ toMethodName mName <> " = _" of - Right (ann, d) -> Just (setPrecedingLines d 1 defaultIndent ann, d) - Left _ -> Nothing - (sigAnn, sig) <- case parseDecl df (T.unpack sig) $ T.unpack sig of - Right (ann, d) -> Just (setPrecedingLines d 1 defaultIndent ann, d) - Left _ -> Nothing - pure (mergeAnnList [nameAnn, sigAnn], (name, sig)) - -addMethodDecls ps mDecls range withSig = do - d <- findInstDecl ps range - newSpan <- uniqueSrcSpanT - let decls = if withSig then concatMap (\(decl, sig) -> [sig, decl]) mDecls else map fst mDecls - annKey = mkAnnKey d - newAnnKey = AnnKey (rs newSpan) (CN "HsValBinds") - addWhere mkds@(Map.lookup annKey -> Just ann) = Map.insert newAnnKey ann2 mkds2 - where - ann1 = ann - { annsDP = annsDP ann ++ [(G AnnWhere, DP (0, 1))] - , annCapturedSpan = Just newAnnKey - , annSortKey = Just (fmap (rs . getLoc) decls) - } - mkds2 = Map.insert annKey ann1 mkds - ann2 = annNone - { annEntryDelta = DP (1, defaultIndent) - } - addWhere _ = panic "Ide.Plugin.Class.addMethodPlaceholder" - modifyAnnsT addWhere - modifyAnnsT (captureOrderAnnKey newAnnKey decls) - foldM (insertAfter d) ps (reverse decls) - -findInstDecl :: ParsedSource -> Range -> Transform (LHsDecl GhcPs) -findInstDecl ps range = head . filter (inRange range . getLoc) <$> hsDecls ps -#endif diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 2a65f10ec8..356c2079f7 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -95,8 +95,6 @@ import qualified Development.IDE.GHC.Compat.Core as Compat (Interac import qualified Development.IDE.GHC.Compat.Core as SrcLoc (HasSrcSpan (getLoc), unLoc) import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) -#if MIN_VERSION_ghc(9,2,0) -#endif import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) import Development.IDE.Core.FileStore (setSomethingModified) @@ -664,9 +662,6 @@ doTypeCmd dflags arg = do parseExprMode :: Text -> (TcRnExprMode, T.Text) parseExprMode rawArg = case T.break isSpace rawArg of -#if !MIN_VERSION_ghc(9,2,0) - ("+v", rest) -> (TM_NoInst, T.strip rest) -#endif ("+d", rest) -> (TM_Default, T.strip rest) _ -> (TM_Inst, rawArg) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs index c198962b17..14c1d0b0b9 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs @@ -42,9 +42,7 @@ import Development.IDE.Graph (alwaysRerun) import Ide.Logger (Pretty (pretty), Recorder, WithPriority, cmapWithPrio) -#if MIN_VERSION_ghc(9,2,0) import GHC.Parser.Annotation -#endif import Ide.Plugin.Eval.Types import qualified Data.ByteString as BS @@ -76,7 +74,6 @@ unqueueForEvaluation ide nfp = do -- remove the module from the Evaluating state, so that next time it won't evaluate to True atomicModifyIORef' var $ \fs -> (Set.delete nfp fs, ()) -#if MIN_VERSION_ghc(9,2,0) #if MIN_VERSION_ghc(9,5,0) getAnnotations :: Development.IDE.GHC.Compat.Located (HsModule GhcPs) -> [LEpaComment] getAnnotations (L _ m@(HsModule { hsmodExt = XModulePs {hsmodAnn = anns'}})) = @@ -102,13 +99,6 @@ apiAnnComments' pm = do pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan pattern RealSrcSpanAlready x = x -#else -apiAnnComments' :: ParsedModule -> [SrcLoc.RealLocated AnnotationComment] -apiAnnComments' = apiAnnRogueComments . pm_annotations - -pattern RealSrcSpanAlready :: SrcLoc.RealSrcSpan -> SrcLoc.RealSrcSpan -pattern RealSrcSpanAlready x = x -#endif evalParsedModuleRule :: Recorder (WithPriority Log) -> Rules () evalParsedModuleRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetEvalComments nfp -> do diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index a18d204759..28cb8e1ec0 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -399,7 +399,7 @@ extractMinimalImports hsc TcModuleResult {..} = runMaybeT $ do not $ any (\e -> ("module " ++ moduleNameString name) == e) exports isExplicitImport :: ImportDecl GhcRn -> Bool -#if MIN_VERSION_ghc (9,5,0) +#if MIN_VERSION_ghc(9,5,0) isExplicitImport ImportDecl {ideclImportList = Just (Exactly, _)} = True #else isExplicitImport ImportDecl {ideclHiding = Just (False, _)} = True diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index a2d3e4364c..6d76471a77 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -21,7 +21,6 @@ import Development.IDE.GHC.Compat.ExactPrint import Ide.PluginUtils (subRange) import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl) -#if MIN_VERSION_ghc(9,2,1) import GHC.Parser.Annotation (AddEpAnn (..), Anchor (Anchor), AnchorOperation (MovedAnchor), @@ -35,15 +34,6 @@ import GHC.Parser.Annotation (AddEpAnn (..), import GHC.Parser.Annotation (TokenLocation (..)) #endif import Language.Haskell.GHC.ExactPrint (showAst) -#else -import qualified Data.Map.Lazy as Map -import Language.Haskell.GHC.ExactPrint.Types (AnnConName (CN), - AnnKey (AnnKey), - Annotation (..), - DeltaPos (DP), - KeywordId (G), - deltaColumn) -#endif type GP = GhcPass Parsed @@ -104,9 +94,6 @@ h98ToGADTConDecl dataName tyVars ctxt = \case [con_name] #endif -#if !MIN_VERSION_ghc(9,2,1) - con_forall -#endif #if MIN_VERSION_ghc(9,5,0) (L NoTokenLoc HsNormalTok) #endif @@ -119,7 +106,6 @@ h98ToGADTConDecl dataName tyVars ctxt = \case x -> x where -- Parameters in the data constructor -#if MIN_VERSION_ghc(9,2,1) renderDetails :: HsConDeclH98Details GP -> HsConDeclGADTDetails GP renderDetails (PrefixCon _ args) = PrefixConGADT args renderDetails (InfixCon arg1 arg2) = PrefixConGADT [arg1, arg2] @@ -129,11 +115,6 @@ h98ToGADTConDecl dataName tyVars ctxt = \case renderDetails (RecCon recs) = RecConGADT recs #endif -#else - renderDetails (PrefixCon args) = PrefixCon args - renderDetails (InfixCon arg1 arg2) = PrefixCon [arg1, arg2] - renderDetails (RecCon recs) = RecCon recs -#endif -- | Construct GADT result type renderResultTy :: LHsType GP @@ -192,7 +173,6 @@ The adjustment includes: 3. Make every data constructor start with a new line and 2 spaces -} prettyGADTDecl :: DynFlags -> TyClDecl GP -> Either String String -#if MIN_VERSION_ghc(9,2,1) prettyGADTDecl df decl = let old = printOutputable decl hsDecl = parseDecl df "unused" (T.unpack old) @@ -237,63 +217,7 @@ prettyGADTDecl df decl = removeExtraEmptyLine s = case stripInfix "\n\n" s of Just (x, xs) -> x <> "\n" <> xs Nothing -> s -#else -prettyGADTDecl df decl = - let old = printOutputable decl - hsDecl = parseDecl df "unused" (T.unpack old) - tycld = adjustTyClD hsDecl - in removeExtraEmptyLine . uncurry (flip exactPrint) <$> tycld - where - adjustTyClD = \case - Right (anns, t@(L _ (TyClD _ _))) -> Right (adjustDataDeclAnns anns, t) - Right _ -> Left "Expect TyClD" - Left err -> Left $ show err - - adjustDataDeclAnns = Map.mapWithKey go - where - isDataDeclAnn (AnnKey _ (CN name)) = name == "DataDecl" - isConDeclGADTAnn (AnnKey _ (CN name)) = name == "ConDeclGADT" - - go key ann - | isDataDeclAnn key = adjustWhere ann - | isConDeclGADTAnn key = adjustCon ann - | otherwise = ann - -- Adjust where annotation to the same line of the type constructor - adjustWhere Ann{..} = Ann - { annsDP = annsDP <&> - (\(keyword, dp) -> - if keyword == G AnnWhere - then (keyword, DP (0, 1)) - else (keyword, dp)) - , .. - } - - -- Make every data constructor start with a new line and 2 spaces - -- - -- Here we can't force every GADT constructor has (1, 2) - -- delta. For the first constructor with (1, 2), it prints - -- a new line with 2 spaces, but for other constructors - -- with (1, 2), it will print a new line with 4 spaces. - -- - -- The original ann parsed with `praseDecl` shows the first - -- constructor has (1, 4) delta, but others have (1, 0). - -- Hence, the following code only deal with the first - -- constructor. - adjustCon Ann{..} = let c = deltaColumn annEntryDelta - in Ann - { annEntryDelta = DP $ (1,) $ if c > 0 then 2 else 0 - , .. - } - - -- Remove the first extra line if exist - removeExtraEmptyLine s = case stripInfix "\n\n" s of - Just (x, xs) -> x <> "\n" <> xs - Nothing -> s - -#endif - -#if MIN_VERSION_ghc(9,2,1) wrap :: forall a. WrapXRec GP a => a -> XRec GP a wrap = wrapXRec @GP wrapCtxt = id @@ -301,20 +225,8 @@ emptyCtxt = Nothing unWrap = unXRec @GP mapX = mapXRec @GP noUsed = EpAnnNotUsed -#else -wrapCtxt = Just -wrap = L noSrcSpan -emptyCtxt = wrap [] -unWrap (L _ r) = r -mapX = fmap -noUsed = noExtField -#endif pattern UserTyVar' :: LIdP pass -> HsTyVarBndr flag pass pattern UserTyVar' s <- UserTyVar _ _ s -#if MIN_VERSION_ghc(9,2,1) implicitTyVars = (wrapXRec @GP mkHsOuterImplicit) -#else -implicitTyVars = [] -#endif diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index ba2bd833c2..0d8404d788 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -189,9 +189,7 @@ allPragmas = -- Language Version Extensions , "Haskell98" , "Haskell2010" -#if MIN_VERSION_ghc(9,2,0) , "GHC2021" -#endif ] -- --------------------------------------------------------------------- diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs index a80f251998..453e5477ad 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Compat/ExactPrint.hs @@ -8,26 +8,10 @@ module Development.IDE.GHC.Compat.ExactPrint , Retrie.Annotated, pattern Annotated, astA, annsA ) where -#if !MIN_VERSION_ghc(9,2,0) -import Control.Arrow ((&&&)) -#else import Development.IDE.GHC.Compat.Parser -#endif import Language.Haskell.GHC.ExactPrint as Retrie import qualified Retrie.ExactPrint as Retrie -#if !MIN_VERSION_ghc(9,2,0) -class ExactPrint ast where - makeDeltaAst :: ast -> ast - makeDeltaAst = id -instance ExactPrint ast -#endif - -#if !MIN_VERSION_ghc(9,2,0) -pattern Annotated :: ast -> Anns -> Retrie.Annotated ast -pattern Annotated {astA, annsA} <- (Retrie.astA &&& Retrie.annsA -> (astA, annsA)) -#else pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA)) -#endif diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index ca3d6a843d..1d74197445 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -1,40 +1,26 @@ {-# LANGUAGE CPP #-} module Development.IDE.GHC.Dump(showAstDataHtml) where +import qualified Data.ByteString as B import Data.Data hiding (Fixity) import Development.IDE.GHC.Compat hiding (LocatedA, NameAnn) import Development.IDE.GHC.Compat.ExactPrint -import GHC.Hs.Dump -#if MIN_VERSION_ghc(9,2,1) -import qualified Data.ByteString as B import Development.IDE.GHC.Compat.Util import Generics.SYB (ext1Q, ext2Q, extQ) import GHC.Hs hiding (AnnLet) -#endif +import GHC.Hs.Dump import GHC.Plugins hiding (AnnLet) import Prelude hiding ((<>)) -- | Show a GHC syntax tree in HTML. -#if MIN_VERSION_ghc(9,2,1) showAstDataHtml :: (Data a, ExactPrint a, Outputable a) => a -> SDoc -#else -showAstDataHtml :: (Data a, Outputable a) => a -> SDoc -#endif showAstDataHtml a0 = html $ header $$ body (tag' [("id",text (show @String "myUL"))] "ul" $ vcat [ -#if MIN_VERSION_ghc(9,2,1) li (pre $ text (exactPrint a0)), li (showAstDataHtml' a0), li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan NoBlankEpAnnotations a0) -#else - li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan -#if MIN_VERSION_ghc(9,3,0) - NoBlankEpAnnotations -#endif - a0) -#endif ]) where tag = tag' [] @@ -46,7 +32,7 @@ showAstDataHtml a0 = html $ li = tag "li" caret x = tag' [("class", text "caret")] "span" "" <+> x nested foo cts -#if MIN_VERSION_ghc(9,2,1) && !MIN_VERSION_ghc(9,3,0) +#if !MIN_VERSION_ghc(9,3,0) | cts == empty = foo #endif | otherwise = foo $$ (caret $ ul cts) @@ -54,7 +40,6 @@ showAstDataHtml a0 = html $ header = tag "head" $ tag "style" $ text css html = tag "html" pre = tag "pre" -#if MIN_VERSION_ghc(9,2,1) showAstDataHtml' :: Data a => a -> SDoc showAstDataHtml' = (generic @@ -287,7 +272,6 @@ showAstDataHtml a0 = html $ $$ li(srcSpan s)) Nothing -> text "locatedAnn:unmatched" <+> tag <+> (text (showConstr (toConstr ss))) -#endif normalize_newlines :: String -> String diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 0521e08751..8e570d9dc0 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -17,18 +17,11 @@ module Development.IDE.GHC.ExactPrint transform, transformM, ExactPrint(..), -#if MIN_VERSION_ghc(9,2,1) modifySmallestDeclWithM, modifyMgMatchesT, modifyMgMatchesT', modifySigWithM, genAnchor1, -#endif -#if !MIN_VERSION_ghc(9,2,0) - Anns, - Annotate, - setPrecedingLinesT, -#else setPrecedingLines, addParens, addParensToCtxt, @@ -39,7 +32,6 @@ module Development.IDE.GHC.ExactPrint epl, epAnn, removeTrailingComma, -#endif annotateParsedSource, getAnnotatedParsedSourceRule, GetAnnotatedParsedSource(..), @@ -98,7 +90,7 @@ import Retrie.ExactPrint hiding (parseDecl, #if MIN_VERSION_ghc(9,9,0) import GHC.Plugins (showSDoc) import GHC.Utils.Outputable (Outputable (ppr)) -#elif MIN_VERSION_ghc(9,2,0) +#else import GHC (EpAnn (..), NameAdornment (NameParens), NameAnn (..), @@ -113,18 +105,14 @@ import GHC.Parser.Annotation (AnnContext (..), deltaPos) #endif -#if MIN_VERSION_ghc(9,2,1) import Data.List (partition) import GHC (Anchor(..), realSrcSpan, AnchorOperation, DeltaPos(..), SrcSpanAnnN) import GHC.Types.SrcLoc (generatedSrcSpan) import Control.Lens ((&), _last) import Control.Lens.Operators ((%~)) -#endif -#if MIN_VERSION_ghc(9,2,0) setPrecedingLines :: Default t => LocatedAn t a -> Int -> Int -> LocatedAn t a setPrecedingLines ast n c = setEntryDP ast (deltaPos n c) -#endif ------------------------------------------------------------------------------ data Log = LogShake Shake.Log deriving Show @@ -152,13 +140,8 @@ getAnnotatedParsedSourceRule recorder = define (cmapWithPrio LogShake recorder) pm <- use GetParsedModuleWithComments nfp return ([], fmap annotateParsedSource pm) -#if MIN_VERSION_ghc(9,2,0) annotateParsedSource :: ParsedModule -> Annotated ParsedSource annotateParsedSource (ParsedModule _ ps _ _) = unsafeMkA (makeDeltaAst ps) 0 -#else -annotateParsedSource :: ParsedModule -> Annotated ParsedSource -annotateParsedSource = fixAnns -#endif ------------------------------------------------------------------------------ @@ -287,12 +270,7 @@ graft' :: LocatedAn l ast -> Graft (Either String) a graft' needs_space dst val = Graft $ \dflags a -> do -#if MIN_VERSION_ghc(9,2,0) val' <- annotate dflags needs_space val -#else - (anns, val') <- annotate dflags needs_space val - modifyAnnsT $ mappend anns -#endif pure $ everywhere' ( mkT $ @@ -360,18 +338,10 @@ graftExprWithM dst trans = Graft $ \dflags a -> do mval <- trans val case mval of Just val' -> do -#if MIN_VERSION_ghc(9,2,0) val'' <- hoistTransform (either Fail.fail pure) (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val')) pure val'' -#else - (anns, val'') <- - hoistTransform (either Fail.fail pure) - (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val')) - modifyAnnsT $ mappend anns - pure val'' -#endif Nothing -> pure val l -> pure l ) @@ -392,18 +362,10 @@ graftWithM dst trans = Graft $ \dflags a -> do mval <- trans val case mval of Just val' -> do -#if MIN_VERSION_ghc(9,2,0) val'' <- hoistTransform (either Fail.fail pure) $ annotate dflags False $ maybeParensAST val' pure val'' -#else - (anns, val'') <- - hoistTransform (either Fail.fail pure) $ - annotate dflags True $ maybeParensAST val' - modifyAnnsT $ mappend anns - pure val'' -#endif Nothing -> pure val l -> pure l ) @@ -451,7 +413,6 @@ graftDecls dst decs0 = Graft $ \dflags a -> do | otherwise = DL.singleton (L src e) <> go rest modifyDeclsT (pure . DL.toList . go) a -#if MIN_VERSION_ghc(9,2,1) -- | Replace the smallest declaration whose SrcSpan satisfies the given condition with a new -- list of declarations. @@ -588,7 +549,6 @@ modifyMgMatchesT' (MG xMg (L locMatches matches) originMg) f def combineResults r' <- lift $ foldM combineResults def rs pure $ (MG xMg (L locMatches matches') originMg, r') #endif -#endif graftSmallestDeclsWithM :: forall a. @@ -635,9 +595,7 @@ class , Typeable l , Outputable l , Outputable ast -#if MIN_VERSION_ghc(9,2,0) , Default l -#endif ) => ASTElement l ast | ast -> l where parseAST :: Parser (LocatedAn l ast) maybeParensAST :: LocatedAn l ast -> LocatedAn l ast @@ -680,13 +638,6 @@ instance ASTElement NameAnn RdrName where ------------------------------------------------------------------------------ -#if !MIN_VERSION_ghc(9,2,0) --- | Dark magic I stole from retrie. No idea what it does. -fixAnns :: ParsedModule -> Annotated ParsedSource -fixAnns ParsedModule {..} = - let ranns = relativiseApiAnns pm_parsed_source pm_annotations - in unsafeMkA pm_parsed_source ranns 0 -#endif ------------------------------------------------------------------------------ @@ -694,66 +645,29 @@ fixAnns ParsedModule {..} = -- | Given an 'LHSExpr', compute its exactprint annotations. -- Note that this function will throw away any existing annotations (and format) annotate :: (ASTElement l ast, Outputable l) -#if MIN_VERSION_ghc(9,2,0) => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast) -#else - => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (Anns, LocatedAn l ast) -#endif annotate dflags needs_space ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0) expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space) -#elif MIN_VERSION_ghc(9,2,0) +#else expr' <- lift $ mapLeft show $ parseAST dflags uniq rendered pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space) -#else - (anns, expr') <- lift $ mapLeft show $ parseAST dflags uniq rendered - let anns' = setPrecedingLines expr' 0 (bool 0 1 needs_space) anns - pure (anns',expr') #endif -- | Given an 'LHsDecl', compute its exactprint annotations. annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs) -#if !MIN_VERSION_ghc(9,2,0) --- The 'parseDecl' function fails to parse 'FunBind' 'ValD's which contain --- multiple matches. To work around this, we split the single --- 'FunBind'-of-multiple-'Match'es into multiple 'FunBind's-of-one-'Match', --- and then merge them all back together. -annotateDecl dflags - (L src ( - ValD ext fb@FunBind - { fun_matches = mg@MG { mg_alts = L alt_src alts@(_:_)} - })) = do - let set_matches matches = - ValD ext fb { fun_matches = mg { mg_alts = L alt_src matches }} - - (anns', alts') <- fmap unzip $ for alts $ \alt -> do - uniq <- show <$> uniqueSrcSpanT - let rendered = render dflags $ set_matches [alt] - lift (mapLeft show $ parseDecl dflags uniq rendered) >>= \case - (ann, L _ (ValD _ FunBind { fun_matches = MG { mg_alts = L _ [alt']}})) - -> pure (setPrecedingLines alt' 1 0 ann, alt') - _ -> lift $ Left "annotateDecl: didn't parse a single FunBind match" - - modifyAnnsT $ mappend $ fold anns' - pure $ L src $ set_matches alts' -#endif annotateDecl dflags ast = do uniq <- show <$> uniqueSrcSpanT let rendered = render dflags ast #if MIN_VERSION_ghc(9,4,0) expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered pure $ setPrecedingLines expr' 1 0 -#elif MIN_VERSION_ghc(9,2,0) +#else expr' <- lift $ mapLeft show $ parseDecl dflags uniq rendered pure $ setPrecedingLines expr' 1 0 -#else - (anns, expr') <- lift $ mapLeft show $ parseDecl dflags uniq rendered - let anns' = setPrecedingLines expr' 1 0 anns - modifyAnnsT $ mappend anns' - pure expr' #endif ------------------------------------------------------------------------------ @@ -777,15 +691,9 @@ eqSrcSpan l r = leftmost_smallest l r == EQ -- | Equality on SrcSpan's. -- Ignores the (Maybe BufSpan) field of SrcSpan's. -#if MIN_VERSION_ghc(9,2,0) eqSrcSpanA :: SrcAnn la -> SrcAnn b -> Bool eqSrcSpanA l r = leftmost_smallest (locA l) (locA r) == EQ -#else -eqSrcSpanA :: SrcSpan -> SrcSpan -> Bool -eqSrcSpanA l r = leftmost_smallest l r == EQ -#endif -#if MIN_VERSION_ghc(9,2,0) addParensToCtxt :: Maybe EpaLocation -> AnnContext -> AnnContext addParensToCtxt close_dp = addOpen . addClose where @@ -830,4 +738,3 @@ removeTrailingComma = flip modifyAnns $ \(AnnListItem l) -> AnnListItem $ filter isCommaAnn :: TrailingAnn -> Bool isCommaAnn AddCommaAnn{} = True isCommaAnn _ = False -#endif diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 3698300138..48130e0d73 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -76,6 +76,15 @@ import qualified Text.Regex.Applicative as RE #if MIN_VERSION_ghc(9,4,0) import GHC.Parser.Annotation (TokenLocation (..)) #endif +import GHC (AddEpAnn (AddEpAnn), + Anchor (anchor_op), + AnchorOperation (..), + AnnsModule (am_main), + DeltaPos (..), + EpAnn (..), + EpaLocation (..), + LEpaComment, + hsmodAnn) import Ide.PluginUtils (extractTextInRange, subRange) import Ide.Types @@ -102,23 +111,6 @@ import Language.LSP.VFS (VirtualFile, _file_text) import qualified Text.Fuzzy.Parallel as TFP import Text.Regex.TDFA ((=~), (=~~)) -#if MIN_VERSION_ghc(9,2,0) -import GHC (AddEpAnn (AddEpAnn), - Anchor (anchor_op), - AnchorOperation (..), - AnnsModule (am_main), - DeltaPos (..), - EpAnn (..), - EpaLocation (..), - LEpaComment, - hsmodAnn) -#else -import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP), - DeltaPos, - KeywordId (G), - deltaRow, - mkAnnKey) -#endif ------------------------------------------------------------------------------------------------- @@ -235,9 +227,6 @@ extendImportHandler' ideState ExtendImport {..} Just imp -> do fmap (nfp,) $ liftEither $ rewriteToWEdit df doc -#if !MIN_VERSION_ghc(9,2,0) - (annsA ps) -#endif $ extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) @@ -308,16 +297,6 @@ findSigOfBind range bind = findSigOfLMatch ls = do match <- findDeclContainingLoc (_start range) ls let grhs = m_grhss $ unLoc match -#if !MIN_VERSION_ghc(9,2,0) - span = getLoc $ reLoc $ grhssLocalBinds grhs - if _start range `isInsideSrcSpan` span - then findSigOfBinds range (unLoc (grhssLocalBinds grhs)) -- where clause - else do - grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs) - case unLoc grhs of - GRHS _ _ bd -> findSigOfExpr (unLoc bd) - _ -> Nothing -#else msum [findSigOfBinds range (grhssLocalBinds grhs) -- where clause , do @@ -329,7 +308,6 @@ findSigOfBind range bind = case unLoc grhs of GRHS _ _ bd -> findSigOfExpr (unLoc bd) ] -#endif findSigOfExpr :: HsExpr p -> Maybe (Sig p) findSigOfExpr = go @@ -360,23 +338,12 @@ findSigOfBinds range = go findInstanceHead :: (Outputable (HsType p), p ~ GhcPass p0) => DynFlags -> String -> [LHsDecl p] -> Maybe (LHsType p) findInstanceHead df instanceHead decls = listToMaybe -#if !MIN_VERSION_ghc(9,2,0) - [ hsib_body - | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB {hsib_body}})) <- decls, - showSDoc df (ppr hsib_body) == instanceHead - ] -#else [ hsib_body | L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig {sig_body = hsib_body})})) <- decls, showSDoc df (ppr hsib_body) == instanceHead ] -#endif -#if MIN_VERSION_ghc(9,2,0) findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e) -#else -findDeclContainingLoc :: Foldable t => Position -> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e) -#endif findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) -- Single: @@ -668,15 +635,9 @@ suggestDeleteUnusedBinding if isEmptyBag bag then [] else concatMap (findRelatedSpanForHsBind indexedContent name lsigs) bag -#if !MIN_VERSION_ghc(9,2,0) - case grhssLocalBinds of - (L _ (HsValBinds _ (ValBinds _ bag lsigs))) -> go bag lsigs - _ -> [] -#else case grhssLocalBinds of (HsValBinds _ (ValBinds _ bag lsigs)) -> go bag lsigs _ -> [] -#endif findRelatedSpanForMatch _ _ _ = [] findRelatedSpanForHsBind @@ -1283,11 +1244,7 @@ suggestInstanceConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing -- (Pair x x') == (Pair y y') = x == y && x' == y' | Just [instanceLineStr, constraintFirstCharStr] <- matchRegexUnifySpaces _message "bound by the instance declaration at .+:([0-9]+):([0-9]+)" -#if !MIN_VERSION_ghc(9,2,0) - , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = HsIB{hsib_body}}))) -#else , Just (L _ (InstD _ (ClsInstD _ ClsInstDecl {cid_poly_ty = (unLoc -> HsSig{sig_body = hsib_body})}))) -#endif <- findDeclContainingLoc (Position (readPositionNumber instanceLineStr) (readPositionNumber constraintFirstCharStr)) hsmodDecls = Just hsib_body | otherwise @@ -1307,11 +1264,7 @@ suggestImplicitParameter :: suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _range} | Just [implicitT] <- matchRegexUnifySpaces _message "Unbound implicit parameter \\(([^:]+::.+)\\) arising", Just (L _ (ValD _ FunBind {fun_id = L _ funId})) <- findDeclContainingLoc (_start _range) hsmodDecls, -#if !MIN_VERSION_ghc(9,2,0) - Just (TypeSig _ _ HsWC {hswc_body = HsIB {hsib_body}}) -#else Just (TypeSig _ _ HsWC {hswc_body = (unLoc -> HsSig {sig_body = hsib_body})}) -#endif <- findSigOfDecl (== funId) hsmodDecls = [( "Add " <> implicitT <> " to the context of " <> T.pack (printRdrName funId) @@ -1347,11 +1300,7 @@ suggestFunctionConstraint df (L _ HsModule {hsmodDecls}) Diagnostic {..} missing -- In an equation for ‘eq’: -- eq (Pair x y) (Pair x' y') = x == x' && y == y' | Just typeSignatureName <- findTypeSignatureName _message -#if !MIN_VERSION_ghc(9,2,0) - , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}}) -#else , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})}) -#endif <- findSigOfDecl ((T.unpack typeSignatureName ==) . showSDoc df . ppr) hsmodDecls , title <- actionTitle missingConstraint typeSignatureName = [(title, appendConstraint (T.unpack missingConstraint) sig)] @@ -1374,11 +1323,7 @@ removeRedundantConstraints df (makeDeltaAst -> L _ HsModule {hsmodDecls}) Diagno -- Account for both "Redundant constraint" and "Redundant constraints". | "Redundant constraint" `T.isInfixOf` _message , Just typeSignatureName <- findTypeSignatureName _message -#if !MIN_VERSION_ghc(9,2,0) - , Just (TypeSig _ _ HsWC{hswc_body = HsIB {hsib_body = sig}}) -#else , Just (TypeSig _ _ HsWC{hswc_body = (unLoc -> HsSig {sig_body = sig})}) -#endif <- fmap(traceAst "redundantConstraint") $ findSigOfDeclRanged _range hsmodDecls , Just redundantConstraintList <- findRedundantConstraints _message , rewrite <- removeConstraint (toRemove df redundantConstraintList) sig @@ -1683,7 +1628,6 @@ findPositionAfterModuleName ps hsmodName' = do -- The relative position of 'where' keyword (in lines, relative to the previous AST node). -- The exact-print API changed a lot in ghc-9.2, so we need to handle it separately for different compiler versions. whereKeywordLineOffset :: Maybe Int -#if MIN_VERSION_ghc(9,2,0) #if MIN_VERSION_ghc(9,5,0) whereKeywordLineOffset = case hsmodAnn hsmodExt of #else @@ -1718,17 +1662,6 @@ findPositionAfterModuleName ps hsmodName' = do anchorOpLine UnchangedAnchor = 0 anchorOpLine (MovedAnchor (SameLine _)) = 0 anchorOpLine (MovedAnchor (DifferentLine line _)) = line -#else - whereKeywordLineOffset = do - ann <- annsA ps M.!? mkAnnKey (astA ps) - deltaPos <- fmap NE.head . NE.nonEmpty .mapMaybe filterWhere $ annsDP ann - pure $ deltaRow deltaPos - - -- Before ghc 9.2, DeltaPos doesn't take comment into account, so we don't need to sum line offset of comments. - filterWhere :: (KeywordId, DeltaPos) -> Maybe DeltaPos - filterWhere (keywordId, deltaPos) = - if keywordId == G AnnWhere then Just deltaPos else Nothing -#endif findPositionFromImports :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int) findPositionFromImports hsField f = case getLoc (f hsField) of @@ -1977,47 +1910,25 @@ smallerRangesForBindingExport lies b = where unqualify = snd . breakOnEnd "." b' = wrapOperatorInParens . unqualify $ b -#if !MIN_VERSION_ghc(9,2,0) - ranges' (L _ (IEThingWith _ thing _ inners labels)) - | T.unpack (printOutputable thing) == b' = [] - | otherwise = - [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] - ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b'] -#else ranges' (L _ (IEThingWith _ thing _ inners)) | T.unpack (printOutputable thing) == b' = [] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] -#endif ranges' _ = [] rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan] -#if !MIN_VERSION_ghc(9,2,0) -rangesForBinding' b (L (locA -> l) (IEVar _ nm)) - | L _ (IEPattern (L _ b')) <- nm - , T.unpack (printOutputable b') == b - = [l] -#else rangesForBinding' b (L (locA -> l) (IEVar _ nm)) | L _ (IEPattern _ (L _ b')) <- nm , T.unpack (printOutputable b') == b = [l] -#endif rangesForBinding' b (L (locA -> l) x@IEVar{}) | T.unpack (printOutputable x) == b = [l] rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | T.unpack (printOutputable x) == b = [l] rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | T.unpack (printOutputable x) == b = [l] -#if !MIN_VERSION_ghc(9,2,0) -rangesForBinding' b (L l (IEThingWith _ thing _ inners labels)) -#else rangesForBinding' b (L (locA -> l) (IEThingWith _ thing _ inners)) -#endif | T.unpack (printOutputable thing) == b = [l] | otherwise = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b] -#if !MIN_VERSION_ghc(9,2,0) - ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b] -#endif rangesForBinding' _ _ = [] -- | 'allMatchRegex' combined with 'unifySpaces' diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs index b70e85b1f6..b84b4aa519 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -122,12 +122,7 @@ instance ToTextEdit Rewrite where toTextEdit CodeActionArgs {..} rw = fmap (fromMaybe []) $ runMaybeT $ do df <- MaybeT caaDf -#if !MIN_VERSION_ghc(9,2,0) - ps <- MaybeT caaAnnSource - let r = rewriteToEdit df (annsA ps) rw -#else let r = rewriteToEdit df rw -#endif pure $ fromRight [] r instance ToTextEdit a => ToTextEdit [a] where diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 74906cb47f..4c07354295 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -4,9 +4,6 @@ module Development.IDE.Plugin.CodeAction.ExactPrint ( Rewrite (..), rewriteToEdit, rewriteToWEdit, -#if !MIN_VERSION_ghc(9,2,0) - transferAnn, -#endif -- * Utilities appendConstraint, @@ -37,7 +34,6 @@ import Language.LSP.Protocol.Types import Development.IDE.Plugin.CodeAction.Util -- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports. -#if MIN_VERSION_ghc(9,2,0) import Control.Lens (_head, _last, over) import Data.Bifunctor (first) import Data.Default (Default (..)) @@ -50,18 +46,6 @@ import GHC (AddEpAnn (..), AnnContext (..), AnnList (..), TrailingAnn (AddCommaAnn), addAnns, ann, emptyComments, noSrcSpanA, reAnnL) import Language.Haskell.GHC.ExactPrint.ExactPrint (makeDeltaAst, showAst) -#else -import Control.Applicative (Alternative ((<|>))) -import Control.Monad.Extra (whenJust) -import Data.Foldable (find) -import Data.Functor (($>)) -import qualified Data.Map.Strict as Map -import Data.Maybe (fromJust, isJust, - isNothing, mapMaybe) -import qualified Development.IDE.GHC.Compat.Util as Util -import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), - KeywordId (G), mkAnnKey) -#endif ------------------------------------------------------------------------------ @@ -70,23 +54,14 @@ import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), -- given 'ast'. data Rewrite where Rewrite :: -#if !MIN_VERSION_ghc(9,2,0) - Annotate ast => -#else (ExactPrint (GenLocated (Anno ast) ast), ResetEntryDP (Anno ast), Outputable (GenLocated (Anno ast) ast), Data (GenLocated (Anno ast) ast)) => -#endif -- | The 'SrcSpan' that we want to rewrite SrcSpan -> -- | The ast that we want to graft -#if !MIN_VERSION_ghc(9,2,0) - (DynFlags -> TransformT (Either String) (Located ast)) -> -#else (DynFlags -> TransformT (Either String) (GenLocated (Anno ast) ast)) -> -#endif Rewrite ------------------------------------------------------------------------------ -#if MIN_VERSION_ghc(9,2,0) class ResetEntryDP ann where resetEntryDP :: GenLocated ann ast -> GenLocated ann ast instance {-# OVERLAPPING #-} Default an => ResetEntryDP (SrcAnn an) where @@ -94,58 +69,32 @@ instance {-# OVERLAPPING #-} Default an => ResetEntryDP (SrcAnn an) where resetEntryDP (L srcAnn x) = setEntryDP (L srcAnn{ann=EpAnnNotUsed} x) (SameLine 0) instance {-# OVERLAPPABLE #-} ResetEntryDP fallback where resetEntryDP = id -#endif -- | Convert a 'Rewrite' into a list of '[TextEdit]'. rewriteToEdit :: HasCallStack => DynFlags -> -#if !MIN_VERSION_ghc(9,2,0) - Anns -> -#endif Rewrite -> Either String [TextEdit] rewriteToEdit dflags -#if !MIN_VERSION_ghc(9,2,0) - anns -#endif (Rewrite dst f) = do (ast, anns , _) <- runTransformT -#if !MIN_VERSION_ghc(9,2,0) - anns -#endif $ do ast <- f dflags -#if !MIN_VERSION_ghc(9,2,0) - ast <$ setEntryDPT ast (DP (0, 0)) -#else pure $ traceAst "REWRITE_result" $ resetEntryDP ast -#endif let editMap = [ TextEdit (fromJust $ srcSpanToRange dst) $ T.pack $ exactPrint ast -#if !MIN_VERSION_ghc(9,2,0) - (fst anns) -#endif ] pure editMap -- | Convert a 'Rewrite' into a 'WorkspaceEdit' rewriteToWEdit :: DynFlags -> Uri -#if !MIN_VERSION_ghc(9,2,0) - -> Anns -#endif -> Rewrite -> Either String WorkspaceEdit rewriteToWEdit dflags uri -#if !MIN_VERSION_ghc(9,2,0) - anns -#endif r = do edits <- rewriteToEdit dflags -#if !MIN_VERSION_ghc(9,2,0) - anns -#endif r return $ WorkspaceEdit @@ -156,35 +105,6 @@ rewriteToWEdit dflags uri ------------------------------------------------------------------------------ -#if !MIN_VERSION_ghc(9,2,0) --- | Fix the parentheses around a type context -fixParens :: - (Monad m, Data (HsType pass), pass ~ GhcPass p0) => - Maybe DeltaPos -> - Maybe DeltaPos -> - LHsContext pass -> - TransformT m [LHsType pass] -fixParens - openDP closeDP - ctxt@(L _ elems) = do - -- Paren annotation for type contexts are usually quite screwed up - -- we remove duplicates and fix negative DPs - let parens = Map.fromList [(G AnnOpenP, dp00), (G AnnCloseP, dp00)] - modifyAnnsT $ - Map.adjust - ( \x -> - let annsMap = Map.fromList (annsDP x) - in x - { annsDP = - Map.toList $ - Map.alter (\_ -> openDP <|> Just dp00) (G AnnOpenP) $ - Map.alter (\_ -> closeDP <|> Just dp00) (G AnnCloseP) $ - annsMap <> parens - } - ) - (mkAnnKey ctxt) - return $ map dropHsParTy elems -#endif dropHsParTy :: LHsType (GhcPass pass) -> LHsType (GhcPass pass) dropHsParTy (L _ (HsParTy _ ty)) = ty @@ -198,14 +118,13 @@ removeConstraint :: removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input" where go :: LHsType GhcPs -> Rewrite -#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,4,0) +#if !MIN_VERSION_ghc(9,4,0) go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt), hst_body}) = Rewrite (locA l) $ \_ -> do #else go (L l it@HsQualTy{hst_ctxt = L l' ctxt, hst_body}) = Rewrite (locA l) $ \_ -> do #endif let ctxt' = filter (not . toRemove) ctxt removeStuff = (toRemove <$> headMaybe ctxt) == Just True -#if MIN_VERSION_ghc(9,2,0) let hst_body' = if removeStuff then resetEntryDP hst_body else hst_body return $ case ctxt' of [] -> hst_body' @@ -218,11 +137,6 @@ removeConstraint toRemove = go . traceAst "REMOVE_CONSTRAINT_input" #endif , hst_body = hst_body' } -#else - when removeStuff $ - setEntryDPT hst_body (DP (0, 0)) - return $ L l $ it{hst_ctxt = L l' ctxt'} -#endif go (L _ (HsParTy _ ty)) = go ty go (L _ HsForAllTy{hst_body}) = go hst_body go (L l other) = Rewrite (locA l) $ \_ -> return $ L l other @@ -239,25 +153,10 @@ appendConstraint constraintT = go . traceAst "appendConstraint" where #if MIN_VERSION_ghc(9,4,0) go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do -#elif MIN_VERSION_ghc(9,2,0) - go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do #else - go (L l it@HsQualTy{hst_ctxt = L l' ctxt}) = Rewrite (locA l) $ \df -> do + go (L l it@HsQualTy{hst_ctxt = Just (L l' ctxt)}) = Rewrite (locA l) $ \df -> do #endif constraint <- liftParseAST df constraintT -#if !MIN_VERSION_ghc(9,2,0) - setEntryDPT constraint (DP (0, 1)) - - -- Paren annotations are usually attached to the first and last constraints, - -- rather than to the constraint list itself, so to preserve them we need to reposition them - closeParenDP <- lookupAnn (G AnnCloseP) `mapM` lastMaybe ctxt - openParenDP <- lookupAnn (G AnnOpenP) `mapM` headMaybe ctxt - ctxt' <- fixParens - (join openParenDP) (join closeParenDP) - (L l' ctxt) - addTrailingCommaT (last ctxt') - return $ L l $ it{hst_ctxt = L l' $ ctxt' ++ [constraint]} -#else constraint <- pure $ setEntryDP constraint (SameLine 1) let l'' = (fmap.fmap) (addParensToCtxt close_dp) l' -- For singleton constraints, the close Paren DP is attached to an HsPar wrapping the constraint @@ -270,7 +169,6 @@ appendConstraint constraintT = go . traceAst "appendConstraint" return $ L l $ it{hst_ctxt = L l'' $ ctxt' ++ [constraint]} #else return $ L l $ it{hst_ctxt = Just $ L l'' $ ctxt' ++ [constraint]} -#endif #endif go (L _ HsForAllTy{hst_body}) = go hst_body go (L _ (HsParTy _ ty)) = go ty @@ -279,7 +177,6 @@ appendConstraint constraintT = go . traceAst "appendConstraint" constraint <- liftParseAST df constraintT lContext <- uniqueSrcSpanT lTop <- uniqueSrcSpanT -#if MIN_VERSION_ghc(9,2,0) #if MIN_VERSION_ghc(9,4,0) let context = reAnnL annCtxt emptyComments $ L lContext [resetEntryDP constraint] #else @@ -288,17 +185,6 @@ appendConstraint constraintT = go . traceAst "appendConstraint" annCtxt = AnnContext (Just (NormalSyntax, epl 1)) [epl 0 | needsParens] [epl 0 | needsParens] needsParens = hsTypeNeedsParens sigPrec $ unLoc constraint ast <- pure $ setEntryDP ast (SameLine 1) -#else - let context = L lContext [constraint] - addSimpleAnnT context dp00 $ - (G AnnDarrow, DP (0, 1)) : - concat - [ [ (G AnnOpenP, dp00) - , (G AnnCloseP, dp00) - ] - | hsTypeNeedsParens sigPrec $ unLoc constraint - ] -#endif return $ reLocA $ L lTop $ HsQualTy noExtField context ast @@ -306,33 +192,9 @@ liftParseAST :: forall ast l. (ASTElement l ast, ExactPrint (LocatedAn l ast)) => DynFlags -> String -> TransformT (Either String) (LocatedAn l ast) liftParseAST df s = case parseAST df "" s of -#if !MIN_VERSION_ghc(9,2,0) - Right (anns, x) -> modifyAnnsT (anns <>) $> x -#else Right x -> pure (makeDeltaAst x) -#endif Left _ -> TransformT $ lift $ Left $ "No parse: " <> s -#if !MIN_VERSION_ghc(9,2,0) -lookupAnn :: (Data a, Monad m) - => KeywordId -> Located a -> TransformT m (Maybe DeltaPos) -lookupAnn comment la = do - anns <- getAnnsT - return $ Map.lookup (mkAnnKey la) anns >>= lookup comment . annsDP - -dp00 :: DeltaPos -dp00 = DP (0, 0) - --- | Copy anns attached to a into b with modification, then delete anns of a -transferAnn :: (Data a, Data b) => Located a -> Located b -> (Annotation -> Annotation) -> TransformT (Either String) () -transferAnn la lb f = do - anns <- getAnnsT - let oldKey = mkAnnKey la - newKey = mkAnnKey lb - oldValue <- liftMaybe "Unable to find ann" $ Map.lookup oldKey anns - putAnnsT $ Map.delete oldKey $ Map.insert newKey (f oldValue) anns - -#endif headMaybe :: [a] -> Maybe a headMaybe [] = Nothing @@ -352,16 +214,11 @@ extendImport mparent identifier lDecl@(L l _) = Rewrite (locA l) $ \df -> do case mparent of -- This will also work for `ImportAllConstructors` -#if !MIN_VERSION_ghc(9,2,0) - Just parent -> extendImportViaParent df parent identifier lDecl - _ -> extendImportTopLevel identifier lDecl -#else -- Parsed source in GHC 9.4 uses absolute position annotation (RealSrcSpan), -- while rewriting relies on relative positions. ghc-exactprint has the utility -- makeDeltaAst for relativization. Just parent -> extendImportViaParent df parent identifier (makeDeltaAst lDecl) _ -> extendImportTopLevel identifier (makeDeltaAst lDecl) -#endif -- | Add an identifier or a data type to import list. Expects a Delta AST -- @@ -401,35 +258,12 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) if x `elem` lies then TransformT $ lift (Left $ thing <> " already imported") else do -#if !MIN_VERSION_ghc(9,2,0) - anns <- getAnnsT - maybe (pure ()) addTrailingCommaT (lastMaybe lies) - addSimpleAnnT x (DP (0, if hasSibling then 1 else 0)) [] - addSimpleAnnT rdr dp00 [(G AnnVal, dp00)] - - -- When the last item already has a trailing comma, we append a trailing comma to the new item. - let isAnnComma (G AnnComma, _) = True - isAnnComma _ = False - shouldAddTrailingComma = maybe False nodeHasComma (lastMaybe lies) - && not (nodeHasComma (L l' lies)) - - nodeHasComma :: Data a => Located a -> Bool - nodeHasComma x = isJust $ Map.lookup (mkAnnKey x) anns >>= find isAnnComma . annsDP - when shouldAddTrailingComma (addTrailingCommaT x) - - -- Parens are attached to `lies`, so if `lies` was empty previously, - -- we need change the ann key from `[]` to `:` to keep parens and other anns. - unless hasSibling $ - transferAnn (L l' lies) (L l' [x]) id - return $ L l it{ideclHiding = Just (hide, L l' $ lies ++ [x])} -#else let lies' = addCommaInImportList lies x #if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' lies')} #else return $ L l it{ideclHiding = Just (hide, L l' lies')} #endif -#endif extendImportTopLevel _ _ = TransformT $ lift $ Left "Unable to extend the import list" wildCardSymbol :: String @@ -477,14 +311,7 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) noExtField #endif childRdr -#if !MIN_VERSION_ghc(9,2,0) - x :: LIE GhcPs = L ll' $ IEThingWith noExtField absIE NoIEWildcard [childLIE] [] - -- take anns from ThingAbs, and attach parens to it - transferAnn lAbs x $ \old -> old{annsDP = annsDP old ++ [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, dp00)]} - addSimpleAnnT childRdr dp00 [(G AnnVal, dp00)] -#else x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE] -#endif #if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} @@ -492,15 +319,10 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} #endif -#if !MIN_VERSION_ghc(9,2,0) - go hide l' pre ((L l'' (IEThingWith _ twIE@(L _ ie) _ lies' _)) : xs) -#else go hide l' pre ((L l'' (IEThingWith l''' twIE@(L _ ie) _ lies')) : xs) -#endif -- ThingWith ie lies' => ThingWith ie (lies' ++ [child]) | parent == unIEWrappedName ie , child == wildCardSymbol = do -#if MIN_VERSION_ghc(9,2,0) #if MIN_VERSION_ghc(9,5,0) let it' = it{ideclImportList = Just (hide, lies)} #else @@ -510,19 +332,12 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l''' lies = L l' $ reverse pre ++ [L l'' thing] ++ xs return $ L l it' -#else - let thing = L l'' (IEThingWith noExtField twIE (IEWildcard 2) [] []) - modifyAnnsT (Map.map (\ann -> ann{annsDP = (G AnnDotdot, dp00) : annsDP ann})) - return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [thing] ++ xs)} -#endif | parent == unIEWrappedName ie , hasSibling <- not $ null lies' = do srcChild <- uniqueSrcSpanT let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child -#if MIN_VERSION_ghc(9,2,0) childRdr <- pure $ setEntryDP childRdr $ SameLine $ if hasSibling then 1 else 0 -#endif let alreadyImported = printOutputable (occName (unLoc childRdr)) `elem` map (printOutputable @OccName) (listify (const True) lies') @@ -534,12 +349,6 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) noExtField #endif childRdr -#if !MIN_VERSION_ghc(9,2,0) - when hasSibling $ - addTrailingCommaT (last lies') - addSimpleAnnT childRdr (DP (0, if hasSibling then 1 else 0)) [(G AnnVal, dp00)] - return $ L l it{ideclHiding = Just (hide, L l' $ reverse pre ++ [L l'' (IEThingWith noExtField twIE NoIEWildcard (lies' ++ [childLIE]) [])] ++ xs)} -#else #if MIN_VERSION_ghc(9,5,0) let it' = it{ideclImportList = Just (hide, lies)} #else @@ -549,7 +358,6 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) [L l'' (IEThingWith l''' twIE NoIEWildcard (over _last fixLast lies' ++ [childLIE]))] ++ xs fixLast = if hasSibling then first addComma else id return $ L l it' -#endif go hide l' pre (x : xs) = go hide l' (x : pre) xs go hide l' pre [] | hasSibling <- not $ null pre = do @@ -560,12 +368,6 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) parentRdr <- liftParseAST df parent let childRdr = reLocA $ L srcChild $ mkRdrUnqual $ mkVarOcc child isParentOperator = hasParen parent -#if !MIN_VERSION_ghc(9,2,0) - when hasSibling $ - addTrailingCommaT (head pre) - let parentLIE = L srcParent (if isParentOperator then IEType parentRdr else IEName parentRdr) - childLIE = reLocA $ L srcChild $ IEName childRdr -#else let parentLIE = reLocA $ L srcParent $ (if isParentOperator then IEType (epl 0) parentRdr' else IEName #if MIN_VERSION_ghc(9,5,0) @@ -580,27 +382,10 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) noExtField #endif childRdr -#endif -#if !MIN_VERSION_ghc(9,2,0) - x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith noExtField parentLIE NoIEWildcard [childLIE] [] - -- Add AnnType for the parent if it's parenthesized (type operator) - when isParentOperator $ - addSimpleAnnT parentLIE (DP (0, 0)) [(G AnnType, DP (0, 0))] - addSimpleAnnT parentRdr (DP (0, if hasSibling then 1 else 0)) $ unqalDP 1 isParentOperator - addSimpleAnnT childRdr (DP (0, 0)) [(G AnnVal, dp00)] - addSimpleAnnT x (DP (0, 0)) [(G AnnOpenP, DP (0, 1)), (G AnnCloseP, DP (0, 0))] - -- Parens are attached to `pre`, so if `pre` was empty previously, - -- we need change the ann key from `[]` to `:` to keep parens and other anns. - unless hasSibling $ - transferAnn (L l' $ reverse pre) (L l' [x]) id - - let lies' = reverse pre ++ [x] -#else listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)] x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE] lies' = addCommaInImportList (reverse pre) x -#endif #if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' lies')} #else @@ -608,7 +393,6 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) #endif extendImportViaParent _ _ _ _ = TransformT $ lift $ Left "Unable to extend the import list via parent" -#if MIN_VERSION_ghc(9,2,0) -- Add an item in an import list, taking care of adding comma if needed. addCommaInImportList :: -- | Initial list @@ -641,7 +425,6 @@ addCommaInImportList lies x = -- Add the comma (if needed) fixLast :: [LocatedAn AnnListItem a] -> [LocatedAn AnnListItem a] fixLast = over _last (first (if existingTrailingComma then id else addComma)) -#endif #if MIN_VERSION_ghc(9,5,0) unIEWrappedName :: IEWrappedName GhcPs -> String @@ -654,15 +437,6 @@ hasParen :: String -> Bool hasParen ('(' : _) = True hasParen _ = False -#if !MIN_VERSION_ghc(9,2,0) -unqalDP :: Int -> Bool -> [(KeywordId, DeltaPos)] -unqalDP c paren = - ( if paren - then \x -> (G AnnOpenP, DP (0, c)) : x : [(G AnnCloseP, dp00)] - else pure - ) - (G AnnVal, dp00) -#endif ------------------------------------------------------------------------------ @@ -687,18 +461,11 @@ hideSymbol _ (L _ (XImportDecl _)) = extendHiding :: String -> LImportDecl GhcPs -> -#if !MIN_VERSION_ghc(9,2,0) - Maybe (Located [LIE GhcPs]) -> -#else Maybe (XRec GhcPs [LIE GhcPs]) -> -#endif DynFlags -> TransformT (Either String) (LImportDecl GhcPs) extendHiding symbol (L l idecls) mlies df = do L l' lies <- case mlies of -#if !MIN_VERSION_ghc(9,2,0) - Nothing -> flip L [] <$> uniqueSrcSpanT -#else Nothing -> do src <- uniqueSrcSpanT let ann = noAnnSrcSpanDP0 src @@ -708,46 +475,20 @@ extendHiding symbol (L l idecls) mlies df = do ,al_close = Just $ AddEpAnn AnnCloseP (epl 0) } return $ L ann' [] -#endif Just pr -> pure pr let hasSibling = not $ null lies src <- uniqueSrcSpanT top <- uniqueSrcSpanT rdr <- liftParseAST df symbol -#if MIN_VERSION_ghc(9,2,0) rdr <- pure $ modifyAnns rdr $ addParens (isOperator $ unLoc rdr) -#endif let lie = reLocA $ L src $ IEName #if MIN_VERSION_ghc(9,5,0) noExtField #endif rdr x = reLocA $ L top $ IEVar noExtField lie -#if MIN_VERSION_ghc(9,2,0) x <- pure $ if hasSibling then first addComma x else x lies <- pure $ over _head (`setEntryDP` SameLine 1) lies -#endif -#if !MIN_VERSION_ghc(9,2,0) - singleHide = L l' [x] - when (isNothing mlies) $ do - addSimpleAnnT - singleHide - dp00 - [ (G AnnHiding, DP (0, 1)) - , (G AnnOpenP, DP (0, 1)) - , (G AnnCloseP, DP (0, 0)) - ] - addSimpleAnnT x (DP (0, 0)) [] - addSimpleAnnT rdr dp00 $ unqalDP 0 $ isOperator $ unLoc rdr - if hasSibling - then do - addTrailingCommaT x - addSimpleAnnT (head lies) (DP (0, 1)) [] - unless (null $ tail lies) $ - addTrailingCommaT (head lies) -- Why we need this? - else forM_ mlies $ \lies0 -> do - transferAnn lies0 singleHide id -#endif #if MIN_VERSION_ghc(9,5,0) return $ L l idecls{ideclImportList = Just (EverythingBut, L l' $ x : lies)} #else @@ -759,11 +500,7 @@ extendHiding symbol (L l idecls) mlies df = do deleteFromImport :: String -> LImportDecl GhcPs -> -#if !MIN_VERSION_ghc(9,2,0) - Located [LIE GhcPs] -> -#else XRec GhcPs [LIE GhcPs] -> -#endif DynFlags -> TransformT (Either String) (LImportDecl GhcPs) deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do @@ -777,24 +514,10 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do { ideclHiding = Just (False, edited) #endif } -#if !MIN_VERSION_ghc(9,2,0) - -- avoid import A (foo,) - whenJust (lastMaybe deletedLies) removeTrailingCommaT - when (not (null lies) && null deletedLies) $ do - transferAnn llies edited id - addSimpleAnnT - edited - dp00 - [ (G AnnOpenP, DP (0, 1)) - , (G AnnCloseP, DP (0, 0)) - ] -#endif pure lidecl' where deletedLies = -#if MIN_VERSION_ghc(9,2,0) over _last removeTrailingComma $ -#endif mapMaybe killLie lies killLie :: LIE GhcPs -> Maybe (LIE GhcPs) killLie v@(L _ (IEVar _ (L _ (unqualIEWrapName -> nam)))) @@ -803,11 +526,7 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do killLie v@(L _ (IEThingAbs _ (L _ (unqualIEWrapName -> nam)))) | nam == symbol = Nothing | otherwise = Just v -#if !MIN_VERSION_ghc(9,2,0) - killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons flds)) -#else killLie (L lieL (IEThingWith xt ty@(L _ (unqualIEWrapName -> nam)) wild cons)) -#endif | nam == symbol = Nothing | otherwise = Just $ @@ -817,7 +536,4 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do ty wild (filter ((/= symbol) . unqualIEWrapName . unLoc) cons) -#if !MIN_VERSION_ghc(9,2,0) - (filter ((/= symbol) . T.pack . Util.unpackFS . flLabel . unLoc) flds) -#endif killLie v = Just v diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs index 0b33d5112f..197c936165 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs @@ -9,16 +9,10 @@ import Debug.Trace import Development.IDE.GHC.Compat.ExactPrint as GHC import Development.IDE.GHC.Dump (showAstDataHtml) import GHC.Stack +import GHC.Utils.Outputable import System.Environment.Blank (getEnvDefault) import System.IO.Unsafe import Text.Printf -#if MIN_VERSION_ghc(9,2,0) -import GHC.Utils.Outputable -#else -import Development.IDE.GHC.Compat -import Development.IDE.GHC.Compat.Util -import Development.IDE.GHC.Util -#endif -------------------------------------------------------------------------------- -- Tracing exactprint terms @@ -38,11 +32,7 @@ traceAst lbl x | debugAST = trace doTrace x | otherwise = x where -#if MIN_VERSION_ghc(9,2,0) renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True} -#else - renderDump = showSDocUnsafe . ppr -#endif htmlDump = showAstDataHtml x doTrace = unsafePerformIO $ do u <- U.newUnique @@ -50,8 +40,6 @@ traceAst lbl x writeFile htmlDumpFileName $ renderDump htmlDump return $ unlines [prettyCallStack callStack ++ ":" -#if MIN_VERSION_ghc(9,2,0) , exactPrint x -#endif , "file://" ++ htmlDumpFileName] diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs index 7340215ead..fcec3b2887 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -5,10 +5,6 @@ module Development.IDE.Plugin.Plugins.AddArgument (plugin) where import Development.IDE.GHC.ExactPrint (epl) import GHC.Parser.Annotation (TokenLocation (..)) #endif -#if !MIN_VERSION_ghc(9,2,1) -import qualified Data.Text as T -import Language.LSP.Protocol.Types (TextEdit) -#else import Control.Monad (join) import Control.Monad.Trans.Class (lift) import Data.Bifunctor (Bifunctor (..)) @@ -39,12 +35,7 @@ import Language.Haskell.GHC.ExactPrint (TransformT (..), runTransformT) import Language.Haskell.GHC.ExactPrint.Transform (d1) import Language.LSP.Protocol.Types -#endif -#if !MIN_VERSION_ghc(9,2,1) -plugin :: [(T.Text, [TextEdit])] -plugin = [] -#else -- When GHC tells us that a variable is not bound, it will tell us either: -- - there is an unbound variable with a given type -- - there is an unbound variable (GHC provides no type suggestion) @@ -162,4 +153,3 @@ addTyHoleToTySigArg loc (L annHsSig (HsSig xHsSig tyVarBndrs lsigTy)) = lsigTy' = hsTypeFromFunTypeAsList (insertArg loc args, res) in L annHsSig (HsSig xHsSig tyVarBndrs lsigTy') -#endif diff --git a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs index 1198cea038..c08870266f 100644 --- a/plugins/hls-refactor-plugin/test/Test/AddArgument.hs +++ b/plugins/hls-refactor-plugin/test/Test/AddArgument.hs @@ -31,9 +31,6 @@ tests :: TestTree tests = testGroup "add argument" -#if !MIN_VERSION_ghc(9,2,1) - [] -#else [ mkGoldenAddArgTest' "Hole" (r 0 0 0 50) "_new_def", mkGoldenAddArgTest "NoTypeSuggestion" (r 0 0 0 50), mkGoldenAddArgTest "MultipleDeclAlts" (r 0 0 0 50), @@ -74,4 +71,3 @@ mkGoldenAddArgTest' testFileName range varName = do "expected" "hs" action -#endif diff --git a/plugins/hls-refactor-plugin/test/data/hover/RecordDotSyntax.hs b/plugins/hls-refactor-plugin/test/data/hover/RecordDotSyntax.hs index 2f43b99977..3680d08a3c 100644 --- a/plugins/hls-refactor-plugin/test/data/hover/RecordDotSyntax.hs +++ b/plugins/hls-refactor-plugin/test/data/hover/RecordDotSyntax.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 902 {-# LANGUAGE OverloadedRecordDot, DuplicateRecordFields, NoFieldSelectors #-} module RecordDotSyntax ( module RecordDotSyntax) where @@ -18,4 +16,3 @@ newtype MyChild = MyChild x = MyRecord { a = "Hello", b = 12, c = MyChild { z = "there" } } y = x.a ++ show x.b ++ x.c.z -#endif diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index 60384b2f42..79b74d9016 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -12,10 +12,8 @@ module Ide.Plugin.Rename (descriptor, E.Log) where -#if MIN_VERSION_ghc(9,2,1) import GHC.Parser.Annotation (AnnContext, AnnList, AnnParen, AnnPragma) -#endif import Compat.HieTypes import Control.Lens ((^.)) @@ -139,13 +137,8 @@ getSrcEdit state verTxtDocId updatePs = do annAst <- runActionE "Rename.GetAnnotatedParsedSource" state (useE GetAnnotatedParsedSource nfp) let (ps, anns) = (astA annAst, annsA annAst) -#if !MIN_VERSION_ghc(9,2,1) - let src = T.pack $ exactPrint ps anns - res = T.pack $ exactPrint (updatePs ps) anns -#else let src = T.pack $ exactPrint ps res = T.pack $ exactPrint (updatePs ps) -#endif pure $ diffText ccs (verTxtDocId, src) res IncludeDeletions -- | Replace names at every given `Location` (in a given `ParsedSource`) with a given new name. @@ -154,7 +147,6 @@ replaceRefs :: HashSet Location -> ParsedSource -> ParsedSource -#if MIN_VERSION_ghc(9,2,1) replaceRefs newName refs = everywhere $ -- there has to be a better way... mkT (replaceLoc @AnnListItem) `extT` @@ -169,14 +161,6 @@ replaceRefs newName refs = everywhere $ replaceLoc (L srcSpan oldRdrName) | isRef (locA srcSpan) = L srcSpan $ replace oldRdrName replaceLoc lOldRdrName = lOldRdrName -#else -replaceRefs newName refs = everywhere $ mkT replaceLoc - where - replaceLoc :: Located RdrName -> Located RdrName - replaceLoc (L srcSpan oldRdrName) - | isRef srcSpan = L srcSpan $ replace oldRdrName - replaceLoc lOldRdrName = lOldRdrName -#endif replace :: RdrName -> RdrName replace (Qual modName _) = Qual modName newName replace _ = Unqual newName @@ -238,12 +222,8 @@ removeGenerated HAR{..} = HAR{hieAst = go hieAst,..} where go :: HieASTs a -> HieASTs a go hf = -#if MIN_VERSION_ghc(9,2,1) HieASTs (fmap goAst (getAsts hf)) goAst (Node nsi sp xs) = Node (SourcedNodeInfo $ M.restrictKeys (getSourcedNodeInfo nsi) (S.singleton SourceInfo)) sp (map goAst xs) -#else - hf -#endif -- head is safe since groups are non-empty collectWith :: (Hashable a, Eq a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)] diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 16f981552f..f20b39bc66 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -159,24 +159,17 @@ import System.Directory (makeAbsolute) import GHC.Types.PkgQual #endif -#if MIN_VERSION_ghc(9,2,0) +import Control.Arrow ((&&&)) import Control.Exception (evaluate) import Data.Monoid (First (First)) -import Retrie.ExactPrint (makeDeltaAst) -import Retrie.GHC (ann) -#else -import Data.Monoid (First (..)) -import qualified GHC.Exts as Ext -import Retrie.AlphaEnv (extendAlphaEnv) -import Retrie.ExactPrint (relativiseApiAnns) -#endif -import Control.Arrow ((&&&)) import Development.IDE.Core.Actions (lookupMod) import Development.IDE.Core.PluginUtils import Development.IDE.Spans.AtPoint (LookupModule, getNamesAtPoint, nameToLocation) import Development.IDE.Types.Shake (WithHieDb) +import Retrie.ExactPrint (makeDeltaAst) +import Retrie.GHC (ann) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = @@ -571,11 +564,7 @@ callRetrie state session rewrites origin restrictToOriginatingFile = do (theImports, theRewrites) = partitionEithers rewrites annotatedImports = -#if MIN_VERSION_ghc(9,2,0) unsafeMkA (map (noLocA . toImportDecl) theImports) 0 -#else - unsafeMkA (map (noLocA . toImportDecl) theImports) mempty 0 -#endif (originFixities, originParsedModule) <- reuseParsedModule state origin retrie <- @@ -630,13 +619,7 @@ fixFixities state f pm = do return (fixities, res) fixAnns :: ParsedModule -> Annotated GHC.ParsedSource -#if MIN_VERSION_ghc(9,2,0) fixAnns GHC.ParsedModule{pm_parsed_source} = unsafeMkA (makeDeltaAst pm_parsed_source) 0 -#else -fixAnns GHC.ParsedModule {..} = - let ranns = relativiseApiAnns pm_parsed_source pm_annotations - in unsafeMkA pm_parsed_source ranns 0 -#endif parseSpecs :: IdeState @@ -646,14 +629,10 @@ parseSpecs -> [RewriteSpec] -> IO [Rewrite Universe] parseSpecs state origin originParsedModule originFixities specs = do -#if MIN_VERSION_ghc(9,2,0) -- retrie needs the libdir for `parseRewriteSpecs` libdir <- topDir . ms_hspp_opts . msrModSummary <$> useOrFail state "Retrie.GetModSummary" (CallRetrieInternalError "file not found") GetModSummary origin -#endif parseRewriteSpecs -#if MIN_VERSION_ghc(9,2,0) libdir -#endif (\_f -> return $ NoCPP originParsedModule) originFixities specs @@ -678,9 +657,7 @@ showQuery = ppRewrite s :: Data a => a -> String s = T.unpack . printOutputable . showAstData NoBlankSrcSpan -#if MIN_VERSION_ghc(9,2,0) NoBlankEpAnnotations -#endif constructInlineFromIdentifer originParsedModule originSpan = do -- traceM $ s $ astA originParsedModule fmap astA $ transformA originParsedModule $ \(L _ m) -> do @@ -779,10 +756,8 @@ toImportDecl AddImport {..} = GHC.ImportDecl {ideclSource = ideclSource', ..} , ideclSourceText = ideclSourceSrc , ideclImplicit = ideclImplicit } -#elif MIN_VERSION_ghc(9,2,0) - ideclExt = GHCGHC.EpAnnNotUsed #else - ideclExt = GHC.noExtField + ideclExt = GHCGHC.EpAnnNotUsed #endif ideclAs = toMod <$> ideclAsString ideclQualified = if ideclQualifiedBool then GHC.QualifiedPre else GHC.NotQualified diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 69f479f41d..424465a636 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -64,12 +64,10 @@ import GHC.Data.Bag (Bag) import GHC.Exts -#if MIN_VERSION_ghc(9,2,0) import GHC.Parser.Annotation (SrcSpanAnn'(..)) import qualified GHC.Types.Error as Error -#endif import Ide.Plugin.Splice.Types import Ide.Types @@ -284,13 +282,8 @@ adjustToRange uri ran (WorkspaceEdit mhult mlt x) = -- `GenLocated`. In GHC >= 9.2 this will be a SrcSpanAnn', with annotations; -- earlier it will just be a plain `SrcSpan`. {-# COMPLETE AsSrcSpan #-} -#if MIN_VERSION_ghc(9,2,0) pattern AsSrcSpan :: SrcSpan -> SrcSpanAnn' a pattern AsSrcSpan locA <- SrcSpanAnn {locA} -#else -pattern AsSrcSpan :: SrcSpan -> SrcSpan -pattern AsSrcSpan loc <- loc -#endif findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)] findSubSpansDesc srcSpan = @@ -414,11 +407,7 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e Right y -> unRenamedE dflags y _ -> pure Nothing let (warns, errs) = -#if MIN_VERSION_ghc(9,2,0) (Error.getWarningMessages msgs, Error.getErrorMessages msgs) -#else - msgs -#endif pure $ (warns,) <$> maybe (throwError $ PluginInternalError $ T.pack $ showErrors errs) (B.first (PluginInternalError . T.pack)) eresl @@ -467,11 +456,7 @@ unRenamedE :: TransformT m (LocatedAn l (ast GhcPs)) unRenamedE dflags expr = do uniq <- show <$> uniqueSrcSpanT -#if MIN_VERSION_ghc(9,2,0) expr' <- -#else - (_anns, expr') <- -#endif either (fail . showErrors) pure $ parseAST @_ @(ast GhcPs) dflags uniq $ showSDoc dflags $ ppr expr