From 64175fc32c348b3a25bd48b8334ba891630f2d93 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Mon, 27 Jun 2022 11:58:43 +0530 Subject: [PATCH 1/8] 9.4 support + MHU --- .github/actions/setup-build/action.yml | 2 +- .github/workflows/test.yml | 10 +- .gitlab-ci.yml | 6 +- bindist/ghcs | 2 + bindist/ghcs-Msys | 2 + cabal.project | 13 + ghcide/ghcide.cabal | 3 +- .../session-loader/Development/IDE/Session.hs | 47 +- ghcide/src/Development/IDE/Core/Compile.hs | 403 ++++++++++++++---- .../Development/IDE/Core/IdeConfiguration.hs | 4 +- .../src/Development/IDE/Core/Preprocessor.hs | 14 + ghcide/src/Development/IDE/Core/Rules.hs | 35 +- ghcide/src/Development/IDE/Core/Shake.hs | 22 +- ghcide/src/Development/IDE/GHC/CPP.hs | 3 + ghcide/src/Development/IDE/GHC/Compat.hs | 99 ++++- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 185 ++++++-- ghcide/src/Development/IDE/GHC/Compat/Env.hs | 18 +- .../src/Development/IDE/GHC/Compat/Iface.hs | 7 +- .../src/Development/IDE/GHC/Compat/Logger.hs | 13 + .../Development/IDE/GHC/Compat/Outputable.hs | 32 +- .../src/Development/IDE/GHC/Compat/Parser.hs | 4 + .../src/Development/IDE/GHC/Compat/Plugins.hs | 21 +- .../src/Development/IDE/GHC/Compat/Units.hs | 101 +++-- ghcide/src/Development/IDE/GHC/Compat/Util.hs | 2 + ghcide/src/Development/IDE/GHC/Error.hs | 13 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 17 + ghcide/src/Development/IDE/GHC/Util.hs | 2 +- ghcide/src/Development/IDE/GHC/Warnings.hs | 23 +- .../src/Development/IDE/Import/FindImports.hs | 81 +++- ghcide/src/Development/IDE/LSP/Outline.hs | 30 +- .../IDE/Plugin/Completions/Logic.hs | 4 + ghcide/src/Development/IDE/Spans/Common.hs | 11 +- .../Development/IDE/Spans/Documentation.hs | 17 +- ghcide/test/exe/Main.hs | 47 +- haskell-language-server.cabal | 40 +- hie-compat/hie-compat.cabal | 2 + .../src-reexport-ghc92/Compat/HieAst.hs | 3 + .../src-reexport-ghc92/Compat/HieBin.hs | 8 + .../src-reexport-ghc92/Compat/HieDebug.hs | 10 + .../src-reexport-ghc92/Compat/HieTypes.hs | 3 + .../src-reexport-ghc92/Compat/HieUtils.hs | 3 + .../hls-alternate-number-format-plugin.cabal | 8 + .../hls-call-hierarchy-plugin.cabal | 8 + .../hls-change-type-signature-plugin.cabal | 8 + .../hls-class-plugin/hls-class-plugin.cabal | 8 + .../hls-code-range-plugin.cabal | 8 + plugins/hls-eval-plugin/hls-eval-plugin.cabal | 8 + .../hls-explicit-fixity-plugin.cabal | 8 + .../hls-explicit-imports-plugin.cabal | 8 + .../hls-floskell-plugin.cabal | 8 + .../hls-fourmolu-plugin.cabal | 8 + plugins/hls-gadt-plugin/hls-gadt-plugin.cabal | 8 + .../hls-hlint-plugin/hls-hlint-plugin.cabal | 8 + .../hls-module-name-plugin.cabal | 8 + .../hls-ormolu-plugin/hls-ormolu-plugin.cabal | 8 + .../hls-pragmas-plugin.cabal | 8 + .../hls-qualify-imported-names-plugin.cabal | 8 + .../hls-refactor-plugin.cabal | 8 + .../Development/IDE/GHC/Compat/ExactPrint.hs | 5 + .../src/Development/IDE/GHC/Dump.hs | 8 +- .../src/Development/IDE/GHC/ExactPrint.hs | 5 + .../src/Development/IDE/Plugin/CodeAction.hs | 39 +- .../Development/IDE/Plugin/CodeAction/Args.hs | 19 + .../hls-refine-imports-plugin.cabal | 8 + .../hls-rename-plugin/hls-rename-plugin.cabal | 8 + .../hls-retrie-plugin/hls-retrie-plugin.cabal | 4 + .../hls-splice-plugin/hls-splice-plugin.cabal | 8 + plugins/hls-stan-plugin/hls-stan-plugin.cabal | 2 +- .../hls-stylish-haskell-plugin.cabal | 8 + .../hls-tactics-plugin.cabal | 8 + 70 files changed, 1372 insertions(+), 248 deletions(-) create mode 100644 hie-compat/src-reexport-ghc92/Compat/HieAst.hs create mode 100644 hie-compat/src-reexport-ghc92/Compat/HieBin.hs create mode 100644 hie-compat/src-reexport-ghc92/Compat/HieDebug.hs create mode 100644 hie-compat/src-reexport-ghc92/Compat/HieTypes.hs create mode 100644 hie-compat/src-reexport-ghc92/Compat/HieUtils.hs diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index 15b309926e..0bc80aca7f 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -7,7 +7,7 @@ inputs: cabal: description: "Cabal version" required: false - default: "3.6" + default: "3.8.1.0" os: description: "Operating system: Linux, Windows or macOS" required: true diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 4891398af9..059a804125 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -57,7 +57,9 @@ jobs: strategy: fail-fast: true matrix: - ghc: [ "9.2.4" + ghc: [ "9.4.2" + , "9.4.1" + , "9.2.4" , "9.2.3" , "9.0.2" , "8.10.7" @@ -69,6 +71,9 @@ jobs: ] include: # only test supported ghc major versions + - os: ubuntu-latest + ghc: '9.4.2' + test: true - os: ubuntu-latest ghc: '9.2.4' test: true @@ -84,6 +89,9 @@ jobs: - os: ubuntu-latest ghc: '8.6.5' test: true + - os: windows-latest + ghc: '9.4.2' + test: true - os: windows-latest ghc: '9.2.4' test: true diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d0bed4d60d..1152d09d36 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -9,7 +9,7 @@ variables: # Commit of ghc/ci-images repository from which to pull Docker images DOCKER_REV: "4ed1a4f27828ba96a34662dc954335e29b470cd2" - CABAL_INSTALL_VERSION: 3.6.2.0 + CABAL_INSTALL_VERSION: 3.8.1.0 .windows_matrix: &windows_matrix matrix: @@ -21,6 +21,10 @@ variables: CABAL_PROJECT: cabal.project - GHC_VERSION: 9.2.4 CABAL_PROJECT: cabal.project + - GHC_VERSION: 9.4.1 + CABAL_PROJECT: cabal.project + - GHC_VERSION: 9.4.2 + CABAL_PROJECT: cabal.project workflow: rules: diff --git a/bindist/ghcs b/bindist/ghcs index b5009e2c78..151afa1251 100644 --- a/bindist/ghcs +++ b/bindist/ghcs @@ -4,3 +4,5 @@ 9.0.2,cabal.project 9.2.3,cabal.project 9.2.4,cabal.project +9.4.1,cabal.project +9.4.2,cabal.project diff --git a/bindist/ghcs-Msys b/bindist/ghcs-Msys index b4ed5601d5..17e3ffea1c 100644 --- a/bindist/ghcs-Msys +++ b/bindist/ghcs-Msys @@ -2,3 +2,5 @@ 9.0.2,cabal.project 9.2.3,cabal.project 9.2.4,cabal.project +9.4.1,cabal.project +9.4.2,cabal.project diff --git a/cabal.project b/cabal.project index 4022fb1c0c..eb2a58c05c 100644 --- a/cabal.project +++ b/cabal.project @@ -67,6 +67,16 @@ source-repository-package tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460 -- https://github.com/tibbe/ekg-json/pull/12 +source-repository-package + type:git + location: https://github.com/wz1000/hiedb + tag: 67b92df2359558091df9102db5b701327308b930 + +source-repository-package + type:git + location: https://github.com/wz1000/hie-bios + tag: aa73d3d2eb89df0003d2468a105e326d71b62cc7 + -- Needed for ghcide-bench until a new release of lsp-test is out source-repository-package type:git @@ -76,6 +86,9 @@ source-repository-package -- https://github.com/haskell/lsp/pull/450 allow-newer: + base, ghc-prim, ghc-bignum, ghc, Cabal, binary, bytestring, unix, time, template-haskell, + ghc-paths:Cabal, + -- ghc-9.2 ---------- hiedb:base, diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 0160398733..810d8a47f1 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -350,7 +350,6 @@ test-suite ghcide-tests -------------------------------------------------------------- ghcide, ghcide-test-utils-internal, - ghc-typelits-knownnat, lsp, lsp-types, hls-plugin-api, @@ -378,6 +377,8 @@ test-suite ghcide-tests build-depends: record-dot-preprocessor, record-hasfield + if impl(ghc < 9.3) + build-depends: ghc-typelits-knownnat hs-source-dirs: test/cabal test/exe bench/lib ghc-options: -threaded -Wall -Wno-name-shadowing -O0 -Wno-unticked-promoted-constructors main-is: Main.hs diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 4a3e932025..da0a7dd5e3 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} {-| The logic for setting up a ghcide session by tapping into hie-bios. @@ -100,6 +101,9 @@ import HieDb.Types import HieDb.Utils import qualified System.Random as Random import System.Random (RandomGen) +import Control.Monad.IO.Unlift (MonadUnliftIO) +import Control.Exception (evaluate) +import Control.DeepSeq data Log = LogSettingInitialDynFlags @@ -208,11 +212,13 @@ data SessionLoadingOptions = SessionLoadingOptions , getCacheDirs :: String -> [String] -> IO CacheDirs -- | Return the GHC lib dir to use for the 'unsafeGlobalDynFlags' , getInitialGhcLibDir :: Recorder (WithPriority Log) -> FilePath -> IO (Maybe LibDir) +#if !MIN_VERSION_ghc(9,3,0) , fakeUid :: UnitId -- ^ unit id used to tag the internal component built by ghcide -- To reuse external interface files the unit ids must match, -- thus make sure to build them with `--this-unit-id` set to the -- same value as the ghcide fake uid +#endif } instance Default SessionLoadingOptions where @@ -221,7 +227,9 @@ instance Default SessionLoadingOptions where ,loadCradle = loadWithImplicitCradle ,getCacheDirs = getCacheDirsDefault ,getInitialGhcLibDir = getInitialGhcLibDirDefault +#if !MIN_VERSION_ghc(9,3,0) ,fakeUid = Compat.toUnitId (Compat.stringToUnit "main") +#endif } -- | Find the cradle for a given 'hie.yaml' configuration. @@ -494,7 +502,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do new_deps' <- forM new_deps $ \RawComponentInfo{..} -> do -- Remove all inplace dependencies from package flags for -- components in this HscEnv +#if MIN_VERSION_ghc(9,3,0) + let (df2, uids) = (rawComponentDynFlags, []) +#else let (df2, uids) = removeInplacePackages fakeUid inplace rawComponentDynFlags +#endif let prefix = show rawComponentUnitId -- See Note [Avoiding bad interface files] let hscComponents = sort $ map show uids @@ -517,10 +529,14 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- that I do not fully understand log Info $ LogMakingNewHscEnv inplace hscEnv <- emptyHscEnv ideNc libDir - newHscEnv <- + !newHscEnv <- -- Add the options for the current component to the HscEnv evalGhcEnv hscEnv $ do - _ <- setSessionDynFlags $ setHomeUnitId_ fakeUid df + _ <- setSessionDynFlags +#if !MIN_VERSION_ghc(9,3,0) + $ setHomeUnitId_ fakeUid +#endif + df getSession -- Modify the map so the hieYaml now maps to the newly created @@ -718,7 +734,11 @@ cradleToOptsAndLibDir recorder cradle file = do logWith recorder Info $ LogNoneCradleFound file return (Left []) +#if MIN_VERSION_ghc(9,3,0) +emptyHscEnv :: NameCache -> FilePath -> IO HscEnv +#else emptyHscEnv :: IORef NameCache -> FilePath -> IO HscEnv +#endif emptyHscEnv nc libDir = do env <- runGhc (Just libDir) getSession initDynLinker env @@ -757,7 +777,11 @@ toFlagsMap TargetDetails{..} = [ (l, (targetEnv, targetDepends)) | l <- targetLocations] +#if MIN_VERSION_ghc(9,3,0) +setNameCache :: NameCache -> HscEnv -> HscEnv +#else setNameCache :: IORef NameCache -> HscEnv -> HscEnv +#endif setNameCache nc hsc = hsc { hsc_NC = nc } -- | Create a mapping from FilePaths to HscEnvEqs @@ -773,6 +797,11 @@ newComponentCache newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do let df = componentDynFlags ci hscEnv' <- +#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) + -- 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` -- because `setSessionDynFlags` also initializes the package database, @@ -782,7 +811,10 @@ 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 henv <- newFunc hscEnv' uids @@ -790,6 +822,7 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do targetDepends = componentDependencyInfo ci res = (targetEnv, targetDepends) logWith recorder Debug $ LogNewComponentCache res + evaluate $ liftRnf rwhnf $ componentTargets ci let mk t = fromTargetId (importPaths df) exts (targetId t) targetEnv targetDepends ctargets <- concatMapM mk (componentTargets ci) @@ -998,9 +1031,11 @@ setOptions (ComponentOptions theOpts compRoot _) dflags = do -- initPackages parses the -package flags and -- sets up the visibility for each component. -- Throws if a -package flag cannot be satisfied. - env <- hscSetFlags dflags'' <$> getSession - final_env' <- liftIO $ wrapPackageSetupException $ Compat.initUnits env - return (hsc_dflags final_env', targets) + -- This only works for GHC <9.2 + -- For GHC >= 9.2, we need to modify the unit env in the hsc_dflags, which + -- is done later in newComponentCache + final_flags <- liftIO $ wrapPackageSetupException $ Compat.oldInitUnits dflags'' + return (final_flags, targets) setIgnoreInterfacePragmas :: DynFlags -> DynFlags setIgnoreInterfacePragmas df = diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 2430ec719a..564078b513 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -63,6 +63,7 @@ import Data.IORef import Data.List.Extra import Data.Map (Map) import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import Data.Maybe import qualified Data.Text as T import Data.Time (UTCTime (..)) @@ -220,7 +221,12 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do -- names in the compiled bytecode, recording the modules that those names -- come from in the IORef,, as these are the modules on whose implementation -- we depend. - compile_bco_hook :: IORef (ModuleEnv BS.ByteString) -> HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue + compile_bco_hook :: IORef (ModuleEnv BS.ByteString) -> HscEnv -> SrcSpan -> CoreExpr +#if MIN_VERSION_ghc(9,3,0) + -> IO (ForeignHValue, [Linkable], PkgsLoaded) +#else + -> IO ForeignHValue +#endif compile_bco_hook var hsc_env srcspan ds_expr = do { let dflags = hsc_dflags hsc_env @@ -241,13 +247,21 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do ; let iNTERACTIVELoc = G.ModLocation{ ml_hs_file = Nothing, ml_hi_file = panic "hscCompileCoreExpr':ml_hi_file", ml_obj_file = panic "hscCompileCoreExpr':ml_obj_file", - ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" } +#if MIN_VERSION_ghc(9,3,0) + ml_dyn_obj_file = panic "hscCompileCoreExpr':ml_dyn_obj_file", + ml_dyn_hi_file = panic "hscCompileCoreExpr':ml_dyn_hi_file", +#endif + ml_hie_file = panic "hscCompileCoreExpr':ml_hie_file" + } ; let ictxt = hsc_IC hsc_env ; (binding_id, stg_expr, _, _) <- myCoreToStgExpr (hsc_logger hsc_env) (hsc_dflags hsc_env) ictxt +#if MIN_VERSION_ghc(9,3,0) + True -- for bytecode +#endif (icInteractiveModule ictxt) iNTERACTIVELoc prepd_expr @@ -269,7 +283,13 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do -- by default, so we can safely ignore them here. -- Find the linkables for the modules we need - ; let needed_mods = mkUniqSet [ moduleName mod + ; let needed_mods = mkUniqSet [ +#if MIN_VERSION_ghc(9,3,0) + mod -- We need the whole module for 9.4 because of multiple home units modules may have different unit ids +#else + 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 @@ -277,32 +297,55 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do #endif , Just mod <- [nameModule_maybe n] -- Names from other modules , not (isWiredInName n) -- Exclude wired-in names - , moduleUnitId mod == uid -- Only care about stuff from the home package + , moduleUnitId mod `elem` home_unit_ids -- Only care about stuff from the home package set ] - hpt = hsc_HPT hsc_env - uid = homeUnitId_ dflags - mods_transitive = getTransitiveMods hpt needed_mods - -- Non det OK as we will put it into maps later anyway - mods_transitive_list = nonDetEltsUniqSet mods_transitive - - ; lbs <- getLinkables [toNormalizedFilePath' file | mod <- mkHomeModule + home_unit_ids = +#if MIN_VERSION_ghc(9,3,0) + map fst (hugElts $ hsc_HUG hsc_env) +#else + [homeUnitId_ dflags] +#endif + mods_transitive = getTransitiveMods hsc_env needed_mods + -- If we don't support multiple home units, ModuleNames are sufficient because all the units will be the same + mods_transitive_list = +#if MIN_VERSION_ghc(9,3,0) + mapMaybe nodeKeyToInstalledModule $ Set.toList mods_transitive +#else + map #if MIN_VERSION_ghc(9,0,0) - (hscHomeUnit hsc_env) + (mkModule (homeUnitId_ dflags)) +#else + (InstalledModule (toInstalledUnitId $ homeUnitId_ dflags)) +#endif + -- Non det OK as we will put it into maps later anyway + $ nonDetEltsUniqSet mods_transitive +#endif + +#if MIN_VERSION_ghc(9,3,0) + ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) #else - uid + ; moduleLocs <- readIORef (hsc_FC hsc_env) #endif - <$> mods_transitive_list - , let ms = fromJust $ mgLookupModule (hsc_mod_graph hsc_env) mod - , let file = fromJust $ ml_hs_file $ ms_location ms - ] - ; let hsc_env' = hsc_env { hsc_HPT = addListToHpt hpt [(moduleName $ mi_module $ hm_iface hm, hm) | lb <- lbs, let hm = linkableHomeMod lb] } + ; lbs <- getLinkables [toNormalizedFilePath' file + | mod <- mods_transitive_list + , let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs mod + file = case ifr of + InstalledFound loc _ -> + fromJust $ ml_hs_file loc + _ -> panic "hscCompileCoreExprHook: module not found" + ] + ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env -- Essential to do this here after we load the linkables ; keep_lbls <- getLinkablesToKeep ; unload hsc_env' $ map (\(mod, time) -> LM time mod []) $ moduleEnvToList keep_lbls -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,3,0) + {- 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) {- load it -} ; fv_hvs <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs) @@ -314,9 +357,26 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do ; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb]) ; return hval } +#if MIN_VERSION_ghc(9,3,0) + -- TODO: support backpack + nodeKeyToInstalledModule :: NodeKey -> Maybe InstalledModule + nodeKeyToInstalledModule (NodeKey_Module (ModNodeKeyWithUid (GWIB mod _) uid)) = Just $ mkModule uid mod + nodeKeyToInstalledModule _ = Nothing + moduleToNodeKey :: Module -> NodeKey + moduleToNodeKey mod = NodeKey_Module $ ModNodeKeyWithUid (GWIB (moduleName mod) NotBoot) (moduleUnitId mod) +#endif + -- Compute the transitive set of linkables required - getTransitiveMods hpt needed_mods = go emptyUniqSet needed_mods + getTransitiveMods hsc_env needed_mods +#if MIN_VERSION_ghc(9,3,0) + = Set.unions (Set.fromList (map moduleToNodeKey mods) : [ dep | m <- mods + , Just dep <- [Map.lookup (moduleToNodeKey m) (mgTransDeps (hsc_mod_graph hsc_env))] + ]) + where mods = nonDetEltsUniqSet needed_mods -- OK because we put them into a set immediately after +#else + = go emptyUniqSet needed_mods where + hpt = hsc_HPT hsc_env go seen new | isEmptyUniqSet new = seen | otherwise = go seen' new' @@ -325,8 +385,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do new' = new_deps `minusUniqSet` seen' new_deps = unionManyUniqSets [ mkUniqSet $ getDependentMods $ hm_iface mod_info | mod_info <- eltsUDFM $ udfmIntersectUFM hpt (getUniqSet new)] - - +#endif -- | Add a Hook to the DynFlags which captures and returns the -- typechecked splices before they are run. This information @@ -390,11 +449,7 @@ mkHiFileResultNoCompile session tcm = do tcGblEnv = tmrTypechecked tcm details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv -#if MIN_VERSION_ghc(8,10,0) - iface <- mkIfaceTc hsc_env_tmp sf details tcGblEnv -#else - (iface, _) <- mkIfaceTc hsc_env_tmp Nothing sf details tcGblEnv -#endif + iface <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing mkHiFileResultCompile @@ -416,12 +471,22 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do else do -- write core file -- give variables unique OccNames - (guts, details) <- tidyProgram session simplified_guts + tidy_opts <- initTidyOpts session + (guts, details) <- tidyProgram tidy_opts simplified_guts pure (details, Just guts) #if MIN_VERSION_ghc(9,0,1) - let !partial_iface = force (mkPartialIface session details simplified_guts) + let !partial_iface = force $ mkPartialIface session details +#if MIN_VERSION_ghc(9,3,0) + ms +#endif + simplified_guts + final_iface <- mkFullIface session partial_iface Nothing +#if MIN_VERSION_ghc(9,4,2) + Nothing +#endif + #elif MIN_VERSION_ghc(8,10,0) let !partial_iface = force (mkPartialIface session details simplified_guts) final_iface <- mkFullIface session partial_iface @@ -464,8 +529,18 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do -- Run corePrep first as we want to test the final version of the program that will -- get translated to STG/Bytecode - (prepd_binds , _) <- corePrepPgm session mod (ms_location ms) unprep_binds data_tycons - (prepd_binds', _) <- corePrepPgm session mod (ms_location ms) unprep_binds' data_tycons +#if MIN_VERSION_ghc(9,3,0) + prepd_binds +#else + (prepd_binds , _) +#endif + <- corePrepPgm session mod (ms_location ms) unprep_binds data_tycons +#if MIN_VERSION_ghc(9,3,0) + prepd_binds' +#else + (prepd_binds', _) +#endif + <- corePrepPgm session mod (ms_location ms) unprep_binds' data_tycons let binds = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds binds' = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds' @@ -552,9 +627,17 @@ generateObjectCode session summary guts = do withWarnings "object" $ \tweak -> do let env' = tweak (hscSetFlags (ms_hspp_opts summary) session) target = platformDefaultBackend (hsc_dflags env') - newFlags = setBackend target $ updOptLevel 0 $ setOutputFile dot_o $ hsc_dflags env' + newFlags = setBackend target $ updOptLevel 0 $ setOutputFile +#if MIN_VERSION_ghc(9,3,0) + (Just dot_o) +#else + dot_o +#endif + $ hsc_dflags env' session' = hscSetFlags newFlags session -#if MIN_VERSION_ghc(9,0,1) +#if MIN_VERSION_ghc(9,4,2) + (outputFilename, _mStub, _foreign_files, _cinfos, _stgcinfos) <- hscGenHardCode session' guts +#elif MIN_VERSION_ghc(9,0,1) (outputFilename, _mStub, _foreign_files, _cinfos) <- hscGenHardCode session' guts #else (outputFilename, _mStub, _foreign_files) <- hscGenHardCode session' guts @@ -565,7 +648,14 @@ generateObjectCode session summary guts = do summary #endif fp - compileFile session' StopLn (outputFilename, Just (As False)) + obj <- compileFile session' driverNoStop (outputFilename, Just (As False)) +#if MIN_VERSION_ghc(9,3,0) + case obj of + Nothing -> throwGhcExceptionIO $ Panic "compileFile didn't generate object code" + Just x -> pure x +#else + return obj +#endif let unlinked = DotO dot_o_fp -- Need time to be the modification time for recompilation checking t <- liftIO $ getModificationTime dot_o_fp @@ -614,10 +704,17 @@ update_pm_mod_summary :: (ModSummary -> ModSummary) -> ParsedModule -> ParsedMod update_pm_mod_summary up pm = pm{pm_mod_summary = up $ pm_mod_summary pm} +#if MIN_VERSION_ghc(9,3,0) +unDefer :: (Maybe DiagnosticReason, FileDiagnostic) -> (Bool, FileDiagnostic) +unDefer (Just (WarningWithFlag Opt_WarnDeferredTypeErrors) , fd) = (True, upgradeWarningToError fd) +unDefer (Just (WarningWithFlag Opt_WarnTypedHoles) , fd) = (True, upgradeWarningToError fd) +unDefer (Just (WarningWithFlag Opt_WarnDeferredOutOfScopeVariables), fd) = (True, upgradeWarningToError fd) +#else unDefer :: (WarnReason, FileDiagnostic) -> (Bool, FileDiagnostic) unDefer (Reason Opt_WarnDeferredTypeErrors , fd) = (True, upgradeWarningToError fd) unDefer (Reason Opt_WarnTypedHoles , fd) = (True, upgradeWarningToError fd) unDefer (Reason Opt_WarnDeferredOutOfScopeVariables, fd) = (True, upgradeWarningToError fd) +#endif unDefer ( _ , fd) = (False, fd) upgradeWarningToError :: FileDiagnostic -> FileDiagnostic @@ -626,10 +723,15 @@ upgradeWarningToError (nfp, sh, fd) = warn2err :: T.Text -> T.Text warn2err = T.intercalate ": error:" . T.splitOn ": warning:" +#if MIN_VERSION_ghc(9,3,0) +hideDiag :: DynFlags -> (Maybe DiagnosticReason, FileDiagnostic) -> (Maybe DiagnosticReason, FileDiagnostic) +hideDiag originalFlags (w@(Just (WarningWithFlag warning)), (nfp, _sh, fd)) +#else hideDiag :: DynFlags -> (WarnReason, FileDiagnostic) -> (WarnReason, FileDiagnostic) -hideDiag originalFlags (Reason warning, (nfp, _sh, fd)) +hideDiag originalFlags (w@(Reason warning), (nfp, _sh, fd)) +#endif | not (wopt warning originalFlags) - = (Reason warning, (nfp, HideDiag, fd)) + = (w, (nfp, HideDiag, fd)) hideDiag _originalFlags t = t -- | Warnings which lead to a diagnostic tag @@ -650,10 +752,15 @@ unnecessaryDeprecationWarningFlags ] -- | Add a unnecessary/deprecated tag to the required diagnostics. +#if MIN_VERSION_ghc(9,3,0) +tagDiag :: (Maybe DiagnosticReason, FileDiagnostic) -> (Maybe DiagnosticReason, FileDiagnostic) +tagDiag (w@(Just (WarningWithFlag warning)), (nfp, sh, fd)) +#else tagDiag :: (WarnReason, FileDiagnostic) -> (WarnReason, FileDiagnostic) -tagDiag (Reason warning, (nfp, sh, fd)) +tagDiag (w@(Reason warning), (nfp, sh, fd)) +#endif | Just tag <- requiresTag warning - = (Reason warning, (nfp, sh, fd { _tags = addTag tag (_tags fd) })) + = (w, (nfp, sh, fd { _tags = addTag tag (_tags fd) })) where requiresTag :: WarningFlag -> Maybe DiagnosticTag requiresTag Opt_WarnWarningsDeprecations @@ -695,7 +802,12 @@ generateHieAsts hscEnv tcm = insts = tcg_insts ts :: [ClsInst] tcs = tcg_tcs ts :: [TyCon] run ts $ - Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs +#if MIN_VERSION_ghc(9,3,0) + pure $ Just $ +#else + Just <$> +#endif + GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs #else Just <$> GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) #endif @@ -703,7 +815,7 @@ generateHieAsts hscEnv tcm = dflags = hsc_dflags hscEnv #if MIN_VERSION_ghc(9,0,0) run ts = -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) fmap (join . snd) . liftIO . initDs hscEnv ts #else id @@ -905,13 +1017,59 @@ loadModulesHome -> HscEnv -> HscEnv loadModulesHome mod_infos e = +#if MIN_VERSION_ghc(9,3,0) + hscUpdateHUG (\hug -> foldr addHomeModInfoToHug hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars }) +#else let !new_modules = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos] in e { hsc_HPT = new_modules - , hsc_type_env_var = Nothing } + , hsc_type_env_var = Nothing + } where mod_name = moduleName . mi_module . hm_iface +#endif -- Merge the HPTs, module graphs and FinderCaches +#if MIN_VERSION_ghc(9,3,0) +mergeEnvs :: HscEnv -> [ModuleGraphNode] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv +mergeEnvs env extraNodes extraMods envs = do + let extraModSummaries = mapMaybe moduleGraphNodeModSum extraNodes + ims = map (\ms -> Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms))) extraModSummaries + ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) extraModSummaries ims + curFinderCache = + foldl' + (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) Compat.emptyInstalledModuleEnv + $ zip ims ifrs + -- Very important to force this as otherwise the hsc_mod_graph field is not + -- forced and ends up retaining a reference to all the old hsc_envs we have merged to get + -- this new one, which in turn leads to the EPS referencing the HPT. + module_graph_nodes = + extraNodes ++ nubOrdOn mkNodeKey (concatMap (mgModSummaries' . hsc_mod_graph) envs) + + newFinderCache <- concatFC curFinderCache (map hsc_FC envs) + liftRnf rwhnf module_graph_nodes `seq` (return $ loadModulesHome extraMods $ + let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in + (hscUpdateHUG (const newHug) env){ + hsc_FC = newFinderCache, + hsc_mod_graph = mkModuleGraph module_graph_nodes + }) + + where + mergeHUG (UnitEnvGraph a) (UnitEnvGraph b) = UnitEnvGraph $ Map.unionWith mergeHUE a b + mergeHUE a b = a { homeUnitEnv_hpt = mergeUDFM (homeUnitEnv_hpt a) (homeUnitEnv_hpt b) } + mergeUDFM = plusUDFM_C combineModules + + combineModules a b + | HsSrcFile <- mi_hsc_src (hm_iface a) = a + | otherwise = b + concatFC :: FinderCacheState -> [FinderCache] -> IO FinderCache + concatFC cur xs = do + fcModules <- mapM (readIORef . fcModuleCache) xs + fcFiles <- mapM (readIORef . fcFileCache) xs + fcModules' <- newIORef (foldl' (plusInstalledModuleEnv const) cur fcModules) + fcFiles' <- newIORef (Map.unions fcFiles) + pure $ FinderCache fcModules' fcFiles' + +#else mergeEnvs :: HscEnv -> [ModSummary] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv mergeEnvs env extraModSummaries extraMods envs = do prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs @@ -933,11 +1091,13 @@ mergeEnvs env extraModSummaries extraMods envs = do foldl' (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) prevFinderCache $ zip ims ifrs - liftRnf rwhnf module_graph_nodes `seq` (return $ loadModulesHome extraMods $ env{ - hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs, - hsc_FC = newFinderCache, - hsc_mod_graph = mkModuleGraph module_graph_nodes - }) + liftRnf rwhnf module_graph_nodes `seq` (return $ loadModulesHome extraMods $ + env{ + hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs, + hsc_FC = newFinderCache, + hsc_mod_graph = mkModuleGraph module_graph_nodes + }) + where mergeUDFM = plusUDFM_C combineModules combineModules a b @@ -950,6 +1110,7 @@ mergeEnvs env extraModSummaries extraMods envs = do -- To remove this, I plan to upstream the missing Monoid instance concatFC :: [FinderCache] -> FinderCache concatFC = unsafeCoerce (mconcat @(Map InstalledModule InstalledFindResult)) +#endif withBootSuffix :: HscSource -> ModLocation -> ModLocation withBootSuffix HsBootFile = addBootSuffixLocnOut @@ -978,26 +1139,45 @@ getModSummaryFromImports env fp modTime contents = do (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource.unLoc) imps -- GHC.Prim doesn't exist physically, so don't go looking for it. - ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc - . ideclName . unLoc) - ord_idecls + (ordinary_imps, ghc_prim_imports) + = partition ((/= moduleName gHC_PRIM) . unLoc + . ideclName . unLoc) + ord_idecls implicit_prelude = xopt LangExt.ImplicitPrelude dflags implicit_imports = mkPrelImports mod main_loc implicit_prelude imps - convImport (L _ i) = (fmap sl_fs (ideclPkgQual i) - , reLoc $ ideclName i) + convImport (L _ i) = ( +#if !MIN_VERSION_ghc (9,3,0) + fmap sl_fs +#endif + (ideclPkgQual i) + , reLoc $ ideclName i) + + msrImports = implicit_imports ++ imps + +#if MIN_VERSION_ghc (9,3,0) + rn_pkg_qual = renameRawPkgQual (hsc_unit_env env) + rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn)) + srcImports = rn_imps $ map convImport src_idecls + textualImports = rn_imps $ map convImport (implicit_imports ++ ordinary_imps) + ghc_prim_import = not (null ghc_prim_imports) +#else srcImports = map convImport src_idecls textualImports = map convImport (implicit_imports ++ ordinary_imps) +#endif - msrImports = implicit_imports ++ imps -- Force bits that might keep the string buffer and DynFlags alive unnecessarily liftIO $ evaluate $ rnf srcImports liftIO $ evaluate $ rnf textualImports +#if MIN_VERSION_ghc (9,3,0) + !src_hash <- liftIO $ fingerprintFromStringBuffer contents +#endif + modLoc <- liftIO $ if mod == mAIN_NAME -- specially in tests it's common to have lots of nameless modules -- mkHomeModLocation will map them to the same hi/hie locations @@ -1012,7 +1192,14 @@ getModSummaryFromImports env fp modTime contents = do #if MIN_VERSION_ghc(8,8,0) , ms_hie_date = Nothing #endif +#if MIN_VERSION_ghc(9,3,0) + , ms_dyn_obj_date = Nothing + , ms_ghc_prim_import = ghc_prim_import + , ms_hs_hash = src_hash + +#else , ms_hs_date = modTime +#endif , ms_hsc_src = sourceType -- The contents are used by the GetModSummary rule , ms_hspp_buf = Just contents @@ -1036,7 +1223,14 @@ getModSummaryFromImports env fp modTime contents = do put $ Util.uniq $ moduleNameFS $ moduleName ms_mod forM_ (ms_srcimps ++ ms_textual_imps) $ \(mb_p, m) -> do put $ Util.uniq $ moduleNameFS $ unLoc m +#if MIN_VERSION_ghc(9,3,0) + case mb_p of + G.NoPkgQual -> pure () + G.ThisPkg uid -> put $ getKey $ getUnique uid + G.OtherPkg uid -> put $ getKey $ getUnique uid +#else whenJust mb_p $ put . Util.uniq +#endif return $! Util.fingerprintFingerprints $ [ Util.fingerprintString fp , fingerPrintImports @@ -1130,7 +1324,12 @@ parseFileContents env customPreprocessor filename ms = do -- - filter out the .hs/.lhs source filename if we have one -- let n_hspp = normalise filename - srcs0 = nubOrd $ filter (not . (tmpDir dflags `isPrefixOf`)) +#if MIN_VERSION_ghc(9,3,0) + TempDir tmp_dir = tmpDir dflags +#else + tmp_dir = tmpDir dflags +#endif + srcs0 = nubOrd $ filter (not . (tmp_dir `isPrefixOf`)) $ filter (/= n_hspp) $ map normalise $ filter (not . isPrefixOf "<") @@ -1272,7 +1471,13 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do -- If mb_old_iface is nothing then checkOldIface will load it for us -- given that the source is unmodified (recomp_iface_reqd, mb_checked_iface) +#if MIN_VERSION_ghc(9,3,0) + <- liftIO $ checkOldIface sessionWithMsDynFlags ms mb_old_iface >>= \case + UpToDateItem x -> pure (UpToDate, Just x) + OutOfDateItem reason x -> pure (NeedsRecompile reason, x) +#else <- liftIO $ checkOldIface sessionWithMsDynFlags ms sourceMod mb_old_iface +#endif let do_regenerate _reason = withTrace "regenerate interface" $ \setTag -> do setTag "Module" $ moduleNameString $ moduleName mod @@ -1309,14 +1514,14 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do readBinCoreFile (mkUpdater $ hsc_NC session) core_file if cf_iface_hash == getModuleHash iface then return ([], Just $ mkHiFileResult ms iface details runtime_deps (Just (core_file, fingerprintToBS core_hash))) - else do_regenerate (RecompBecause "Core file out of date (doesn't match iface hash)") + else do_regenerate (recompBecause "Core file out of date (doesn't match iface hash)") | otherwise -> return ([], Just $ mkHiFileResult ms iface details runtime_deps Nothing) where handleErrs = flip catches - [Handler $ \(e :: IOException) -> do_regenerate (RecompBecause $ "Reading core file failed (" ++ show e ++ ")") + [Handler $ \(e :: IOException) -> do_regenerate (recompBecause $ "Reading core file failed (" ++ show e ++ ")") ,Handler $ \(e :: GhcException) -> case e of Signal _ -> throw e Panic _ -> throw e - _ -> do_regenerate (RecompBecause $ "Reading core file failed (" ++ show e ++ ")") + _ -> do_regenerate (recompBecause $ "Reading core file failed (" ++ show e ++ ")") ] (_, _reason) -> do_regenerate _reason @@ -1351,18 +1556,36 @@ checkLinkableDependencies get_linkable_hashes graph runtime_deps = do let out_of_date = [core_file | ((core_file, expected_hash), actual_hash) <- zip fs store_hashes, expected_hash /= actual_hash] case out_of_date of [] -> pure Nothing - _ -> pure $ Just $ - RecompBecause $ "out of date runtime dependencies: " ++ intercalate ", " (map show out_of_date) + _ -> pure $ Just $ recompBecause + $ "out of date runtime dependencies: " ++ intercalate ", " (map show out_of_date) + +recompBecause = +#if MIN_VERSION_ghc(9,3,0) + NeedsRecompile . +#endif + RecompBecause +#if MIN_VERSION_ghc(9,3,0) + . CustomReason +#endif + +#if MIN_VERSION_ghc(9,3,0) +data SourceModified = SourceModified | SourceUnmodified deriving (Eq, Ord, Show) +#endif showReason :: RecompileRequired -> String showReason UpToDate = "UpToDate" +#if MIN_VERSION_ghc(9,3,0) +showReason (NeedsRecompile MustCompile) = "MustCompile" +showReason (NeedsRecompile s) = printWithoutUniques s +#else showReason MustCompile = "MustCompile" showReason (RecompBecause s) = s +#endif mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails mkDetailsFromIface session iface = do fixIO $ \details -> do - let hsc' = session { hsc_HPT = addToHpt (hsc_HPT session) (moduleName $ mi_module iface) (HomeModInfo iface details Nothing) } + let hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details Nothing)) session initIfaceLoad hsc' (typecheckIface iface) coreFileToCgGuts :: HscEnv -> ModIface -> ModDetails -> CoreFile -> IO CgGuts @@ -1371,28 +1594,26 @@ coreFileToCgGuts session iface details core_file = do (HomeModInfo iface details Nothing) this_mod = mi_module iface types_var <- newIORef (md_types details) - let kv = Just (this_mod, types_var) - hsc_env' = session { hsc_HPT = act (hsc_HPT session) - , hsc_type_env_var = kv } + let hsc_env' = hscUpdateHPT act (session { +#if MIN_VERSION_ghc(9,3,0) + hsc_type_env_vars = knotVarsFromModuleEnv (mkModuleEnv [(this_mod, types_var)]) +#else + hsc_type_env_var = Just (this_mod, types_var) +#endif + }) core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckCoreFile this_mod types_var core_file -- Implicit binds aren't saved, so we need to regenerate them ourselves. let implicit_binds = concatMap getImplicitBinds tyCons tyCons = typeEnvTyCons (md_types details) +#if MIN_VERSION_ghc(9,3,0) + pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] +#else pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing [] +#endif coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDetails -> CoreFile -> UTCTime -> IO ([FileDiagnostic], Maybe HomeModInfo) coreFileToLinkable linkableType session ms iface details core_file t = do - let act hpt = addToHpt hpt (moduleName this_mod) - (HomeModInfo iface details Nothing) - this_mod = mi_module iface - types_var <- newIORef (md_types details) - let kv = Just (this_mod, types_var) - hsc_env' = session { hsc_HPT = act (hsc_HPT session) - , hsc_type_env_var = kv } - core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckCoreFile this_mod types_var core_file - let implicit_binds = concatMap getImplicitBinds tyCons - tyCons = typeEnvTyCons (md_types details) - let cgi_guts = CgGuts this_mod tyCons (implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing [] + cgi_guts <- coreFileToCgGuts session iface details core_file (warns, lb) <- case linkableType of BCOLinkable -> generateByteCode (CoreFileTime t) session ms cgi_guts ObjectLinkable -> generateObjectCode session ms cgi_guts @@ -1405,27 +1626,55 @@ getDocsBatch :: HscEnv -> Module -- ^ a moudle where the names are in scope -> [Name] +#if MIN_VERSION_ghc(9,3,0) + -> IO [Either String (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn))] +#else -> IO [Either String (Maybe HsDocString, IntMap HsDocString)] +#endif getDocsBatch hsc_env _mod _names = do (msgs, res) <- initTc hsc_env HsSrcFile False _mod fakeSpan $ forM _names $ \name -> case nameModule_maybe name of Nothing -> return (Left $ NameHasNoModule name) Just mod -> do - ModIface { mi_doc_hdr = mb_doc_hdr + ModIface { +#if MIN_VERSION_ghc(9,3,0) + mi_docs = Just Docs{ docs_mod_hdr = mb_doc_hdr + , docs_decls = dmap + , docs_args = amap + } +#else + mi_doc_hdr = mb_doc_hdr , mi_decl_docs = DeclDocMap dmap , mi_arg_docs = ArgDocMap amap +#endif } <- loadModuleInterface "getModuleInterface" mod +#if MIN_VERSION_ghc(9,3,0) + if isNothing mb_doc_hdr && isNullUniqMap dmap && isNullUniqMap amap +#else if isNothing mb_doc_hdr && Map.null dmap && null amap +#endif then pure (Left (NoDocsInIface mod $ compiled name)) - else pure (Right ( Map.lookup name dmap , + else pure (Right ( +#if MIN_VERSION_ghc(9,3,0) + lookupUniqMap dmap name, +#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 Map.findWithDefault mempty name amap)) +#endif case res of - Just x -> return $ map (first $ T.unpack . printOutputable) x + Just x -> return $ map (first $ T.unpack . printOutputable) + $ x Nothing -> throwErrors -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,3,0) + $ fmap GhcTcRnMessage msgs +#elif MIN_VERSION_ghc(9,2,0) $ Error.getErrorMessages msgs #else $ snd msgs diff --git a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs index c3b5323548..45f6e8c3da 100644 --- a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs +++ b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs @@ -56,8 +56,8 @@ parseConfiguration InitializeParams {..} = clientSettings = hashed _initializationOptions parseWorkspaceFolder :: WorkspaceFolder -> NormalizedUri -parseWorkspaceFolder = - toNormalizedUri . Uri . (_uri :: WorkspaceFolder -> Text) +parseWorkspaceFolder WorkspaceFolder{_uri} = + toNormalizedUri (Uri _uri) modifyWorkspaceFolders :: IdeState -> (HashSet NormalizedUri -> HashSet NormalizedUri) -> IO () diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 678471c9c1..08a41b0ed4 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -1,5 +1,6 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} module Development.IDE.Core.Preprocessor ( preprocessor @@ -28,6 +29,10 @@ import Development.IDE.Types.Location import qualified GHC.LanguageExtensions as LangExt import System.FilePath import System.IO.Extra +#if MIN_VERSION_ghc(9,3,0) +import GHC.Utils.Logger (LogFlags(..)) +import GHC.Utils.Outputable (renderWithContext) +#endif -- | Given a file and some contents, apply any necessary preprocessors, -- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies. @@ -76,10 +81,15 @@ preprocessor env0 filename mbContents = do where logAction :: IORef [CPPLog] -> LogActionCompat logAction cppLogs dflags _reason severity srcSpan _style msg = do +#if MIN_VERSION_ghc(9,3,0) + let log = CPPLog (fromMaybe SevWarning severity) srcSpan $ T.pack $ renderWithContext (log_default_user_context dflags) msg +#else let log = CPPLog severity srcSpan $ T.pack $ showSDoc dflags msg +#endif modifyIORef cppLogs (log :) + data CPPLog = CPPLog Severity SrcSpan Text deriving (Show) @@ -133,7 +143,11 @@ parsePragmasIntoDynFlags -> Util.StringBuffer -> IO (Either [FileDiagnostic] ([String], DynFlags)) parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do +#if MIN_VERSION_ghc(9,3,0) + let (_warns,opts) = getOptions (initParserOpts dflags0) contents fp +#else let opts = getOptions dflags0 contents fp +#endif -- Force bits that might keep the dflags and stringBuffer alive unnecessarily evaluate $ rnf opts diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index dfba6a32e7..07cf081c21 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -158,6 +158,10 @@ import qualified Development.IDE.Types.Shake as Shake import Development.IDE.GHC.CoreFile import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Control.Monad.IO.Unlift +#if MIN_VERSION_ghc(9,3,0) +import GHC.Unit.Module.Graph +import GHC.Unit.Env +#endif data Log = LogShake Shake.Log @@ -664,7 +668,7 @@ typeCheckRule recorder = define (cmapWithPrio LogShake recorder) $ \TypeCheck fi -- very expensive. when (foi == NotFOI) $ logWith recorder Logger.Warning $ LogTypecheckedFOI file - typeCheckRuleDefinition hsc pm + typeCheckRuleDefinition hsc pm file knownFilesRule :: Recorder (WithPriority Log) -> Rules () knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetKnownTargets -> do @@ -685,8 +689,9 @@ getModuleGraphRule recorder = defineNoFile (cmapWithPrio LogShake recorder) $ \G typeCheckRuleDefinition :: HscEnv -> ParsedModule + -> NormalizedFilePath -> Action (IdeResult TcModuleResult) -typeCheckRuleDefinition hsc pm = do +typeCheckRuleDefinition hsc pm file = do setPriority priorityTypeCheck IdeOptions { optDefer = defer } <- getIdeOptions @@ -772,9 +777,21 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps ifaces <- uses_ GetModIface deps - - let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces - session' <- liftIO $ mergeEnvs hsc mss inLoadOrder depSessions + let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces +#if MIN_VERSION_ghc(9,3,0) + mss_imports <- uses_ GetLocatedImports (file : deps) + final_deps <- forM mss_imports $ \imports -> do + let fs = mapMaybe (fmap artifactFilePath . snd) imports + dep_mss <- map msrModSummary <$> if fullModSummary + then uses_ GetModSummary fs + else uses_ GetModSummaryWithoutTimestamps fs + return (map (NodeKey_Module . msKey) dep_mss) + ms <- msrModSummary <$> use_ GetModSummary file + let moduleNodes = zipWith ModuleNode final_deps (ms : mss) +#else + let moduleNodes = mss +#endif + session' <- liftIO $ mergeEnvs hsc moduleNodes inLoadOrder depSessions Just <$> liftIO (newHscEnvEqWithImportPaths (envImportPaths env) session' []) @@ -880,8 +897,12 @@ getModSummaryRule displayTHWarning recorder = do when (uses_th_qq $ msrModSummary res) $ do DisplayTHWarning act <- getIdeGlobalAction liftIO act +#if MIN_VERSION_ghc(9,3,0) + let bufFingerPrint = ms_hs_hash (msrModSummary res) +#else bufFingerPrint <- liftIO $ fingerprintFromStringBuffer $ fromJust $ ms_hspp_buf $ msrModSummary res +#endif let fingerPrint = Util.fingerprintFingerprints [ msrFingerprint res, bufFingerPrint ] return ( Just (fingerprintToBS fingerPrint) , ([], Just res)) @@ -892,7 +913,9 @@ getModSummaryRule displayTHWarning recorder = do case ms of Just res@ModSummaryResult{..} -> do let ms = msrModSummary { +#if !MIN_VERSION_ghc(9,3,0) ms_hs_date = error "use GetModSummary instead of GetModSummaryWithoutTimestamps", +#endif ms_hspp_buf = error "use GetModSummary instead of GetModSummaryWithoutTimestamps" } fp = fingerprintToBS msrFingerprint @@ -973,7 +996,7 @@ regenerateHiFile sess f ms compNeeded = do Just pm -> do -- Invoke typechecking directly to update it without incurring a dependency -- on the parsed module and the typecheck rules - (diags', mtmr) <- typeCheckRuleDefinition hsc pm + (diags', mtmr) <- typeCheckRuleDefinition hsc pm f case mtmr of Nothing -> pure (diags', Nothing) Just tmr -> do diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 211c5468a2..0b31b83ac7 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -10,6 +10,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} -- | A Shake implementation of the compiler service. -- @@ -129,8 +130,11 @@ import Development.IDE.GHC.Compat (NameCache, NameCacheUpdater (..), initNameCache, knownKeyNames, - mkSplitUniqSupply, - upNameCache) +#if !MIN_VERSION_ghc(9,3,0) + upNameCache, +#endif + mkSplitUniqSupply + ) import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import qualified Development.IDE.Graph as Shake @@ -262,7 +266,11 @@ data ShakeExtras = ShakeExtras -> String -> [DelayedAction ()] -> IO () +#if MIN_VERSION_ghc(9,3,0) + ,ideNc :: NameCache +#else ,ideNc :: IORef NameCache +#endif -- | A mapping of module name to known target (or candidate targets, if missing) ,knownTargetsVar :: TVar (Hashed KnownTargets) -- | A mapping of exported identifiers for local modules. Updated on kick @@ -572,8 +580,12 @@ shakeOpen recorder lspEnv defaultConfig idePlugins logger debouncer let log :: Logger.Priority -> Log -> IO () log = logWith recorder +#if MIN_VERSION_ghc(9,3,0) + ideNc <- initNameCache 'r' knownKeyNames +#else us <- mkSplitUniqSupply 'r' ideNc <- newIORef (initNameCache us knownKeyNames) +#endif shakeExtras <- do globals <- newTVarIO HMap.empty state <- STM.newIO @@ -959,8 +971,14 @@ runIdeAction _herald s i = runReaderT (runIdeActionT i) s askShake :: IdeAction ShakeExtras askShake = ask + +#if MIN_VERSION_ghc(9,3,0) +mkUpdater :: NameCache -> NameCacheUpdater +mkUpdater = id +#else mkUpdater :: IORef NameCache -> NameCacheUpdater mkUpdater ref = NCU (upNameCache ref) +#endif -- | A (maybe) stale result now, and an up to date one later data FastResult a = FastResult { stale :: Maybe (a,PositionMapping), uptoDate :: IO (Maybe a) } diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 788e93ea8d..fc18450292 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -34,6 +34,9 @@ import ToolSettings import DynFlags #endif #endif +#if MIN_VERSION_ghc(9,3,0) +import qualified GHC.Driver.Pipeline.Execute as Pipeline +#endif addOptP :: String -> DynFlags -> DynFlags #if MIN_VERSION_ghc (8,10,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 43cb524256..157ddcde4c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -9,12 +9,19 @@ -- | Attempt at hiding the GHC version differences we can. module Development.IDE.GHC.Compat( - NameCacheUpdater(..), + mkHomeModLocation, hPutStringBuffer, addIncludePathsQuote, getModuleHash, setUpTypedHoles, + NameCacheUpdater(..), +#if MIN_VERSION_ghc(9,3,0) + getMessages, + diagnosticMessage, + nameEnvElts, +#else upNameCache, +#endif disableWarningsAsErrors, reLoc, reLocA, @@ -27,8 +34,10 @@ module Development.IDE.GHC.Compat( #endif #if MIN_VERSION_ghc(9,2,0) +#if !MIN_VERSION_ghc(9,3,0) extendModSummaryNoDeps, emsModSummary, +#endif myCoreToStgExpr, #endif @@ -87,7 +96,11 @@ module Development.IDE.GHC.Compat( icInteractiveModule, HomePackageTable, lookupHpt, +#if MIN_VERSION_ghc(9,3,0) + Dependencies(dep_direct_mods), +#else Dependencies(dep_mods), +#endif bcoFreeNames, ModIfaceAnnotation, pattern Annotation, @@ -116,7 +129,7 @@ module Development.IDE.GHC.Compat( ) where import Data.Bifunctor -import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Core hiding (moduleUnitId) import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface import Development.IDE.GHC.Compat.Logger @@ -147,7 +160,11 @@ import GHC.Linker.Types (isObjectLinkable) import GHC.Runtime.Context (icInteractiveModule) import GHC.Unit.Home.ModInfo (HomePackageTable, lookupHpt) -import GHC.Unit.Module.Deps (Dependencies (dep_mods)) +#if MIN_VERSION_ghc(9,3,0) +import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods)) +#else +import GHC.Unit.Module.Deps (Dependencies(dep_mods)) +#endif #else import GHC.CoreToByteCode (coreExprToBCOs) import GHC.Driver.Types (Dependencies (dep_mods), @@ -255,16 +272,37 @@ import GHC.Types.CostCentre import GHC.Types.IPE #endif +#if MIN_VERSION_ghc(9,3,0) +import GHC.Types.Error +import GHC.Driver.Config.Stg.Pipeline +#endif + type ModIfaceAnnotation = Annotation +#if MIN_VERSION_ghc(9,3,0) +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 +#endif -> Module -> ModLocation -> CoreExpr -> IO ( Id - , [StgTopBinding] +#if MIN_VERSION_ghc(9,3,0) + ,[CgStgTopBinding] -- output program +#else + ,[StgTopBinding] -- output program +#endif , InfoTableProvMap , CollectedCCs ) -myCoreToStgExpr logger dflags ictxt this_mod ml prepd_expr = do +myCoreToStgExpr logger dflags ictxt +#if MIN_VERSION_ghc(9,3,0) + for_bytecode +#endif + this_mod ml prepd_expr = do {- Create a temporary binding (just because myCoreToStg needs a binding for the stg2stg step) -} let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel") @@ -275,24 +313,46 @@ myCoreToStgExpr logger dflags ictxt this_mod ml prepd_expr = do myCoreToStg logger dflags ictxt +#if MIN_VERSION_ghc(9,3,0) + for_bytecode +#endif this_mod ml [NonRec bco_tmp_id prepd_expr] return (bco_tmp_id, stg_binds, prov_map, collected_ccs) myCoreToStg :: Logger -> DynFlags -> InteractiveContext +#if MIN_VERSION_ghc(9,3,0) + -> Bool +#endif -> Module -> ModLocation -> CoreProgram +#if MIN_VERSION_ghc(9,3,0) + -> IO ( [CgStgTopBinding] -- output program +#else -> IO ( [StgTopBinding] -- output program +#endif , InfoTableProvMap , CollectedCCs ) -- CAF cost centre info (declared and used) -myCoreToStg logger dflags ictxt this_mod ml prepd_binds = do +myCoreToStg logger dflags ictxt +#if MIN_VERSION_ghc(9,3,0) + for_bytecode +#endif + this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} coreToStg dflags this_mod ml prepd_binds +#if MIN_VERSION_ghc(9,4,2) + (stg_binds2,_) +#else stg_binds2 +#endif <- {-# SCC "Stg2Stg" #-} +#if MIN_VERSION_ghc(9,3,0) + stg2stg logger ictxt (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds +#else stg2stg logger dflags ictxt this_mod stg_binds +#endif return (stg_binds2, denv, cost_centre_info) #endif @@ -307,7 +367,9 @@ reLocA = id #endif getDependentMods :: ModIface -> [ModuleName] -#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,3,0) +getDependentMods = map (gwib_mod . snd) . S.toList . dep_direct_mods . mi_deps +#elif MIN_VERSION_ghc(9,0,0) getDependentMods = map gwib_mod . dep_mods . mi_deps #else getDependentMods = map fst . dep_mods . mi_deps @@ -333,9 +395,15 @@ hPutStringBuffer hdl (StringBuffer buf len cur) #if MIN_VERSION_ghc(9,2,0) type ErrMsg = MsgEnvelope DecoratedSDoc #endif +#if MIN_VERSION_ghc(9,3,0) +type WarnMsg = MsgEnvelope DecoratedSDoc +#endif getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag ErrMsg) getMessages' pst dflags = +#if MIN_VERSION_ghc(9,3,0) + bimap (fmap (fmap diagnosticMessage) . getMessages) (fmap (fmap diagnosticMessage) . getMessages) $ getPsMessages pst +#else #if MIN_VERSION_ghc(9,2,0) bimap (fmap pprWarning) (fmap pprError) $ #endif @@ -343,11 +411,16 @@ getMessages' pst dflags = #if !MIN_VERSION_ghc(9,2,0) dflags #endif +#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) + <- PFailed (const . fmap (fmap diagnosticMessage) . getMessages . getPsErrorMessages -> msgs) +#else <- PFailed (const . fmap pprError . getErrorMessages -> msgs) +#endif #elif MIN_VERSION_ghc(8,10,0) pattern PFailedWithErrorMessages :: (DynFlags -> ErrorMessages) -> ParseResult a pattern PFailedWithErrorMessages msgs @@ -360,7 +433,7 @@ pattern PFailedWithErrorMessages msgs mkPlainErrMsgIfPFailed (PFailed _ pst err) = Just (\dflags -> mkPlainErrMsg dflags pst err) mkPlainErrMsgIfPFailed _ = Nothing #endif -{-# COMPLETE PFailedWithErrorMessages #-} +{-# COMPLETE POk, PFailedWithErrorMessages #-} supportsHieFiles :: Bool supportsHieFiles = True @@ -368,7 +441,9 @@ supportsHieFiles = True hieExportNames :: HieFile -> [(SrcSpan, Name)] hieExportNames = nameListFromAvails . hie_exports - +#if MIN_VERSION_ghc(9,3,0) +type NameCacheUpdater = NameCache +#else upNameCache :: IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c #if MIN_VERSION_ghc(8,8,0) upNameCache = updNameCache @@ -376,6 +451,7 @@ upNameCache = updNameCache upNameCache ref upd_fn = atomicModifyIORef' ref upd_fn #endif +#endif #if !MIN_VERSION_ghc(9,0,1) type RefMap a = Map.Map Identifier [(Span, IdentifierDetails a)] @@ -535,13 +611,16 @@ data GhcVersion | GHC810 | GHC90 | GHC92 + | GHC94 deriving (Eq, Ord, Show) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion -#if MIN_VERSION_GLASGOW_HASKELL(9,2,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) +ghcVersion = GHC94 +#elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0) ghcVersion = GHC92 #elif MIN_VERSION_GLASGOW_HASKELL(9,0,0,0) ghcVersion = GHC90 diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 222be572e6..173759a5f8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -- TODO: remove {-# OPTIONS -Wno-dodgy-imports -Wno-unused-imports #-} @@ -61,7 +62,9 @@ module Development.IDE.GHC.Compat.Core ( pattern ExposePackage, parseDynamicFlagsCmdLine, parseDynamicFilePragma, +#if !MIN_VERSION_ghc(9,3,0) WarnReason(..), +#endif wWarningFlags, updOptLevel, -- slightly unsafe @@ -84,7 +87,9 @@ module Development.IDE.GHC.Compat.Core ( HscSource(..), WhereFrom(..), loadInterface, +#if !MIN_VERSION_ghc(9,3,0) SourceModified(..), +#endif loadModuleInterface, RecompileRequired(..), #if MIN_VERSION_ghc(8,10,0) @@ -188,12 +193,17 @@ module Development.IDE.GHC.Compat.Core ( hscInteractive, hscSimplify, hscTypecheckRename, - makeSimpleDetails, + Development.IDE.GHC.Compat.Core.makeSimpleDetails, -- * Typecheck utils Development.IDE.GHC.Compat.Core.tcSplitForAllTyVars, Development.IDE.GHC.Compat.Core.tcSplitForAllTyVarBinder_maybe, typecheckIface, - mkIfaceTc, + Development.IDE.GHC.Compat.Core.mkIfaceTc, + Development.IDE.GHC.Compat.Core.mkBootModDetailsTc, + Development.IDE.GHC.Compat.Core.initTidyOpts, + hscUpdateHPT, + driverNoStop, + tidyProgram, ImportedModsVal(..), importedByUser, GHC.TypecheckedSource, @@ -297,7 +307,6 @@ module Development.IDE.GHC.Compat.Core ( Warn(..), -- * ModLocation GHC.ModLocation, - pattern ModLocation, Module.ml_hs_file, Module.ml_obj_file, Module.ml_hi_file, @@ -349,7 +358,6 @@ module Development.IDE.GHC.Compat.Core ( module GHC.HsToCore.Expr, module GHC.HsToCore.Monad, - module GHC.Iface.Tidy, module GHC.Iface.Syntax, #if MIN_VERSION_ghc(9,2,0) @@ -430,7 +438,6 @@ module Development.IDE.GHC.Compat.Core ( module TcRnTypes, module TcRnDriver, module TcRnMonad, - module TidyPgm, module TyCon, module TysPrim, module TysWiredIn, @@ -466,11 +473,46 @@ module Development.IDE.GHC.Compat.Core ( module ExtractDocs, module Parser, module Lexer, +#endif +#if MIN_VERSION_ghc(9,3,0) + CompileReason(..), + hsc_type_env_vars, + hscUpdateHUG, hscUpdateHPT, hsc_HUG, + GhcMessage(..), + getKey, + module GHC.Driver.Env.KnotVars, + module GHC.Iface.Recomp, + module GHC.Linker.Types, + module GHC.Unit.Module.Graph, + module GHC.Types.Unique.Map, + module GHC.Utils.TmpFs, + module GHC.Utils.Panic, + module GHC.Unit.Finder.Types, + module GHC.Unit.Env, + module GHC.Driver.Phases, #endif ) where import qualified GHC +#if MIN_VERSION_ghc(9,3,0) +import GHC.Iface.Recomp (CompileReason(..)) +import GHC.Driver.Env.Types (hsc_type_env_vars) +import GHC.Driver.Env (hscUpdateHUG, hscUpdateHPT, hsc_HUG) +import GHC.Driver.Env.KnotVars +import GHC.Iface.Recomp +import GHC.Linker.Types +import GHC.Unit.Module.Graph +import GHC.Driver.Errors.Types +import GHC.Types.Unique.Map +import GHC.Types.Unique +import GHC.Utils.TmpFs +import GHC.Utils.Panic +import GHC.Unit.Finder.Types +import GHC.Unit.Env +import GHC.Driver.Phases +#endif + #if MIN_VERSION_ghc(9,0,0) import GHC.Builtin.Names hiding (Unique, printName) import GHC.Builtin.Types @@ -484,6 +526,10 @@ import qualified GHC.Core.DataCon as DataCon import GHC.Core.FamInstEnv hiding (pprFamInst) import GHC.Core.InstEnv import GHC.Types.Unique.FM +#if MIN_VERSION_ghc(9,3,0) +import qualified GHC.Driver.Config.Tidy as GHC +import qualified GHC.Data.Strict as Strict +#endif #if MIN_VERSION_ghc(9,2,0) import GHC.Data.Bag import GHC.Core.Multiplicity (scaledThing) @@ -505,13 +551,13 @@ import GHC.Core.Utils #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env #else -import GHC.Driver.Finder +import GHC.Driver.Finder hiding (mkHomeModLocation) import GHC.Driver.Types import GHC.Driver.Ways #endif import GHC.Driver.CmdLine (Warn (..)) import GHC.Driver.Hooks -import GHC.Driver.Main +import GHC.Driver.Main as GHC import GHC.Driver.Monad import GHC.Driver.Phases import GHC.Driver.Pipeline @@ -537,11 +583,11 @@ import GHC.HsToCore.Docs import GHC.HsToCore.Expr import GHC.HsToCore.Monad import GHC.Iface.Load -import GHC.Iface.Make (mkFullIface, mkIfaceTc, - mkPartialIface) +import GHC.Iface.Make (mkFullIface, mkPartialIface) +import GHC.Iface.Make as GHC import GHC.Iface.Recomp import GHC.Iface.Syntax -import GHC.Iface.Tidy +import GHC.Iface.Tidy as GHC import GHC.IfaceToCore import GHC.Parser import GHC.Parser.Header hiding (getImports) @@ -588,7 +634,10 @@ import qualified GHC.Types.Name.Reader as RdrName #if MIN_VERSION_ghc(9,2,0) import GHC.Types.Name.Set import GHC.Types.SourceFile (HscSource (..), - SourceModified (..)) +#if !MIN_VERSION_ghc(9,3,0) + SourceModified(..) +#endif + ) import GHC.Types.SourceText import GHC.Types.Target (Target (..), TargetId (..)) import GHC.Types.TyThing @@ -604,7 +653,7 @@ import GHC.Types.Unique.Supply import GHC.Types.Var (Var (varName), setTyVarUnique, setVarUnique) #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Finder +import GHC.Unit.Finder hiding (mkHomeModLocation) import GHC.Unit.Home.ModInfo #endif import GHC.Unit.Info (PackageName (..)) @@ -644,7 +693,7 @@ import ErrUtils hiding (logInfo, mkWarnMsg) import ExtractDocs import FamInst import FamInstEnv -import Finder +import Finder hiding (mkHomeModLocation) #if MIN_VERSION_ghc(8,10,0) import GHC.Hs hiding (HsLet, LetStmt) #endif @@ -652,7 +701,7 @@ import qualified GHCi import GhcMonad import HeaderInfo hiding (getImports) import Hooks -import HscMain +import HscMain as GHC import HscTypes #if !MIN_VERSION_ghc(8,10,0) -- Syntax imports @@ -674,7 +723,7 @@ import InstEnv import Lexer hiding (getSrcLoc) import qualified Linker import LoadIface -import MkIface +import MkIface as GHC import Module hiding (ModLocation (..), UnitId, addBootSuffixLocnOut, moduleUnitId) @@ -716,7 +765,7 @@ import TcRnMonad hiding (Applicative (..), IORef, import TcRnTypes import TcType hiding (mkVisFunTys) import qualified TcType -import TidyPgm +import TidyPgm as GHC import qualified TyCoRep import TyCon import Type hiding (mkVisFunTys) @@ -750,14 +799,48 @@ import System.FilePath #if MIN_VERSION_ghc(9,2,0) import Language.Haskell.Syntax hiding (FunDep) #endif +#if MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Env as GHCi +#endif + +import Data.Foldable (toList) + +#if MIN_VERSION_ghc(9,3,0) +import qualified GHC.Unit.Finder as GHC +import qualified GHC.Driver.Config.Finder as GHC +#elif MIN_VERSION_ghc(9,2,0) +import qualified GHC.Unit.Finder as GHC +#elif MIN_VERSION_ghc(9,0,0) +import qualified GHC.Driver.Finder as GHC +#else +import qualified Finder as GHC +#endif + + +mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation +#if MIN_VERSION_ghc(9,3,0) +mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f +#else +mkHomeModLocation = GHC.mkHomeModLocation +#endif + #if !MIN_VERSION_ghc(9,0,0) type BufSpan = () type BufPos = () #endif +#if MIN_VERSION_ghc(9,3,0) pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan -#if MIN_VERSION_ghc(9,0,0) +#else +pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan +#endif + +#if MIN_VERSION_ghc(9,3,0) +pattern RealSrcSpan x y <- SrcLoc.RealSrcSpan x ((\case Strict.Nothing -> Nothing; Strict.Just a -> Just a) -> y) where + RealSrcSpan x y = SrcLoc.RealSrcSpan x (case y of Nothing -> Strict.Nothing; Just a -> Strict.Just a) + +#elif MIN_VERSION_ghc(9,0,0) pattern RealSrcSpan x y = SrcLoc.RealSrcSpan x y #else pattern RealSrcSpan x y <- ((,Nothing) -> (SrcLoc.RealSrcSpan x, y)) where @@ -765,7 +848,11 @@ pattern RealSrcSpan x y <- ((,Nothing) -> (SrcLoc.RealSrcSpan x, y)) where #endif {-# COMPLETE RealSrcSpan, UnhelpfulSpan #-} +#if MIN_VERSION_ghc(9,3,0) +pattern RealSrcLoc :: SrcLoc.RealSrcLoc -> Strict.Maybe BufPos-> SrcLoc.SrcLoc +#else pattern RealSrcLoc :: SrcLoc.RealSrcLoc -> Maybe BufPos-> SrcLoc.SrcLoc +#endif #if MIN_VERSION_ghc(9,0,0) pattern RealSrcLoc x y = SrcLoc.RealSrcLoc x y #else @@ -936,14 +1023,6 @@ tcSplitForAllTyVarBinder_maybe = tcSplitForAllTy_maybe #endif -pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> GHC.ModLocation -#if MIN_VERSION_ghc(8,8,0) -pattern ModLocation a b c <- - GHC.ModLocation a b c _ where ModLocation a b c = GHC.ModLocation a b c "" -#else -pattern ModLocation a b c <- - GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c -#endif #if !MIN_VERSION_ghc(8,10,0) noExtField :: GHC.NoExt @@ -1015,6 +1094,7 @@ unload hsc_env linkables = #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) @@ -1023,6 +1103,7 @@ setOutputFile f d = d { outputFile = Just f #endif } +#endif isSubspanOfA :: LocatedAn la a -> LocatedAn lb b -> Bool #if MIN_VERSION_ghc(9,2,0) @@ -1072,7 +1153,7 @@ pattern GRE :: Name -> Parent -> Bool -> [ImportSpec] -> RdrName.GlobalRdrElt #if MIN_VERSION_ghc(9,2,0) pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE {gre_name = (greNamePrintableName -> gre_name) - ,gre_par, gre_lcl, gre_imp} + ,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)} #else pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} = RdrName.GRE{..} #endif @@ -1091,3 +1172,55 @@ pattern LetStmt xlet localBinds <- GHC.LetStmt xlet (SrcLoc.unLoc -> localBinds) rationalFromFractionalLit :: FractionalLit -> Rational rationalFromFractionalLit = fl_value #endif + +makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails +makeSimpleDetails hsc_env = + GHC.makeSimpleDetails +#if MIN_VERSION_ghc(9,3,0) + (hsc_logger hsc_env) +#else + hsc_env +#endif + +mkIfaceTc hsc_env sf details ms tcGblEnv = +#if MIN_VERSION_ghc(8,10,0) + GHC.mkIfaceTc hsc_env sf details +#if MIN_VERSION_ghc(9,3,0) + ms +#endif + tcGblEnv +#else + fst <$> GHC.mkIfaceTc hsc_env Nothing sf details tcGblEnv +#endif + +mkBootModDetailsTc :: HscEnv -> TcGblEnv -> IO ModDetails +mkBootModDetailsTc session = GHC.mkBootModDetailsTc +#if MIN_VERSION_ghc(9,3,0) + (hsc_logger session) +#else + session +#endif + +#if !MIN_VERSION_ghc(9,3,0) +type TidyOpts = HscEnv +#endif + +initTidyOpts :: HscEnv -> IO TidyOpts +initTidyOpts = +#if MIN_VERSION_ghc(9,3,0) + GHC.initTidyOpts +#else + pure +#endif + +driverNoStop = +#if MIN_VERSION_ghc(9,3,0) + NoStop +#else + StopLn +#endif + +#if !MIN_VERSION_ghc(9,3,0) +hscUpdateHPT :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv +hscUpdateHPT k session = session { hsc_HPT = k (hsc_HPT session) } +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 7662587898..0909e78366 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -3,7 +3,14 @@ -- | Compat module for the main Driver types, such as 'HscEnv', -- 'UnitEnv' and some DynFlags compat functions. module Development.IDE.GHC.Compat.Env ( - Env.HscEnv(hsc_FC, hsc_NC, hsc_IC, hsc_mod_graph, hsc_HPT, hsc_type_env_var), + Env.HscEnv(hsc_FC, hsc_NC, hsc_IC, hsc_mod_graph +#if MIN_VERSION_ghc(9,3,0) + , hsc_type_env_vars +#else + , hsc_type_env_var +#endif + ), + Env.hsc_HPT, InteractiveContext(..), setInteractivePrintName, setInteractiveDynFlags, @@ -51,7 +58,11 @@ import GHC (setInteractiveDynFlags) #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Backend as Backend +#if MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Env (HscEnv) +#else import GHC.Driver.Env (HscEnv, hsc_EPS) +#endif import qualified GHC.Driver.Env as Env import qualified GHC.Driver.Session as Session import GHC.Platform.Ways hiding (hostFullWays) @@ -80,6 +91,11 @@ import HscTypes as Env import Module #endif +#if MIN_VERSION_ghc(9,3,0) +hsc_EPS :: HscEnv -> UnitEnv +hsc_EPS = hsc_unit_env +#endif + #if MIN_VERSION_ghc(9,0,0) #if !MIN_VERSION_ghc(9,2,0) import qualified Data.Set as Set diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index 36ac26a446..e0b36a13a9 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -7,6 +7,9 @@ module Development.IDE.GHC.Compat.Iface ( ) where import GHC +#if MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Session (targetProfile) +#endif #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Iface.Load as Iface import GHC.Unit.Finder.Types (FindResult) @@ -24,7 +27,9 @@ import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Outputable writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () -#if MIN_VERSION_ghc(9,2,0) +#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 #elif MIN_VERSION_ghc(9,0,0) writeIfaceFile env = Iface.writeIface (hsc_dflags env) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index cb94532eb7..6e8c6dca52 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -24,6 +24,9 @@ import GHC.Utils.Logger as Logger import DynFlags import Outputable (queryQual) #endif +#if MIN_VERSION_ghc(9,3,0) +import GHC.Types.Error +#endif putLogHook :: Logger -> HscEnv -> HscEnv putLogHook logger env = @@ -41,6 +44,15 @@ pushLogHook f logger = 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 () + +-- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test. +logActionCompat :: LogActionCompat -> LogAction +logActionCompat logAction logFlags (MCDiagnostic severity wr) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify +logActionCompat logAction logFlags _cls loc = logAction logFlags Nothing Nothing loc alwaysQualify + +#else #if MIN_VERSION_ghc(9,0,0) type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnqualified -> SDoc -> IO () @@ -54,3 +66,4 @@ type LogActionCompat = DynFlags -> WarnReason -> Severity -> SrcSpan -> PrintUnq logActionCompat :: LogActionCompat -> LogAction logActionCompat logAction dynFlags wr severity loc style = logAction dynFlags wr severity loc (queryQual style) #endif +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 88bd76934e..084a48a04b 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -17,8 +17,12 @@ module Development.IDE.GHC.Compat.Outputable ( -- * Parser errors PsWarning, PsError, +#if MIN_VERSION_ghc(9,3,0) + DiagnosticReason(..), +#else pprWarning, pprError, +#endif -- * Error infrastructure DecoratedSDoc, MsgEnvelope, @@ -35,7 +39,11 @@ module Development.IDE.GHC.Compat.Outputable ( import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Driver.Session +#if !MIN_VERSION_ghc(9,3,0) import GHC.Parser.Errors +#else +import GHC.Parser.Errors.Types +#endif import qualified GHC.Parser.Errors.Ppr as Ppr import qualified GHC.Types.Error as Error import GHC.Types.Name.Ppr @@ -69,6 +77,11 @@ import Outputable as Out hiding import qualified Outputable as Out import SrcLoc #endif +#if MIN_VERSION_ghc(9,3,0) +import GHC.Utils.Logger +import GHC.Driver.Config.Diagnostic +import Data.Maybe +#endif -- | A compatible function to print `Outputable` instances -- without unique symbols. @@ -125,6 +138,7 @@ oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc oldFormatErrDoc = Err.formatErrDoc #endif +#if !MIN_VERSION_ghc(9,3,0) pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc pprWarning = #if MIN_VERSION_ghc(9,2,0) @@ -140,18 +154,27 @@ 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) +pprNoLocMsgEnvelope :: MsgEnvelope DecoratedSDoc -> SDoc +#else pprNoLocMsgEnvelope :: Error.RenderableDiagnostic e => MsgEnvelope e -> SDoc +#endif pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e , errMsgContext = unqual }) = sdocWithContext $ \ctx -> withErrStyle unqual $ +#if MIN_VERSION_ghc(9,3,0) + (formatBulleted ctx $ e) +#else (formatBulleted ctx $ Error.renderDiagnostic e) +#endif #else Out.showSDoc dflags @@ -178,13 +201,18 @@ mkPrintUnqualifiedDefault env = HscTypes.mkPrintUnqualified (hsc_dflags env) #endif -mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc -mkWarnMsg = +#if MIN_VERSION_ghc(9,3,0) +mkWarnMsg :: DynFlags -> Maybe DiagnosticReason -> b -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc +mkWarnMsg df reason _logFlags l st doc = fmap diagnosticMessage $ mkMsgEnvelope (initDiagOpts df) l st (mkPlainDiagnostic (fromMaybe WarningWithoutFlag reason) [] doc) +#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 defaultUserStyle :: PprStyle #if MIN_VERSION_ghc(9,0,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 91a925cb0b..391ca9fb82 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -62,7 +62,11 @@ import GHC (Anchor (anchor), pm_mod_summary, pm_parsed_source) import qualified GHC +#if MIN_VERSION_ghc(9,3,0) +import qualified GHC.Driver.Config.Parser as Config +#else import qualified GHC.Driver.Config as Config +#endif import GHC.Hs (LEpaComment, hpm_module, hpm_src_files) import GHC.Parser.Lexer hiding (initParserState) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 6fd5834f63..12cf035483 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -24,6 +24,11 @@ import qualified GHC.Driver.Env as Env import GHC.Driver.Plugins (Plugin (..), PluginWithArgs (..), StaticPlugin (..), +#if MIN_VERSION_ghc(9,3,0) + staticPlugins, + ParsedResult(..), + PsMessages(..), +#endif defaultPlugin, withPlugins) import qualified GHC.Runtime.Loader as Loader #elif MIN_VERSION_ghc(8,8,0) @@ -42,15 +47,25 @@ applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.Api applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do -- Apply parsedResultAction of plugins let applyPluginAction p opts = parsedResultAction p opts ms +#if MIN_VERSION_ghc(9,3,0) + fmap (hpm_module . parsedResultModule) $ +#else fmap hpm_module $ +#endif runHsc env $ withPlugins -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,3,0) + (Env.hsc_plugins env) +#elif MIN_VERSION_ghc(9,2,0) env #else dflags #endif applyPluginAction +#if MIN_VERSION_ghc(9,3,0) + (ParsedResult (HsParsedModule parsed [] hpm_annotations) (PsMessages mempty mempty)) +#else (HsParsedModule parsed [] hpm_annotations) +#endif initializePlugins :: HscEnv -> IO HscEnv initializePlugins env = do @@ -64,7 +79,9 @@ initializePlugins env = do #if MIN_VERSION_ghc(8,8,0) hsc_static_plugins :: HscEnv -> [StaticPlugin] -#if MIN_VERSION_ghc(9,2,0) +#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 diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index 9077745aef..c4a56bec5f 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -5,7 +5,10 @@ module Development.IDE.GHC.Compat.Units ( -- * UnitState UnitState, +#if MIN_VERSION_ghc(9,3,0) initUnits, +#endif + oldInitUnits, unitState, getUnitName, explicitUnits, @@ -39,7 +42,7 @@ module Development.IDE.GHC.Compat.Units ( installedModule, -- * Module toUnitId, - moduleUnitId, + Development.IDE.GHC.Compat.Units.moduleUnitId, moduleUnit, -- * ExternalPackageState ExternalPackageState(..), @@ -49,10 +52,18 @@ module Development.IDE.GHC.Compat.Units ( showSDocForUser', ) where +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map +import Control.Monad +#if MIN_VERSION_ghc(9,3,0) +import GHC.Unit.Home.ModInfo +#endif #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Data.ShortText as ST +#if !MIN_VERSION_ghc(9,3,0) import GHC.Driver.Env (hsc_unit_dbs) +#endif import GHC.Driver.Ppr import GHC.Unit.Env import GHC.Unit.External @@ -128,37 +139,69 @@ unitState = DynFlags.unitState . hsc_dflags unitState = DynFlags.pkgState . hsc_dflags #endif -initUnits :: HscEnv -> IO HscEnv -initUnits env = do -#if MIN_VERSION_ghc(9,2,0) - let dflags1 = hsc_dflags env - -- Copied from GHC.setSessionDynFlags - let cached_unit_dbs = hsc_unit_dbs env - (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags1 cached_unit_dbs - - dflags <- DynFlags.updatePlatformConstants dflags1 mconstants - - +#if MIN_VERSION_ghc(9,3,0) +createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> HomeUnitGraph +createUnitEnvFromFlags unitDflags = + let + newInternalUnitEnv dflags = mkHomeUnitEnv dflags emptyHomePackageTable Nothing + unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags + in + unitEnv_new (Map.fromList (NE.toList (unitEnvList))) + +initUnits :: [DynFlags] -> HscEnv -> IO HscEnv +initUnits unitDflags env = do + let dflags0 = hsc_dflags env + -- additionally, set checked dflags so we don't lose fixes + let initial_home_graph = createUnitEnvFromFlags (dflags0 NE.:| unitDflags) + home_units = unitEnv_keys initial_home_graph + home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do + let cached_unit_dbs = homeUnitEnv_unit_dbs homeUnitEnv + dflags = homeUnitEnv_dflags homeUnitEnv + old_hpt = homeUnitEnv_hpt homeUnitEnv + + (dbs,unit_state,home_unit,mconstants) <- State.initUnits (hsc_logger env) dflags cached_unit_dbs home_units + + updated_dflags <- DynFlags.updatePlatformConstants dflags mconstants + pure HomeUnitEnv + { homeUnitEnv_units = unit_state + , homeUnitEnv_unit_dbs = Just dbs + , homeUnitEnv_dflags = updated_dflags + , homeUnitEnv_hpt = old_hpt + , homeUnitEnv_home_unit = Just home_unit + } + + let dflags1 = homeUnitEnv_dflags $ unitEnv_lookup (homeUnitId_ dflags0) home_unit_graph let unit_env = UnitEnv - { ue_platform = targetPlatform dflags - , ue_namever = DynFlags.ghcNameVersion dflags - , ue_home_unit = home_unit - , ue_units = unit_state + { ue_platform = targetPlatform dflags1 + , ue_namever = GHC.ghcNameVersion dflags1 + , ue_home_unit_graph = home_unit_graph + , ue_current_unit = homeUnitId_ dflags0 + , ue_eps = ue_eps (hsc_unit_env env) } - pure $ hscSetFlags dflags $ hscSetUnitEnv unit_env env - { hsc_unit_dbs = Just dbs - } + pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env +#endif + +-- | oldInitUnits only needs to modify DynFlags for GHC <9.2 +-- 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 #elif MIN_VERSION_ghc(9,0,0) - newFlags <- State.initUnits $ hsc_dflags env - pure $ hscSetFlags newFlags env +oldInitUnits dflags = do + newFlags <- State.initUnits dflags + pure newFlags #else - newFlags <- fmap fst . Packages.initPackages $ hsc_dflags env - pure $ hscSetFlags newFlags env +oldInitUnits dflags = do + newFlags <- fmap fst $ Packages.initPackages dflags + pure newFlags #endif explicitUnits :: UnitState -> [Unit] explicitUnits ue = -#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,3,0) + map fst $ State.explicitUnits ue +#elif MIN_VERSION_ghc(9,0,0) State.explicitUnits ue #else Packages.explicitPackages ue @@ -180,7 +223,15 @@ getUnitName env i = packageName <$> Packages.lookupPackage (hsc_dflags env) (definiteUnitId (defUnitId i)) #endif -lookupModuleWithSuggestions :: HscEnv -> ModuleName -> Maybe FastString -> LookupResult +lookupModuleWithSuggestions + :: HscEnv + -> ModuleName +#if MIN_VERSION_ghc(9,3,0) + -> GHC.PkgQual +#else + -> Maybe FastString +#endif + -> LookupResult lookupModuleWithSuggestions env modname mpkg = #if MIN_VERSION_ghc(9,0,0) State.lookupModuleWithSuggestions (unitState env) modname mpkg diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index 17799ea31d..7c521e88e8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -24,7 +24,9 @@ module Development.IDE.GHC.Compat.Util ( LBooleanFormula, BooleanFormula(..), -- * OverridingBool +#if !MIN_VERSION_ghc(9,3,0) OverridingBool(..), +#endif -- * Maybes MaybeErr(..), orElse, diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index 74a72148c8..89c527e404 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 module Development.IDE.GHC.Error @@ -121,13 +122,17 @@ p `isInsideSrcSpan` r = case srcSpanToRange r of -- | Convert a GHC severity to a DAML compiler Severity. Severities below -- "Warning" level are dropped (returning Nothing). toDSeverity :: GHC.Severity -> Maybe D.DiagnosticSeverity +#if !MIN_VERSION_ghc(9,3,0) toDSeverity SevOutput = Nothing toDSeverity SevInteractive = Nothing toDSeverity SevDump = Nothing toDSeverity SevInfo = Just DsInfo +toDSeverity SevFatal = Just DsError +#else +toDSeverity SevIgnore = Nothing +#endif toDSeverity SevWarning = Just DsWarning toDSeverity SevError = Just DsError -toDSeverity SevFatal = Just DsError -- | Produce a bag of GHC-style errors (@ErrorMessages@) from the given @@ -167,7 +172,11 @@ catchSrcErrors dflags fromWhere ghcM = do Right <$> ghcM where ghcExceptionToDiagnostics dflags = return . Left . diagFromGhcException fromWhere dflags - sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs fromWhere dflags . srcErrorMessages + sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs fromWhere dflags +#if MIN_VERSION_ghc(9,3,0) + . fmap (fmap Compat.diagnosticMessage) . Compat.getMessages +#endif + . srcErrorMessages diagFromGhcException :: T.Text -> DynFlags -> GhcException -> [FileDiagnostic] diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 3d506fbe4a..4e7ff4463e 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -43,6 +43,9 @@ import GHC.ByteCode.Types #else import ByteCodeTypes #endif +#if MIN_VERSION_ghc(9,3,0) +import GHC.Types.PkgQual +#endif -- Orphan instances for types from the GHC API. instance Show CoreModule where show = unpack . printOutputable @@ -85,7 +88,9 @@ instance NFData SB.StringBuffer where rnf = rwhnf instance Show Module where show = moduleNameString . moduleName +#if !MIN_VERSION_ghc(9,3,0) instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable +#endif instance (NFData l, NFData e) => NFData (GenLocated l e) where rnf (L l e) = rnf l `seq` rnf e @@ -126,10 +131,12 @@ instance Show HieFile where instance NFData HieFile where rnf = rwhnf +#if !MIN_VERSION_ghc(9,3,0) deriving instance Eq SourceModified deriving instance Show SourceModified instance NFData SourceModified where rnf = rwhnf +#endif #if !MIN_VERSION_ghc(9,2,0) instance Show ModuleName where @@ -207,3 +214,13 @@ instance Show HomeModInfo where show = show . mi_module . hm_iface instance NFData HomeModInfo where rnf (HomeModInfo iface dets link) = rwhnf iface `seq` rnf dets `seq` rnf link + +#if MIN_VERSION_ghc(9,3,0) +instance NFData PkgQual where + rnf NoPkgQual = () + rnf (ThisPkg uid) = rnf uid + rnf (OtherPkg uid) = rnf uid + +instance NFData UnitId where + rnf = rwhnf +#endif diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 4776626aa6..8dd99b8bde 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -32,7 +32,7 @@ module Development.IDE.GHC.Util( #if MIN_VERSION_ghc(9,2,0) import GHC.Data.FastString import GHC.Data.StringBuffer -import GHC.Driver.Env +import GHC.Driver.Env hiding (hscSetFlags) import GHC.Driver.Monad import GHC.Driver.Session hiding (ExposePackage) import GHC.Parser.Lexer diff --git a/ghcide/src/Development/IDE/GHC/Warnings.hs b/ghcide/src/Development/IDE/GHC/Warnings.hs index 720828fef3..fa30373ce8 100644 --- a/ghcide/src/Development/IDE/GHC/Warnings.hs +++ b/ghcide/src/Development/IDE/GHC/Warnings.hs @@ -1,6 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE CPP #-} module Development.IDE.GHC.Warnings(withWarnings) where @@ -23,14 +24,18 @@ import Language.LSP.Types (type (|?) (..)) -- https://github.com/ghc/ghc/blob/5f1d949ab9e09b8d95319633854b7959df06eb58/compiler/main/GHC.hs#L623-L640 -- which basically says that log_action is taken from the ModSummary when GHC feels like it. -- The given argument lets you refresh a ModSummary log_action +#if MIN_VERSION_ghc(9,3,0) +withWarnings :: T.Text -> ((HscEnv -> HscEnv) -> IO a) -> IO ([(Maybe DiagnosticReason, FileDiagnostic)], a) +#else withWarnings :: T.Text -> ((HscEnv -> HscEnv) -> IO a) -> IO ([(WarnReason, FileDiagnostic)], a) +#endif withWarnings diagSource action = do warnings <- newVar [] - let newAction :: LogActionCompat - newAction dynFlags wr _ loc prUnqual msg = do - let wr_d = map ((wr,) . third3 (attachReason wr)) $ diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags loc prUnqual msg + let newAction :: DynFlags -> LogActionCompat + newAction dynFlags logFlags wr _ loc prUnqual msg = do + let wr_d = map ((wr,) . third3 (attachReason wr)) $ diagFromErrMsg diagSource dynFlags $ mkWarnMsg dynFlags wr logFlags loc prUnqual msg modifyVar_ warnings $ return . (wr_d:) - newLogger env = pushLogHook (const (logActionCompat newAction)) (hsc_logger env) + newLogger env = pushLogHook (const (logActionCompat (newAction (hsc_dflags env)))) (hsc_logger env) res <- action $ \env -> putLogHook (newLogger env) env warns <- readVar warnings return (reverse $ concat warns, res) @@ -38,6 +43,15 @@ withWarnings diagSource action = do third3 :: (c -> d) -> (a, b, c) -> (a, b, d) third3 f (a, b, c) = (a, b, f c) +#if MIN_VERSION_ghc(9,3,0) +attachReason :: Maybe DiagnosticReason -> Diagnostic -> Diagnostic +attachReason Nothing d = d +attachReason (Just wr) d = d{_code = InR <$> showReason wr} + where + showReason = \case + WarningWithFlag flag -> showFlag flag + _ -> Nothing +#else attachReason :: WarnReason -> Diagnostic -> Diagnostic attachReason wr d = d{_code = InR <$> showReason wr} where @@ -45,6 +59,7 @@ attachReason wr d = d{_code = InR <$> showReason wr} NoReason -> Nothing Reason flag -> showFlag flag ErrReason flag -> showFlag =<< flag +#endif showFlag :: WarningFlag -> Maybe T.Text showFlag flag = ("-W" <>) . T.pack . flagSpecName <$> find ((== flag) . flagSpecFlag) wWarningFlags diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 101e21fe32..2cc08b9f57 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -27,6 +27,9 @@ import Control.Monad.IO.Class import Data.List (isSuffixOf) import Data.Maybe import System.FilePath +#if MIN_VERSION_ghc(9,3,0) +import GHC.Types.PkgQual +#endif data Import = FileImport !ArtifactsLocation @@ -37,11 +40,11 @@ data ArtifactsLocation = ArtifactsLocation { artifactFilePath :: !NormalizedFilePath , artifactModLocation :: !(Maybe ModLocation) , artifactIsSource :: !Bool -- ^ True if a module is a source input - } - deriving (Show) + , artifactModule :: !(Maybe Module) + } deriving Show instance NFData ArtifactsLocation where - rnf ArtifactsLocation{..} = rnf artifactFilePath `seq` rwhnf artifactModLocation `seq` rnf artifactIsSource + rnf ArtifactsLocation{..} = rnf artifactFilePath `seq` rwhnf artifactModLocation `seq` rnf artifactIsSource `seq` rnf artifactModule isBootLocation :: ArtifactsLocation -> Bool isBootLocation = not . artifactIsSource @@ -51,28 +54,30 @@ instance NFData Import where rnf PackageImport = () modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation -modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source +modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source mod where isSource HsSrcFile = True isSource _ = False source = case ms of Nothing -> "-boot" `isSuffixOf` fromNormalizedFilePath nfp Just ms -> isSource (ms_hsc_src ms) + mod = ms_mod <$> ms -- | locate a module in the file system. Where we go from *daml to Haskell locateModuleFile :: MonadIO m - => [[FilePath]] + => [(UnitId, [FilePath])] -> [String] -> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)) -> Bool -> ModuleName - -> m (Maybe NormalizedFilePath) + -> m (Maybe (UnitId, NormalizedFilePath)) locateModuleFile import_dirss exts targetFor isSource modName = do let candidates import_dirs = [ toNormalizedFilePath' (prefix moduleNameSlashes modName <.> maybeBoot ext) | prefix <- import_dirs , ext <- exts] - firstJustM (targetFor modName) (concatMap candidates import_dirss) + firstJustM go (concat [map (uid,) (candidates dirs) | (uid, dirs) <- import_dirss]) where + go (uid, candidate) = fmap ((uid,) <$>) $ targetFor modName candidate maybeBoot ext | isSource = ext ++ "-boot" | otherwise = ext @@ -81,8 +86,13 @@ locateModuleFile import_dirss exts targetFor isSource modName = do -- It only returns Just for unit-ids which are possible to import into the -- current module. In particular, it will return Nothing for 'main' components -- as they can never be imported into another package. -mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, [FilePath]) -mkImportDirs env (i, flags) = (, importPaths flags) <$> getUnitName env i +#if MIN_VERSION_ghc(9,3,0) +mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (UnitId, [FilePath]) +mkImportDirs env (i, flags) = Just (i, importPaths flags) +#else +mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, (UnitId, [FilePath])) +mkImportDirs env (i, flags) = (, (i, importPaths flags)) <$> getUnitName env i +#endif -- | locate a module in either the file system or the package database. Where we go from *daml to -- Haskell @@ -93,43 +103,72 @@ locateModule -> [String] -- ^ File extensions -> (ModuleName -> NormalizedFilePath -> m (Maybe NormalizedFilePath)) -- ^ does file exist predicate -> Located ModuleName -- ^ Module name +#if MIN_VERSION_ghc(9,3,0) + -> PkgQual -- ^ Package name +#else -> Maybe FastString -- ^ Package name +#endif -> Bool -- ^ Is boot module -> m (Either [FileDiagnostic] Import) locateModule env comp_info exts targetFor modName mbPkgName isSource = do case mbPkgName of -- "this" means that we should only look in the current package +#if MIN_VERSION_ghc(9,3,0) + ThisPkg _ -> do +#else Just "this" -> do - lookupLocal [importPaths dflags] +#endif + lookupLocal (homeUnitId_ dflags) (importPaths dflags) -- if a package name is given we only go look for a package +#if MIN_VERSION_ghc(9,3,0) + OtherPkg uid + | Just dirs <- lookup uid import_paths +#else Just pkgName - | Just dirs <- lookup (PackageName pkgName) import_paths - -> lookupLocal [dirs] + | Just (uid, dirs) <- lookup (PackageName pkgName) import_paths +#endif + -> lookupLocal uid dirs | otherwise -> lookupInPackageDB env +#if MIN_VERSION_ghc(9,3,0) + NoPkgQual -> do +#else Nothing -> do +#endif -- first try to find the module as a file. If we can't find it try to find it in the package -- database. -- Here the importPaths for the current modules are added to the front of the import paths from the other components. -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in -- each component will end up being found in the wrong place and cause a multi-cradle match failure. - mbFile <- locateModuleFile (importPaths dflags : map snd import_paths) exts targetFor isSource $ unLoc modName + let import_paths' = +#if MIN_VERSION_ghc(9,3,0) + import_paths +#else + map snd import_paths +#endif + + mbFile <- locateModuleFile ((homeUnitId_ dflags, importPaths dflags) : import_paths') exts targetFor isSource $ unLoc modName case mbFile of Nothing -> lookupInPackageDB env - Just file -> toModLocation file + Just (uid, file) -> toModLocation uid file where dflags = hsc_dflags env import_paths = mapMaybe (mkImportDirs env) comp_info - toModLocation file = liftIO $ do + toModLocation uid file = liftIO $ do loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file) - return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource) - - lookupLocal dirs = do - mbFile <- locateModuleFile dirs exts targetFor isSource $ unLoc modName +#if MIN_VERSION_ghc(9,0,0) + let mod = mkModule (RealUnit $ Definite uid) (unLoc modName) -- TODO support backpack holes +#else + let mod = mkModule uid (unLoc modName) +#endif + return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource) (Just mod) + + lookupLocal uid dirs = do + mbFile <- locateModuleFile [(uid, dirs)] exts targetFor isSource $ unLoc modName case mbFile of Nothing -> return $ Left $ notFoundErr env modName $ LookupNotFound [] - Just file -> toModLocation file + Just (uid, file) -> toModLocation uid file - lookupInPackageDB env = + lookupInPackageDB env = do case Compat.lookupModuleWithSuggestions env (unLoc modName) mbPkgName of LookupFound _m _pkgConfig -> return $ Right PackageImport reason -> return $ Left $ notFoundErr env modName reason diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 0a45688fef..2ad518d588 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -11,7 +11,7 @@ where import Control.Monad.IO.Class import Data.Functor -import Data.Generics +import Data.Generics hiding (Prefix) import Data.Maybe import qualified Data.Text as T import Development.IDE.Core.Rules @@ -122,8 +122,16 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam } where cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol +#if MIN_VERSION_ghc(9,3,0) + cvtFld (L (locA -> RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol) +#else cvtFld (L (RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol) +#endif +#if MIN_VERSION_ghc(9,3,0) + { _name = printOutputable (unLoc (foLabel n)) +#else { _name = printOutputable (unLoc (rdrNameFieldOcc n)) +#endif , _kind = SkField } cvtFld _ = Nothing @@ -161,8 +169,13 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ DataFamInstD { dfi documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) #endif = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = printOutputable (unLoc feqn_tycon) <> " " <> T.unwords + { _name = +#if MIN_VERSION_ghc(9,3,0) + printOutputable $ pprHsArgsApp (unLoc feqn_tycon) Prefix (feqn_pats) +#else + printOutputable (unLoc feqn_tycon) <> " " <> T.unwords (map printOutputable feqn_pats) +#endif , _kind = SkInterface } #if MIN_VERSION_ghc(9,2,0) @@ -171,8 +184,13 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ TyFamInstD { tfid_ documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) #endif = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = printOutputable (unLoc feqn_tycon) <> " " <> T.unwords + { _name = +#if MIN_VERSION_ghc(9,3,0) + printOutputable $ pprHsArgsApp (unLoc feqn_tycon) Prefix (feqn_pats) +#else + printOutputable (unLoc feqn_tycon) <> " " <> T.unwords (map printOutputable feqn_pats) +#endif , _kind = SkInterface } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (DerivD _ DerivDecl { deriv_type })) = @@ -217,7 +235,7 @@ documentSymbolForImportSummary importSymbols = let -- safe because if we have no ranges then we don't take this branch mergeRanges xs = Range (minimum $ map _start xs) (maximum $ map _end xs) - importRange = mergeRanges $ map (_range :: DocumentSymbol -> Range) importSymbols + importRange = mergeRanges $ map (\DocumentSymbol{_range} -> _range) importSymbols in Just (defDocumentSymbol (rangeToRealSrcSpan "" importRange)) { _name = "imports" @@ -293,7 +311,11 @@ hsConDeclsBinders cons get_flds_gadt :: HsConDeclGADTDetails GhcPs -> ([LFieldOcc GhcPs]) +#if MIN_VERSION_ghc(9,3,0) + get_flds_gadt (RecConGADT flds _) = get_flds (reLoc flds) +#else get_flds_gadt (RecConGADT flds) = get_flds (reLoc flds) +#endif get_flds_gadt _ = [] get_flds :: Located [LConDeclField GhcPs] diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index c703ec7a66..415743d082 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -526,7 +526,11 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result -- -- is encoded as @[[arg1, arg2], [arg3], [arg4]]@ -- Hence, we must concat nested arguments into one to get all the fields. +#if MIN_VERSION_ghc(9,3,0) + = map (foLabel . unLoc) cd_fld_names +#else = map (rdrNameFieldOcc . unLoc) cd_fld_names +#endif -- XConDeclField extract _ = [] findRecordCompl _ _ _ _ = [] diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index dd241e7fc9..701074b3ac 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -50,7 +50,11 @@ safeTyThingId _ = Nothing -- Possible documentation for an element in the code data SpanDoc +#if MIN_VERSION_ghc(9,3,0) + = SpanDocString [HsDocString] SpanDocUris +#else = SpanDocString HsDocString SpanDocUris +#endif | SpanDocText [T.Text] SpanDocUris deriving stock (Eq, Show, Generic) deriving anyclass NFData @@ -86,7 +90,12 @@ emptySpanDoc = SpanDocText [] (SpanDocUris Nothing Nothing) spanDocToMarkdown :: SpanDoc -> [T.Text] spanDocToMarkdown = \case (SpanDocString docs uris) -> - let doc = T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $ unpackHDS docs + let doc = T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $ +#if MIN_VERSION_ghc(9,3,0) + renderHsDocStrings docs +#else + unpackHDS docs +#endif in go [doc] uris (SpanDocText txt uris) -> go txt uris where diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index c5a9190652..08ad918bc4 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -33,6 +33,9 @@ import System.Directory import System.FilePath import Language.LSP.Types (filePathToUri, getUri) +#if MIN_VERSION_ghc(9,3,0) +import GHC.Types.Unique.Map +#endif mkDocMap :: HscEnv @@ -41,12 +44,18 @@ mkDocMap -> IO DocAndKindMap mkDocMap env rm this_mod = do -#if MIN_VERSION_ghc(9,2,0) +#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 #endif +#if MIN_VERSION_ghc(9,3,0) + d <- foldrM getDocs (fmap (\(_, x) -> (map hsDocString x) `SpanDocString` SpanDocUris Nothing Nothing) this_docs) names +#else d <- foldrM getDocs (mkNameEnv $ M.toList $ fmap (`SpanDocString` SpanDocUris Nothing Nothing) this_docs) names +#endif k <- foldrM getType (tcg_type_env this_mod) names pure $ DKMap d k where @@ -69,7 +78,7 @@ lookupKind env mod = fmap (fromRight Nothing) . catchSrcErrors (hsc_dflags env) "span" . lookupName env mod getDocumentationTryGhc :: HscEnv -> Module -> Name -> IO SpanDoc -getDocumentationTryGhc env mod n = head <$> getDocumentationsTryGhc env mod [n] +getDocumentationTryGhc env mod n = fromMaybe emptySpanDoc . listToMaybe <$> getDocumentationsTryGhc env mod [n] getDocumentationsTryGhc :: HscEnv -> Module -> [Name] -> IO [SpanDoc] getDocumentationsTryGhc env mod names = do @@ -78,7 +87,11 @@ getDocumentationsTryGhc env mod names = do Left _ -> return [] Right res -> zipWithM unwrap res names where +#if MIN_VERSION_ghc(9,3,0) + unwrap (Right (Just docs, _)) n = SpanDocString (map hsDocString docs) <$> getUris n +#else unwrap (Right (Just docs, _)) n = SpanDocString docs <$> getUris n +#endif unwrap _ n = mkSpanDocText n mkSpanDocText name = diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 12fce8ce67..523a7474f8 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -259,11 +259,11 @@ initializeResponseTests = withResource acquire release tests where _documentOnTypeFormattingProvider Nothing , chk "NO renaming" _renameProvider (Just $ InL False) , chk "NO doc link" _documentLinkProvider Nothing - , chk "NO color" _colorProvider (Just $ InL False) + , chk "NO color" (^. L.colorProvider) (Just $ InL False) , chk "NO folding range" _foldingRangeProvider (Just $ InL False) , che " execute command" _executeCommandProvider [typeLensCommandId, blockCommandId] - , chk " workspace" _workspace (Just $ WorkspaceServerCapabilities (Just WorkspaceFoldersServerCapabilities{_supported = Just True, _changeNotifications = Just ( InR True )})) - , chk "NO experimental" _experimental Nothing + , chk " workspace" (^. L.workspace) (Just $ WorkspaceServerCapabilities (Just WorkspaceFoldersServerCapabilities{_supported = Just True, _changeNotifications = Just ( InR True )})) + , chk "NO experimental" (^. L.experimental) Nothing ] where tds = Just (InL (TextDocumentSyncOptions @@ -564,13 +564,20 @@ diagnosticTests = testGroup "diagnostics" , "useBase = BaseList.map" , "wrong1 = ThisList.map" , "wrong2 = BaseList.x" + , "main = pure ()" ] _ <- createDoc "Data/List.hs" "haskell" thisDataListContent _ <- createDoc "Main.hs" "haskell" mainContent expectDiagnostics [ ( "Main.hs" - , [(DsError, (6, 9), "Not in scope: \8216ThisList.map\8217") - ,(DsError, (7, 9), "Not in scope: \8216BaseList.x\8217") + , [(DsError, (6, 9), + if ghcVersion >= GHC94 + then "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 + else "Not in scope: \8216ThisList.map\8217") + ,(DsError, (7, 9), + if ghcVersion >= GHC94 + then "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130 + else "Not in scope: \8216BaseList.x\8217") ] ) ] @@ -588,7 +595,7 @@ diagnosticTests = testGroup "diagnostics" -- where appropriate. The warning should use an unqualified name 'Ord', not -- sometihng like 'GHC.Classes.Ord'. The choice of redundant-constraints to -- test this is fairly arbitrary. - , [(DsWarning, (2, 0), "Redundant constraint: Ord a") + , [(DsWarning, (2, if ghcVersion >= GHC94 then 7 else 0), "Redundant constraint: Ord a") ] ) ] @@ -621,7 +628,7 @@ diagnosticTests = testGroup "diagnostics" -- Check that if we put a lower-case drive in for A.A -- the diagnostics for A.B will also be lower-case. liftIO $ fileUri @?= uriB - let msg = _message (head (toList diags) :: Diagnostic) + let msg = head (toList diags) ^. L.message liftIO $ unless ("redundant" `T.isInfixOf` msg) $ assertFailure ("Expected redundant import but got " <> T.unpack msg) closeDoc a @@ -1096,7 +1103,7 @@ findDefinitionAndHoverTests = let holeL65 = Position 65 8 ; hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]] cccL17 = Position 17 16 ; docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"] imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3] - reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14] + reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 (if ghcVersion >= GHC94 then 5 else 0) 3 (if ghcVersion >= GHC94 then 8 else 14)] thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]] in mkFindTests @@ -1180,7 +1187,7 @@ checkFileCompiles fp diag = pluginSimpleTests :: TestTree pluginSimpleTests = ignoreInWindowsForGHC88And810 $ - ignoreForGHC92 "blocked on ghc-typelits-natnormalise" $ + ignoreForGHC92Plus "blocked on ghc-typelits-natnormalise" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" liftIO $ writeFile (dir"hie.yaml") @@ -1195,7 +1202,7 @@ pluginSimpleTests = pluginParsedResultTests :: TestTree pluginParsedResultTests = ignoreInWindowsForGHC88And810 $ - ignoreForGHC92 "No need for this plugin anymore!" $ + ignoreForGHC92Plus "No need for this plugin anymore!" $ testSessionWithExtraFiles "plugin-recorddot" "parsedResultAction plugin" $ \dir -> do _ <- openDoc (dir "RecordDot.hs") "haskell" expectNoMoreDiagnostics 2 @@ -1778,10 +1785,10 @@ packageCompletionTests = , _label == "fromList" ] liftIO $ take 3 (sort compls') @?= - map ("Defined in "<>) + map ("Defined in "<>) ( [ "'Data.List.NonEmpty" , "'GHC.Exts" - ] + ] ++ if ghcVersion >= GHC94 then [ "'GHC.IsList" ] else []) , testSessionWait "Map" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines @@ -1994,10 +2001,10 @@ completionDocTests = test doc (Position 1 7) "id" (Just $ T.length expected) [expected] ] where - brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92]) "Completion doc doesn't support ghc9" - brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2" + brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9" + brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92, GHC94]) "Extern doc doesn't support Windows for ghc9.2" -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903 - brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92]) "Extern doc doesn't support MacOS for ghc9" + brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9" test doc pos label mn expected = do _ <- waitForDiagnostics compls <- getCompletions doc pos @@ -2040,7 +2047,7 @@ highlightTests = testGroup "highlight" , DocumentHighlight (R 6 10 6 13) (Just HkRead) , DocumentHighlight (R 7 12 7 15) (Just HkRead) ] - , knownBrokenForGhcVersions [GHC90, GHC92] "Ghc9 highlights the constructor and not just this field" $ + , knownBrokenForGhcVersions [GHC90, GHC92, GHC94] "Ghc9 highlights the constructor and not just this field" $ testSessionWait "record" $ do doc <- createDoc "A.hs" "haskell" recsource _ <- waitForDiagnostics @@ -2048,8 +2055,8 @@ highlightTests = testGroup "highlight" liftIO $ highlights @?= List -- Span is just the .. on 8.10, but Rec{..} before [ if ghcVersion >= GHC810 - then DocumentHighlight (R 4 8 4 10) (Just HkWrite) - else DocumentHighlight (R 4 4 4 11) (Just HkWrite) + then DocumentHighlight (R 4 8 4 10) (Just HkWrite) + else DocumentHighlight (R 4 4 4 11) (Just HkWrite) , DocumentHighlight (R 4 14 4 20) (Just HkRead) ] highlights <- getHighlights doc (Position 3 17) @@ -2270,8 +2277,8 @@ ignoreInWindowsForGHC88And810 :: TestTree -> TestTree ignoreInWindowsForGHC88And810 = ignoreFor (BrokenSpecific Windows [GHC88, GHC810]) "tests are unreliable in windows for ghc 8.8 and 8.10" -ignoreForGHC92 :: String -> TestTree -> TestTree -ignoreForGHC92 = ignoreFor (BrokenForGHC [GHC92]) +ignoreForGHC92Plus :: String -> TestTree -> TestTree +ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94]) ignoreInWindowsForGHC88 :: TestTree -> TestTree ignoreInWindowsForGHC88 = diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 6ea7ad476e..bfdd321674 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -239,12 +239,12 @@ flag dynamic manual: True common class - if flag(class) + if flag(class) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-class-plugin ^>= 1.0 cpp-options: -Dhls_class common callHierarchy - if flag(callHierarchy) + if flag(callHierarchy) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-call-hierarchy-plugin ^>= 1.0 cpp-options: -Dhls_callHierarchy @@ -254,22 +254,22 @@ common haddockComments cpp-options: -Dhls_haddockComments common eval - if flag(eval) + if flag(eval) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-eval-plugin ^>= 1.2 cpp-options: -Dhls_eval common importLens - if flag(importLens) + if flag(importLens) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-explicit-imports-plugin ^>= 1.1 cpp-options: -Dhls_importLens common refineImports - if flag(refineImports) + if flag(refineImports) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-refine-imports-plugin ^>=1.0 cpp-options: -Dhls_refineImports common rename - if flag(rename) + if flag(rename) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-rename-plugin ^>= 1.0 cpp-options: -Dhls_rename @@ -284,7 +284,7 @@ common tactic cpp-options: -Dhls_tactic common hlint - if flag(hlint) + if flag(hlint) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-hlint-plugin ^>= 1.0 cpp-options: -Dhls_hlint @@ -294,12 +294,12 @@ common stan cpp-options: -Dhls_stan common moduleName - if flag(moduleName) + if flag(moduleName) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-module-name-plugin ^>= 1.0 cpp-options: -Dhls_moduleName common pragmas - if flag(pragmas) + if flag(pragmas) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-pragmas-plugin ^>= 1.0 cpp-options: -Dhls_pragmas @@ -309,54 +309,54 @@ common splice cpp-options: -Dhls_splice common alternateNumberFormat - if flag(alternateNumberFormat) + if flag(alternateNumberFormat) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-alternate-number-format-plugin ^>= 1.1 cpp-options: -Dhls_alternateNumberFormat common qualifyImportedNames - if flag(qualifyImportedNames) + if flag(qualifyImportedNames) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-qualify-imported-names-plugin ^>=1.0 cpp-options: -Dhls_qualifyImportedNames common codeRange - if flag(codeRange) + if flag(codeRange) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-code-range-plugin ^>= 1.0 cpp-options: -Dhls_codeRange common changeTypeSignature - if flag(changeTypeSignature) + if flag(changeTypeSignature) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-change-type-signature-plugin ^>= 1.0 cpp-options: -Dhls_changeTypeSignature common gadt - if flag(gadt) + if flag(gadt) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-gadt-plugin ^>= 1.0 cpp-options: -Dhls_gadt common explicitFixity - if flag(explicitFixity) + if flag(explicitFixity) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-explicit-fixity-plugin ^>= 1.0 cpp-options: -DexplicitFixity -- formatters common floskell - if flag(floskell) + if flag(floskell) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-floskell-plugin ^>= 1.0 cpp-options: -Dhls_floskell common fourmolu - if flag(fourmolu) + if flag(fourmolu) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-fourmolu-plugin ^>= 1.0 cpp-options: -Dhls_fourmolu common ormolu - if flag(ormolu) + if flag(ormolu) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-ormolu-plugin ^>= 1.0 cpp-options: -Dhls_ormolu common stylishHaskell - if flag(stylishHaskell) + if flag(stylishHaskell) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-stylish-haskell-plugin ^>= 1.0 cpp-options: -Dhls_stylishHaskell @@ -366,7 +366,7 @@ common brittany cpp-options: -Dhls_brittany common refactor - if flag(refactor) + if flag(refactor) && (impl(ghc < 9.4.1) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-refactor-plugin ^>= 1.0 cpp-options: -Dhls_refactor diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index 8166d2fcd2..7e3aee55a6 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -52,3 +52,5 @@ library hs-source-dirs: src-ghc90 src-reexport-ghc9 if (impl(ghc >= 9.2) && impl(ghc < 9.3)) hs-source-dirs: src-ghc92 src-reexport-ghc9 + if (impl(ghc >= 9.4) && impl(ghc < 9.5)) + hs-source-dirs: src-reexport-ghc92 diff --git a/hie-compat/src-reexport-ghc92/Compat/HieAst.hs b/hie-compat/src-reexport-ghc92/Compat/HieAst.hs new file mode 100644 index 0000000000..240dc4da49 --- /dev/null +++ b/hie-compat/src-reexport-ghc92/Compat/HieAst.hs @@ -0,0 +1,3 @@ +module Compat.HieAst + ( module GHC.Iface.Ext.Ast ) where +import GHC.Iface.Ext.Ast diff --git a/hie-compat/src-reexport-ghc92/Compat/HieBin.hs b/hie-compat/src-reexport-ghc92/Compat/HieBin.hs new file mode 100644 index 0000000000..254e1db6d3 --- /dev/null +++ b/hie-compat/src-reexport-ghc92/Compat/HieBin.hs @@ -0,0 +1,8 @@ +{- +Binary serialization for .hie files. +-} + +module Compat.HieBin ( module GHC.Iface.Ext.Binary) +where + +import GHC.Iface.Ext.Binary diff --git a/hie-compat/src-reexport-ghc92/Compat/HieDebug.hs b/hie-compat/src-reexport-ghc92/Compat/HieDebug.hs new file mode 100644 index 0000000000..872da67c2b --- /dev/null +++ b/hie-compat/src-reexport-ghc92/Compat/HieDebug.hs @@ -0,0 +1,10 @@ +module Compat.HieDebug + ( module GHC.Iface.Ext.Debug + , ppHie ) where +import GHC.Iface.Ext.Debug + +import GHC.Iface.Ext.Types (HieAST) +import GHC.Utils.Outputable (Outputable(ppr), SDoc) + +ppHie :: Outputable a => HieAST a -> SDoc +ppHie = ppr diff --git a/hie-compat/src-reexport-ghc92/Compat/HieTypes.hs b/hie-compat/src-reexport-ghc92/Compat/HieTypes.hs new file mode 100644 index 0000000000..36bb86abeb --- /dev/null +++ b/hie-compat/src-reexport-ghc92/Compat/HieTypes.hs @@ -0,0 +1,3 @@ +module Compat.HieTypes + ( module GHC.Iface.Ext.Types ) where +import GHC.Iface.Ext.Types diff --git a/hie-compat/src-reexport-ghc92/Compat/HieUtils.hs b/hie-compat/src-reexport-ghc92/Compat/HieUtils.hs new file mode 100644 index 0000000000..204a312039 --- /dev/null +++ b/hie-compat/src-reexport-ghc92/Compat/HieUtils.hs @@ -0,0 +1,3 @@ +module Compat.HieUtils + ( module GHC.Iface.Ext.Utils ) where +import GHC.Iface.Ext.Utils diff --git a/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal b/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal index 372fd8c3d2..b7eee39ce0 100644 --- a/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal +++ b/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal @@ -18,6 +18,10 @@ extra-source-files: test/testdata/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.AlternateNumberFormat, Ide.Plugin.Conversion other-modules: Ide.Plugin.Literals hs-source-dirs: src @@ -47,6 +51,10 @@ library RecordWildCards test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal index 8865f07951..dc5cd8e398 100644 --- a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal +++ b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal @@ -16,6 +16,10 @@ extra-source-files: test/testdata/*.hs library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.CallHierarchy other-modules: Ide.Plugin.CallHierarchy.Internal @@ -43,6 +47,10 @@ library default-extensions: DataKinds test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal b/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal index 5f9812c30e..f93f303788 100644 --- a/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal +++ b/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal @@ -19,6 +19,10 @@ extra-source-files: test/testdata/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.ChangeTypeSignature hs-source-dirs: src build-depends: @@ -46,6 +50,10 @@ library test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index c0ad09f305..245522a9cd 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -21,6 +21,10 @@ extra-source-files: test/testdata/*.hs library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Class other-modules: Ide.Plugin.Class.CodeAction , Ide.Plugin.Class.CodeLens @@ -58,6 +62,10 @@ library ghc-options: -Wall -Wno-unticked-promoted-constructors -Wno-name-shadowing test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal index d726b48ee8..3d50d0c764 100644 --- a/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal +++ b/plugins/hls-code-range-plugin/hls-code-range-plugin.cabal @@ -21,6 +21,10 @@ extra-source-files: test/testdata/selection-range/*.txt library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.CodeRange Ide.Plugin.CodeRange.Rules @@ -48,6 +52,10 @@ library , vector test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal index 676e0bf732..a016aade1e 100644 --- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal +++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal @@ -37,6 +37,10 @@ source-repository head location: https://github.com/haskell/haskell-language-server library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Eval Ide.Plugin.Eval.Types @@ -97,6 +101,10 @@ library TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal b/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal index 087c1466b6..dc865f2c12 100644 --- a/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal +++ b/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal @@ -16,6 +16,10 @@ extra-source-files: test/testdata/*.hs library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.ExplicitFixity hs-source-dirs: src @@ -39,6 +43,10 @@ library default-extensions: DataKinds test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal index f94922fd15..fb73ff894f 100644 --- a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal +++ b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal @@ -16,6 +16,10 @@ extra-source-files: test/testdata/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.ExplicitImports hs-source-dirs: src build-depends: @@ -37,6 +41,10 @@ library TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal index 8416ccbc77..e13fa98e4a 100644 --- a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal +++ b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal @@ -17,6 +17,10 @@ extra-source-files: test/testdata/**/*.hs library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Floskell hs-source-dirs: src build-depends: @@ -31,6 +35,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index bb4e0b687a..e84cdccf7a 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -23,6 +23,10 @@ source-repository head location: git://github.com/haskell/haskell-language-server.git library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Fourmolu , Ide.Plugin.Fourmolu.Shim @@ -44,6 +48,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal b/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal index f109ea05d3..47ff630eed 100644 --- a/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal +++ b/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal @@ -16,6 +16,10 @@ extra-source-files: test/testdata/*.hs library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.GADT other-modules: Ide.Plugin.GHC @@ -46,6 +50,10 @@ library default-extensions: DataKinds test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 82f60839e6..5fca22d6e0 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -26,6 +26,10 @@ flag pedantic manual: True library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Hlint hs-source-dirs: src build-depends: @@ -73,6 +77,10 @@ library TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal index 1290ab75bf..08c17e2349 100644 --- a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal +++ b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal @@ -20,6 +20,10 @@ extra-source-files: test/testdata/**/*.project library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.ModuleName hs-source-dirs: src build-depends: @@ -37,6 +41,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal index 67abe1c090..49bfb4959b 100644 --- a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal +++ b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal @@ -17,6 +17,10 @@ extra-source-files: test/testdata/**/*.hs library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Ormolu hs-source-dirs: src build-depends: @@ -34,6 +38,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal index ba29d7a1cc..76f64083bd 100644 --- a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal +++ b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal @@ -18,6 +18,10 @@ extra-source-files: test/testdata/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Pragmas hs-source-dirs: src build-depends: @@ -37,6 +41,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-qualify-imported-names-plugin/hls-qualify-imported-names-plugin.cabal b/plugins/hls-qualify-imported-names-plugin/hls-qualify-imported-names-plugin.cabal index 2ba2a6da91..8990e05f09 100644 --- a/plugins/hls-qualify-imported-names-plugin/hls-qualify-imported-names-plugin.cabal +++ b/plugins/hls-qualify-imported-names-plugin/hls-qualify-imported-names-plugin.cabal @@ -18,6 +18,10 @@ extra-source-files: test/data/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.QualifyImportedNames hs-source-dirs: src build-depends: @@ -41,6 +45,10 @@ library TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index da2d1683c1..d848e77bbb 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal @@ -18,6 +18,10 @@ extra-source-files: test/data/**/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Development.IDE.GHC.ExactPrint Development.IDE.GHC.Compat.ExactPrint Development.IDE.Plugin.CodeAction @@ -81,6 +85,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test 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..28e34ba379 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 @@ -2,6 +2,9 @@ -- multiple ghc-exactprint versions, accepting that anything more ambitious is -- pretty much impossible with the GHC 9.2 redesign of ghc-exactprint module Development.IDE.GHC.Compat.ExactPrint +#if MIN_VERSION_ghc(9,3,0) + ( ) where +#else ( ExactPrint , exactPrint , makeDeltaAst @@ -31,3 +34,5 @@ pattern Annotated {astA, annsA} <- (Retrie.astA &&& Retrie.annsA -> (astA, annsA pattern Annotated :: ast -> ApiAnns -> Retrie.Annotated ast pattern Annotated {astA, annsA} <- ((,()) . Retrie.astA -> (astA, annsA)) #endif + +#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 abaaa81cfb..cde3f79c48 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -36,7 +36,11 @@ showAstDataHtml a0 = html $ li (showAstDataHtml' a0), li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan NoBlankEpAnnotations a0) #else - li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan a0) + li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan +#if MIN_VERSION_ghc(9,3,0) + NoBlankEpAnnotations +#endif + a0) #endif ]) where @@ -49,7 +53,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) +#if MIN_VERSION_ghc(9,2,1) && !MIN_VERSION_ghc(9,3,0) | cts == empty = foo #endif | otherwise = foo $$ (caret $ ul cts) 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 a0d8ce135e..d56b513a79 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -3,6 +3,9 @@ -- | This module hosts various abstractions and utility functions to work with ghc-exactprint. module Development.IDE.GHC.ExactPrint +#if MIN_VERSION_ghc(9,3,0) + ( ) where +#else ( Graft(..), graftDecls, graftDeclsWithM, @@ -665,3 +668,5 @@ isCommaAnn :: TrailingAnn -> Bool isCommaAnn AddCommaAnn{} = True isCommaAnn _ = False #endif + +#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 d883e84e89..01c3b555c1 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -132,14 +132,16 @@ iePluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> PluginDescrip iePluginDescriptor recorder plId = let old = mkGhcideCAsPlugin [ - wrap suggestExtendImport - , wrap suggestImportDisambiguation - , wrap suggestNewOrExtendImportForClassMethod - , wrap suggestNewImport + wrap suggestExportUnusedTopBinding , wrap suggestModuleTypo , wrap suggestFixConstructorImport + , wrap suggestNewImport +#if !MIN_VERSION_ghc(9,3,0) + , wrap suggestExtendImport + , wrap suggestImportDisambiguation + , wrap suggestNewOrExtendImportForClassMethod , wrap suggestHideShadow - , wrap suggestExportUnusedTopBinding +#endif ] plId in mkExactprintPluginDescriptor recorder $ old {pluginHandlers = pluginHandlers old <> mkPluginHandler STextDocumentCodeAction codeAction } @@ -149,9 +151,11 @@ typeSigsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ mkGhcideCAsPlugin [ wrap $ suggestSignature True , wrap suggestFillTypeWildcard - , wrap removeRedundantConstraints , wrap suggestAddTypeAnnotationToSatisfyContraints +#if !MIN_VERSION_ghc(9,3,0) + , wrap removeRedundantConstraints , wrap suggestConstraint +#endif ] plId @@ -159,7 +163,9 @@ bindingsPluginDescriptor :: Recorder (WithPriority E.Log) -> PluginId -> Plugin bindingsPluginDescriptor recorder plId = mkExactprintPluginDescriptor recorder $ mkGhcideCAsPlugin [ wrap suggestReplaceIdentifier +#if !MIN_VERSION_ghc(9,3,0) , wrap suggestImplicitParameter +#endif , wrap suggestNewDefinition , wrap suggestDeleteUnusedBinding ] @@ -296,7 +302,11 @@ findSigOfBind range bind = msum [findSigOfBinds range (grhssLocalBinds grhs) -- where clause , do +#if MIN_VERSION_ghc(9,3,0) + grhs <- findDeclContainingLoc (_start range) (grhssGRHSs grhs) +#else grhs <- findDeclContainingLoc (_start range) (map reLocA $ grhssGRHSs grhs) +#endif case unLoc grhs of GRHS _ _ bd -> findSigOfExpr (unLoc bd) ] @@ -305,7 +315,11 @@ findSigOfBind range bind = findSigOfExpr :: HsExpr p -> Maybe (Sig p) findSigOfExpr = go where +#if MIN_VERSION_ghc(9,3,0) + go (HsLet _ _ binds _ _) = findSigOfBinds range binds +#else go (HsLet _ binds _) = findSigOfBinds range binds +#endif go (HsDo _ _ stmts) = do stmtlr <- unLoc <$> findDeclContainingLoc (_start range) (unLoc stmts) case stmtlr of @@ -355,6 +369,7 @@ findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) -- imported from ‘Data.ByteString’ at B.hs:6:1-22 -- imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27 -- imported from ‘Data.Text’ at B.hs:7:1-16 +#if !MIN_VERSION_ghc(9,3,0) suggestHideShadow :: Annotated ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range} | Just [identifier, modName, s] <- @@ -386,6 +401,7 @@ suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range} then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps fileContents else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl | otherwise = [] +#endif findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs) findImportDeclByModuleName decls modName = flip find decls $ \case @@ -978,6 +994,7 @@ getIndentedGroupsBy pred inp = case dropWhile (not.pred) inp of indentation :: T.Text -> Int indentation = T.length . T.takeWhile isSpace +#if !MIN_VERSION_ghc(9,3,0) suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, CodeActionKind, Rewrite)] suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..} | Just [binding, mod, srcspan] <- @@ -1025,6 +1042,7 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_ , parent = Nothing , isDatacon = False , moduleNameText = mod} +#endif data HidingMode = HideOthers [ModuleTarget] @@ -1050,6 +1068,7 @@ oneAndOthers = go isPreludeImplicit :: DynFlags -> Bool isPreludeImplicit = xopt Lang.ImplicitPrelude +#if !MIN_VERSION_ghc(9,3,0) -- | Suggests disambiguation for ambiguous symbols. suggestImportDisambiguation :: DynFlags -> @@ -1141,6 +1160,7 @@ suggestImportDisambiguation df (Just txt) ps fileContents diag@Diagnostic {..} <> "." <> symbol suggestImportDisambiguation _ _ _ _ _ = [] +#endif occursUnqualified :: T.Text -> ImportDecl GhcPs -> Bool occursUnqualified symbol ImportDecl{..} @@ -1163,6 +1183,7 @@ targetModuleName (ExistingImp (L _ ImportDecl{..} :| _)) = targetModuleName (ExistingImp _) = error "Cannot happen!" +#if !MIN_VERSION_ghc(9,3,0) disambiguateSymbol :: Annotated ParsedSource -> T.Text -> @@ -1195,6 +1216,8 @@ disambiguateSymbol ps fileContents Diagnostic {..} (T.unpack -> symbol) = \case liftParseAST @RdrName df $ T.unpack $ printOutputable $ L (mkGeneralSrcSpan "") rdr ] +#endif + findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs) findImportDeclByRange xs range = find (\(L (locA -> l) _)-> srcSpanToRange l == Just range) xs @@ -1212,6 +1235,7 @@ suggestFixConstructorImport Diagnostic{_range=_range,..} in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)] | otherwise = [] +#if !MIN_VERSION_ghc(9,3,0) -- | Suggests a constraint for a declaration for which a constraint is missing. suggestConstraint :: DynFlags -> ParsedSource -> Diagnostic -> [(T.Text, Rewrite)] suggestConstraint df (makeDeltaAst -> parsedModule) diag@Diagnostic {..} @@ -1293,10 +1317,12 @@ suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _rang [( "Add " <> implicitT <> " to the context of " <> T.pack (printRdrName funId) , appendConstraint (T.unpack implicitT) hsib_body)] | otherwise = [] +#endif findTypeSignatureName :: T.Text -> Maybe T.Text findTypeSignatureName t = matchRegexUnifySpaces t "([^ ]+) :: " <&> head +#if !MIN_VERSION_ghc(9,3,0) -- | Suggests a constraint for a type signature with any number of existing constraints. suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)] @@ -1443,6 +1469,7 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos ] <> [(quickFixImportKind "new.all", newImportAll moduleNameText)] | otherwise -> [] +#endif suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] suggestNewImport packageExportsMap ps fileContents Diagnostic{_message} 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 59c0ac868f..ef5c7b623a 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 @@ -26,8 +26,10 @@ import Development.IDE.Core.Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.ExactPrint import Development.IDE.GHC.ExactPrint +#if !MIN_VERSION_ghc(9,3,0) import Development.IDE.Plugin.CodeAction.ExactPrint (Rewrite, rewriteToEdit) +#endif import Development.IDE.Plugin.TypeLenses (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs), GlobalBindingTypeSigsResult) import Development.IDE.Spans.LocalBindings (Bindings) @@ -70,7 +72,9 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra Just (_, txt) -> pure txt _ -> pure Nothing caaDf <- onceIO $ fmap (ms_hspp_opts . pm_mod_summary) <$> caaParsedModule +#if !MIN_VERSION_ghc(9,3,0) caaAnnSource <- onceIO $ runRule GetAnnotatedParsedSource +#endif caaTmr <- onceIO $ runRule TypeCheck caaHar <- onceIO $ runRule GetHieAst caaBindings <- onceIO $ runRule GetBindings @@ -113,6 +117,7 @@ class ToTextEdit a where instance ToTextEdit TextEdit where toTextEdit _ = pure . pure +#if !MIN_VERSION_ghc(9,3,0) instance ToTextEdit Rewrite where toTextEdit CodeActionArgs {..} rw = fmap (fromMaybe []) $ runMaybeT $ do @@ -124,6 +129,7 @@ instance ToTextEdit Rewrite where let r = rewriteToEdit df rw #endif pure $ fromRight [] r +#endif instance ToTextEdit a => ToTextEdit [a] where toTextEdit caa = foldMap (toTextEdit caa) @@ -143,7 +149,11 @@ data CodeActionArgs = CodeActionArgs caaParsedModule :: IO (Maybe ParsedModule), caaContents :: IO (Maybe T.Text), caaDf :: IO (Maybe DynFlags), +#if MIN_VERSION_ghc(9,3,0) + caaAnnSource :: IO (Maybe ParsedSource), +#else caaAnnSource :: IO (Maybe (Annotated ParsedSource)), +#endif caaTmr :: IO (Maybe TcModuleResult), caaHar :: IO (Maybe HieAstResult), caaBindings :: IO (Maybe Bindings), @@ -212,10 +222,17 @@ toCodeAction3 get f = ReaderT $ \caa -> get caa >>= flip runReaderT caa . toCode -- | this instance returns a delta AST, useful for exactprint transforms instance ToCodeAction r => ToCodeAction (ParsedSource -> r) where +#if !MIN_VERSION_ghc(9,3,0) toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaAnnSource = x} -> x >>= \case Just s -> flip runReaderT caa . toCodeAction . f . astA $ s _ -> pure [] +#else + toCodeAction f = ReaderT $ \caa@CodeActionArgs {caaParsedModule = x} -> + x >>= \case + Just s -> flip runReaderT caa . toCodeAction . f . pm_parsed_source $ s + _ -> pure [] +#endif instance ToCodeAction r => ToCodeAction (ExportsMap -> r) where toCodeAction = toCodeAction3 caaExportsMap @@ -244,11 +261,13 @@ instance ToCodeAction r => ToCodeAction (Maybe DynFlags -> r) where instance ToCodeAction r => ToCodeAction (DynFlags -> r) where toCodeAction = toCodeAction2 caaDf +#if !MIN_VERSION_ghc(9,3,0) instance ToCodeAction r => ToCodeAction (Maybe (Annotated ParsedSource) -> r) where toCodeAction = toCodeAction1 caaAnnSource instance ToCodeAction r => ToCodeAction (Annotated ParsedSource -> r) where toCodeAction = toCodeAction2 caaAnnSource +#endif instance ToCodeAction r => ToCodeAction (Maybe TcModuleResult -> r) where toCodeAction = toCodeAction1 caaTmr diff --git a/plugins/hls-refine-imports-plugin/hls-refine-imports-plugin.cabal b/plugins/hls-refine-imports-plugin/hls-refine-imports-plugin.cabal index 98d36465e4..ebbe0b271c 100644 --- a/plugins/hls-refine-imports-plugin/hls-refine-imports-plugin.cabal +++ b/plugins/hls-refine-imports-plugin/hls-refine-imports-plugin.cabal @@ -16,6 +16,10 @@ extra-source-files: test/testdata/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.RefineImports hs-source-dirs: src build-depends: @@ -38,6 +42,10 @@ library TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal index e0c295dc12..43f8397fbe 100644 --- a/plugins/hls-rename-plugin/hls-rename-plugin.cabal +++ b/plugins/hls-rename-plugin/hls-rename-plugin.cabal @@ -17,6 +17,10 @@ extra-source-files: test/testdata/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Rename hs-source-dirs: src build-depends: @@ -41,6 +45,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal index 3313ffe610..c86bacbb20 100644 --- a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal +++ b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal @@ -13,6 +13,10 @@ build-type: Simple extra-source-files: LICENSE library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Retrie hs-source-dirs: src build-depends: diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index 4dc8f7fdd9..0ea73506de 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -23,6 +23,10 @@ extra-source-files: test/testdata/*.yaml library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Splice Ide.Plugin.Splice.Types @@ -56,6 +60,10 @@ library TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-stan-plugin/hls-stan-plugin.cabal b/plugins/hls-stan-plugin/hls-stan-plugin.cabal index 0f63a01a77..5c149e18b4 100644 --- a/plugins/hls-stan-plugin/hls-stan-plugin.cabal +++ b/plugins/hls-stan-plugin/hls-stan-plugin.cabal @@ -76,4 +76,4 @@ test-suite test , text default-extensions: NamedFieldPuns - OverloadedStrings \ No newline at end of file + OverloadedStrings diff --git a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal index c161f888bf..f7b229b4e7 100644 --- a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal +++ b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal @@ -16,6 +16,10 @@ extra-source-files: test/testdata/*.hs library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.StylishHaskell hs-source-dirs: src build-depends: @@ -33,6 +37,10 @@ library default-language: Haskell2010 test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index 14faae448e..bbb7e9e104 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -25,6 +25,10 @@ flag pedantic manual: True library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True hs-source-dirs: src exposed-modules: Ide.Plugin.Tactic @@ -127,6 +131,10 @@ library ViewPatterns test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 main-is: Main.hs other-modules: From 04df804e4b1cd49653188376affdb2a602d5c56c Mon Sep 17 00:00:00 2001 From: Guillaume Bouchard Date: Tue, 16 Aug 2022 17:51:21 +0200 Subject: [PATCH 2/8] chore: add the nix stuffs for GHC 9.4 I've just added naively the different nix lines. The configuration file comes from a copy of the one for 9.2. With that, we can open a shell with `nix develop .\#haskell-language-server-941-dev` and type `cabal build`. (cherry picked from commit 48084ab95729d48d470888d8fde807a1d7865860) --- configuration-ghc-94.nix | 42 ++++++++++++++++++++++++++++++++++++++++ flake.nix | 6 ++++++ 2 files changed, 48 insertions(+) create mode 100644 configuration-ghc-94.nix diff --git a/configuration-ghc-94.nix b/configuration-ghc-94.nix new file mode 100644 index 0000000000..3790e182a7 --- /dev/null +++ b/configuration-ghc-94.nix @@ -0,0 +1,42 @@ +{ pkgs, inputs }: + +let + disabledPlugins = [ + "hls-hlint-plugin" + # That one is not technically a plugin, but by putting it in this list, we + # get it removed from the top level list of requirement and it is not pull + # in the nix shell. + "shake-bench" + ]; + + hpkgsOverride = hself: hsuper: + with pkgs.haskell.lib; + { + hlsDisabledPlugins = disabledPlugins; + # YOLO + mkDerivation = args: + hsuper.mkDerivation (args // { + jailbreak = true; + doCheck = false; + }); + } // (builtins.mapAttrs (_: drv: disableLibraryProfiling drv) { + # ptr-poker breaks on MacOS without SSE2 optimizations + # https://github.com/nikita-volkov/ptr-poker/issues/11 + ptr-poker = hself.callCabal2nix "ptr-poker" inputs.ptr-poker { }; + + ghc-exactprint = + hself.callCabal2nix "ghc-exactprint" inputs.ghc-exactprint-150 { }; + # Hlint is still broken + hlint = doJailbreak (hself.callCabal2nix "hlint" inputs.hlint { }); + + stylish-haskell = appendConfigureFlag hsuper.stylish-haskell "-fghc-lib"; + + # Re-generate HLS drv excluding some plugins + haskell-language-server = + hself.callCabal2nixWithOptions "haskell-language-server" ./. + (pkgs.lib.concatStringsSep " " [ "-fpedantic" "-f-hlint" ]) { }; + }); +in { + inherit disabledPlugins; + tweakHpkgs = hpkgs: hpkgs.extend hpkgsOverride; +} diff --git a/flake.nix b/flake.nix index 47dcc62798..5257bda8f8 100644 --- a/flake.nix +++ b/flake.nix @@ -215,6 +215,7 @@ ghc902Config = (import ./configuration-ghc-90.nix) { inherit pkgs inputs; }; ghc924Config = (import ./configuration-ghc-92.nix) { inherit pkgs inputs; }; + ghc941Config = (import ./configuration-ghc-94.nix) { inherit pkgs inputs; }; # GHC versions # While HLS still works fine with 8.10 GHCs, we only support the versions that are cached @@ -224,11 +225,13 @@ cases = { ghc902 = ghc902Config.tweakHpkgs (pkgs.hlsHpkgs "ghc902"); ghc924 = ghc924Config.tweakHpkgs (pkgs.hlsHpkgs "ghc924"); + ghc941 = ghc941Config.tweakHpkgs (pkgs.hlsHpkgs "ghc941"); }; in { default = cases."${ghcVersion}"; } // cases; ghc902 = supportedGHCs.ghc902; ghc924 = supportedGHCs.ghc924; + ghc941 = supportedGHCs.ghc941; ghcDefault = supportedGHCs.default; # For markdown support @@ -361,6 +364,7 @@ haskell-language-server-dev = mkDevShell ghcDefault "cabal.project"; haskell-language-server-902-dev = mkDevShell ghc902 "cabal.project"; haskell-language-server-924-dev = mkDevShell ghc924 "cabal.project"; + haskell-language-server-941-dev = mkDevShell ghc941 "cabal.project"; }; # Developement shell, haskell packages are also provided by nix @@ -368,12 +372,14 @@ haskell-language-server-dev-nix = mkDevShellWithNixDeps ghcDefault "cabal.project"; haskell-language-server-902-dev-nix = mkDevShellWithNixDeps ghc902 "cabal.project"; haskell-language-server-924-dev-nix = mkDevShellWithNixDeps ghc924 "cabal.project"; + haskell-language-server-941-dev-nix = mkDevShellWithNixDeps ghc941 "cabal.project"; }; allPackages = { haskell-language-server = mkExe ghcDefault; haskell-language-server-902 = mkExe ghc902; haskell-language-server-924 = mkExe ghc924; + haskell-language-server-941 = mkExe ghc941; }; devShells = simpleDevShells // nixDevShells // { From f25d071d0b4556e43ad0703109ff02e96d4c9926 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 31 Aug 2022 19:22:51 +0530 Subject: [PATCH 3/8] drop windows for 9.4.2 --- .github/workflows/test.yml | 3 --- 1 file changed, 3 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 059a804125..d541d644cf 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -89,9 +89,6 @@ jobs: - os: ubuntu-latest ghc: '8.6.5' test: true - - os: windows-latest - ghc: '9.4.2' - test: true - os: windows-latest ghc: '9.2.4' test: true From 1d568f1a924fcd51e94afe8a83a52c55128b5a2a Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 31 Aug 2022 21:37:09 +0530 Subject: [PATCH 4/8] Fix func test --- haskell-language-server.cabal | 1 + test/functional/Format.hs | 11 +++++++---- test/functional/FunctionalCodeAction.hs | 2 ++ 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index bfdd321674..fb73813911 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -520,6 +520,7 @@ test-suite func-test import: common-deps , warnings , pedantic + , refactor type: exitcode-stdio-1.0 default-language: Haskell2010 build-tool-depends: diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 9b853d527e..ec4087ec95 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -47,10 +47,13 @@ providerTests = testGroup "formatting provider" [ testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do doc <- openDoc "Format.hs" "haskell" resp <- request STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) - liftIO $ resp ^. LSP.result @?= Left (ResponseError InvalidRequest - ("No plugin enabled for STextDocumentFormatting, available:\n" - <> "PluginId \"floskell\"\nPluginId \"fourmolu\"\nPluginId \"stylish-haskell\"\nPluginId \"brittany\"\nPluginId \"ormolu\"\n") - Nothing) + case resp ^. LSP.result of + result@(Left (ResponseError reason message Nothing)) -> case reason of + MethodNotFound -> pure () -- No formatter + InvalidRequest | "No plugin enabled for STextDocumentFormatting" `isPrefixOf` message -> pure () + _ -> assertFailure $ "strange response from formatting provider:" ++ show result + result -> assertFailure $ "strange response from formatting provider:" ++ show result + , requiresOrmoluPlugin . requiresFloskellPlugin $ testCase "can change on the fly" $ runSession hlsCommand fullCaps "test/testdata/format" $ do formattedOrmolu <- liftIO $ T.readFile "test/testdata/format/Format.ormolu.formatted.hs" diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 91cb322e20..aa7bf9253b 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -24,6 +24,7 @@ import Test.Hls.Command tests :: TestTree tests = testGroup "code actions" [ +#if hls_refactor importTests , packageTests , redundantImportTests @@ -31,6 +32,7 @@ tests = testGroup "code actions" [ , signatureTests , typedHoleTests , unusedTermTests +#endif ] renameTests :: TestTree From 5d3b0a45ede40cdfd286268ea744f880db3b30e0 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 1 Sep 2022 00:27:57 +0530 Subject: [PATCH 5/8] Disable plugin tests for 9.4 --- .github/workflows/test.yml | 50 +++++++++++++++++++------------------- test/functional/Format.hs | 5 ++-- 2 files changed, 28 insertions(+), 27 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index d541d644cf..faf0529644 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -161,103 +161,103 @@ jobs: HLS_WRAPPER_TEST_EXE: hls-wrapper run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" || cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" - - if: matrix.test && matrix.ghc != '9.2.4' + - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-brittany-plugin run: cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || cabal test hls-brittany-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-brittany-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refactor-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-floskell-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-class-plugin run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-class-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-pragmas-plugin run: cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-pragmas-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-eval-plugin run: cabal test hls-eval-plugin --test-options="$TEST_OPTS" || cabal test hls-eval-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-eval-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.4' + - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-haddock-comments-plugin run: cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-haddock-comments-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.4' + - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-splice-plugin run: cabal test hls-splice-plugin --test-options="$TEST_OPTS" || cabal test hls-splice-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-splice-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.2.4' + - if: matrix.test && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-tactics-plugin test suite run: cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || cabal test hls-tactics-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-tactics-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-refine-imports-plugin test suite run: cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-refine-imports-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-explicit-imports-plugin test suite run: cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-imports-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.os != 'windows-latest' + - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc != '9.4.2' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-rename-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-hlint-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.0.1' && matrix.ghc != '9.0.2' && matrix.ghc != '9.2.4' + - if: matrix.test && matrix.ghc != '9.0.1' && matrix.ghc != '9.0.2' && matrix.ghc != '9.2.4' && matrix.ghc != '9.4.2' name: Test hls-stan-plugin test suite run: cabal test hls-stan-plugin --test-options="$TEST_OPTS" || cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-stan-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-module-name-plugin test suite run: cabal test hls-module-name-plugin --test-options="$TEST_OPTS" || cabal test hls-module-name-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-module-name-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-alternate-number-format-plugin test suite run: cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-alternate-number-format-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-qualify-imported-names-plugin test suite run: cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-qualify-imported-names-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-code-range-plugin test suite run: cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || cabal test hls-code-range-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-code-range-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-change-type-signature test suite run: cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-gadt-plugin test suit run: cabal test hls-gadt-plugin --test-options="$TEST_OPTS" || cabal test hls-gadt-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-gadt-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.4.2' name: Test hls-explicit-fixity-plugin test suite run: cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" || cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" diff --git a/test/functional/Format.hs b/test/functional/Format.hs index ec4087ec95..b3829c3a9f 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -8,6 +8,7 @@ import Data.Aeson import qualified Data.ByteString.Lazy as BS import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T +import qualified Data.Text as T import Language.LSP.Test import Language.LSP.Types import qualified Language.LSP.Types.Lens as LSP @@ -47,10 +48,10 @@ providerTests = testGroup "formatting provider" [ testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do doc <- openDoc "Format.hs" "haskell" resp <- request STextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing) - case resp ^. LSP.result of + liftIO $ case resp ^. LSP.result of result@(Left (ResponseError reason message Nothing)) -> case reason of MethodNotFound -> pure () -- No formatter - InvalidRequest | "No plugin enabled for STextDocumentFormatting" `isPrefixOf` message -> pure () + InvalidRequest | "No plugin enabled for STextDocumentFormatting" `T.isPrefixOf` message -> pure () _ -> assertFailure $ "strange response from formatting provider:" ++ show result result -> assertFailure $ "strange response from formatting provider:" ++ show result From e139e3775b7b14ce48577f26b0be3aa1eceb7df0 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 1 Sep 2022 01:21:51 +0530 Subject: [PATCH 6/8] Improve GhcSessionDeps and lay out assumptions --- ghcide/src/Development/IDE/Core/Compile.hs | 39 ++++++++++----------- ghcide/src/Development/IDE/Core/Rules.hs | 40 ++++++++++++---------- ghcide/src/Development/IDE/GHC/Orphans.hs | 3 ++ 3 files changed, 43 insertions(+), 39 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 564078b513..fb0bd5b02a 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -1029,21 +1029,21 @@ loadModulesHome mod_infos e = #endif -- Merge the HPTs, module graphs and FinderCaches +-- See Note [GhcSessionDeps] in Development.IDE.Core.Rules +-- Add the current ModSummary to the graph, along with the +-- HomeModInfo's of all direct dependencies (by induction hypothesis all +-- transitive dependencies will be contained in envs) #if MIN_VERSION_ghc(9,3,0) -mergeEnvs :: HscEnv -> [ModuleGraphNode] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv -mergeEnvs env extraNodes extraMods envs = do - let extraModSummaries = mapMaybe moduleGraphNodeModSum extraNodes - ims = map (\ms -> Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms))) extraModSummaries - ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) extraModSummaries ims - curFinderCache = - foldl' - (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) Compat.emptyInstalledModuleEnv - $ zip ims ifrs +mergeEnvs :: HscEnv -> (ModSummary, [NodeKey]) -> [HomeModInfo] -> [HscEnv] -> IO HscEnv +mergeEnvs env (ms, deps) extraMods envs = do + let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms)) + ifr = InstalledFound (ms_location ms) im + curFinderCache = Compat.extendInstalledModuleEnv Compat.emptyInstalledModuleEnv im ifr -- Very important to force this as otherwise the hsc_mod_graph field is not -- forced and ends up retaining a reference to all the old hsc_envs we have merged to get -- this new one, which in turn leads to the EPS referencing the HPT. module_graph_nodes = - extraNodes ++ nubOrdOn mkNodeKey (concatMap (mgModSummaries' . hsc_mod_graph) envs) + nubOrdOn mkNodeKey (ModuleNode deps ms : concatMap (mgModSummaries' . hsc_mod_graph) envs) newFinderCache <- concatFC curFinderCache (map hsc_FC envs) liftRnf rwhnf module_graph_nodes `seq` (return $ loadModulesHome extraMods $ @@ -1065,16 +1065,16 @@ mergeEnvs env extraNodes extraMods envs = do concatFC cur xs = do fcModules <- mapM (readIORef . fcModuleCache) xs fcFiles <- mapM (readIORef . fcFileCache) xs - fcModules' <- newIORef (foldl' (plusInstalledModuleEnv const) cur fcModules) - fcFiles' <- newIORef (Map.unions fcFiles) + fcModules' <- newIORef $! foldl' (plusInstalledModuleEnv const) cur fcModules + fcFiles' <- newIORef $! Map.unions fcFiles pure $ FinderCache fcModules' fcFiles' #else -mergeEnvs :: HscEnv -> [ModSummary] -> [HomeModInfo] -> [HscEnv] -> IO HscEnv -mergeEnvs env extraModSummaries extraMods envs = do +mergeEnvs :: HscEnv -> ModSummary -> [HomeModInfo] -> [HscEnv] -> IO HscEnv +mergeEnvs env ms extraMods envs = do prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs - let ims = map (\ms -> Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms))) extraModSummaries - ifrs = zipWith (\ms -> InstalledFound (ms_location ms)) extraModSummaries ims + let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms)) + ifr = InstalledFound (ms_location ms) im -- Very important to force this as otherwise the hsc_mod_graph field is not -- forced and ends up retaining a reference to all the old hsc_envs we have merged to get -- this new one, which in turn leads to the EPS referencing the HPT. @@ -1085,12 +1085,9 @@ mergeEnvs env extraModSummaries extraMods envs = do -- This may have to change in the future. map extendModSummaryNoDeps $ #endif - extraModSummaries ++ nubOrdOn ms_mod (concatMap (mgModSummaries . hsc_mod_graph) envs) + nubOrdOn ms_mod (ms : concatMap (mgModSummaries . hsc_mod_graph) envs) - newFinderCache <- newIORef $ - foldl' - (\fc (im, ifr) -> Compat.extendInstalledModuleEnv fc im ifr) prevFinderCache - $ zip ims ifrs + newFinderCache <- newIORef $! Compat.extendInstalledModuleEnv prevFinderCache im ifr liftRnf rwhnf module_graph_nodes `seq` (return $ loadModulesHome extraMods $ env{ hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs, diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 07cf081c21..72313a4661 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -67,6 +67,7 @@ import Control.Applicative (liftA2) #endif import Control.Concurrent.Async (concurrently) import Control.Concurrent.Strict +import Control.DeepSeq import Control.Exception.Safe import Control.Monad.Extra import Control.Monad.Reader @@ -668,7 +669,7 @@ typeCheckRule recorder = define (cmapWithPrio LogShake recorder) $ \TypeCheck fi -- very expensive. when (foi == NotFOI) $ logWith recorder Logger.Warning $ LogTypecheckedFOI file - typeCheckRuleDefinition hsc pm file + typeCheckRuleDefinition hsc pm knownFilesRule :: Recorder (WithPriority Log) -> Rules () knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetKnownTargets -> do @@ -689,9 +690,8 @@ getModuleGraphRule recorder = defineNoFile (cmapWithPrio LogShake recorder) $ \G typeCheckRuleDefinition :: HscEnv -> ParsedModule - -> NormalizedFilePath -> Action (IdeResult TcModuleResult) -typeCheckRuleDefinition hsc pm file = do +typeCheckRuleDefinition hsc pm = do setPriority priorityTypeCheck IdeOptions { optDefer = defer } <- getIdeOptions @@ -759,6 +759,11 @@ instance Default GhcSessionDepsConfig where { checkForImportCycles = True } +-- | Note [GhcSessionDeps] +-- For a file 'Foo', GhcSessionDeps "Foo.hs" results in an HscEnv which includes +-- 1. HomeModInfo's (in the HUG/HPT) for all modules in the transitive closure of "Foo", **NOT** including "Foo" itself. +-- 2. ModSummary's (in the ModuleGraph) for all modules in the transitive closure of "Foo", including "Foo" itself. +-- 3. ModLocation's (in the FinderCache) all modules in the transitive closure of "Foo", including "Foo" itself. ghcSessionDepsDefinition :: -- | full mod summary Bool -> @@ -771,27 +776,26 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do Nothing -> return Nothing Just deps -> do when checkForImportCycles $ void $ uses_ ReportImportCycles deps - mss <- map msrModSummary <$> if fullModSummary - then uses_ GetModSummary deps - else uses_ GetModSummaryWithoutTimestamps deps + ms <- msrModSummary <$> if fullModSummary + then use_ GetModSummary file + else use_ GetModSummaryWithoutTimestamps file depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps ifaces <- uses_ GetModIface deps let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces #if MIN_VERSION_ghc(9,3,0) - mss_imports <- uses_ GetLocatedImports (file : deps) - final_deps <- forM mss_imports $ \imports -> do - let fs = mapMaybe (fmap artifactFilePath . snd) imports - dep_mss <- map msrModSummary <$> if fullModSummary - then uses_ GetModSummary fs - else uses_ GetModSummaryWithoutTimestamps fs - return (map (NodeKey_Module . msKey) dep_mss) - ms <- msrModSummary <$> use_ GetModSummary file - let moduleNodes = zipWith ModuleNode final_deps (ms : mss) + -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph + -- also points to all the direct descendents of the current module. To get the keys for the descendents + -- we must get their `ModSummary`s + !final_deps <- do + dep_mss <- map msrModSummary <$> uses_ GetModSummaryWithoutTimestamps deps + -- Don't want to retain references to the entire ModSummary when just the key will do + return $!! map (NodeKey_Module . msKey) dep_mss + let moduleNode = (ms, final_deps) #else - let moduleNodes = mss + let moduleNode = ms #endif - session' <- liftIO $ mergeEnvs hsc moduleNodes inLoadOrder depSessions + session' <- liftIO $ mergeEnvs hsc moduleNode inLoadOrder depSessions Just <$> liftIO (newHscEnvEqWithImportPaths (envImportPaths env) session' []) @@ -996,7 +1000,7 @@ regenerateHiFile sess f ms compNeeded = do Just pm -> do -- Invoke typechecking directly to update it without incurring a dependency -- on the parsed module and the typecheck rules - (diags', mtmr) <- typeCheckRuleDefinition hsc pm f + (diags', mtmr) <- typeCheckRuleDefinition hsc pm case mtmr of Nothing -> pure (diags', Nothing) Just tmr -> do diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 4e7ff4463e..d4f5c51972 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -223,4 +223,7 @@ instance NFData PkgQual where instance NFData UnitId where rnf = rwhnf + +instance NFData NodeKey where + rnf = rwhnf #endif From a747f5bf4f94d54fd004135d164a5c267cbe24c8 Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Thu, 1 Sep 2022 01:33:44 +0530 Subject: [PATCH 7/8] Reduce nesting of ifdefs in hscCompileCoreHook --- ghcide/src/Development/IDE/Core/Compile.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index fb0bd5b02a..e6094a470d 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -306,19 +306,14 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do [homeUnitId_ dflags] #endif mods_transitive = getTransitiveMods hsc_env needed_mods + -- If we don't support multiple home units, ModuleNames are sufficient because all the units will be the same mods_transitive_list = #if MIN_VERSION_ghc(9,3,0) mapMaybe nodeKeyToInstalledModule $ Set.toList mods_transitive #else - map -#if MIN_VERSION_ghc(9,0,0) - (mkModule (homeUnitId_ dflags)) -#else - (InstalledModule (toInstalledUnitId $ homeUnitId_ dflags)) -#endif -- Non det OK as we will put it into maps later anyway - $ nonDetEltsUniqSet mods_transitive + map (Compat.installedModule (homeUnitId_ dflags)) $ nonDetEltsUniqSet mods_transitive #endif #if MIN_VERSION_ghc(9,3,0) From ce2bf7a8f7b8868d327d92435c0a8b6b9f2a54e4 Mon Sep 17 00:00:00 2001 From: Guillaume Bouchard Date: Thu, 1 Sep 2022 10:56:10 +0200 Subject: [PATCH 8/8] chore: add missing sub-project in flake.nix --- flake.nix | 1 + 1 file changed, 1 insertion(+) diff --git a/flake.nix b/flake.nix index 5257bda8f8..5c661fe66e 100644 --- a/flake.nix +++ b/flake.nix @@ -144,6 +144,7 @@ hie-compat = ./hie-compat; hls-plugin-api = ./hls-plugin-api; hls-test-utils = ./hls-test-utils; + ghcide-test-utils = ./ghcide/test; } // pluginSourceDirs; # Tweak our packages