From 3d58a9317cdd11d40f1e969ef3702ab22d0916f1 Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 16 Mar 2025 14:30:17 +0800 Subject: [PATCH 01/46] init to ghcide --- ghcide/cabal.project | 6 ++++++ ghcide/src/Development/IDE/Core/Compile.hs | 2 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 19 ++++++++++++++++++- .../src/Development/IDE/GHC/Compat/Driver.hs | 2 ++ .../src/Development/IDE/GHC/Compat/Iface.hs | 4 ++++ .../src/Development/IDE/GHC/Compat/Parser.hs | 4 ++++ ghcide/src/Development/IDE/GHC/CoreFile.hs | 8 ++++++-- 7 files changed, 41 insertions(+), 4 deletions(-) create mode 100644 ghcide/cabal.project diff --git a/ghcide/cabal.project b/ghcide/cabal.project new file mode 100644 index 0000000000..593b6f12d6 --- /dev/null +++ b/ghcide/cabal.project @@ -0,0 +1,6 @@ +packages: + ./ + +allow-newer: + base + , ghc diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 47872b9255..de48f1fb79 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -470,7 +470,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do core_file = codeGutsToCoreFile iface_hash guts iface_hash = getModuleHash final_iface core_hash1 <- atomicFileWrite se core_fp $ \fp -> - writeBinCoreFile fp core_file + writeBinCoreFile (ms_hspp_opts ms) fp core_file -- We want to drop references to guts and read in a serialized, compact version -- of the core file from disk (as it is deserialised lazily) -- This is because we don't want to keep the guts in memory for every file in diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 301aa980bd..fadc8887a2 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -230,7 +230,12 @@ module Development.IDE.GHC.Compat.Core ( ModuleOrigin(..), PackageName(..), -- * Linker +#if !MIN_VERSION_ghc(9,11,0) Unlinked(..), +#else + LinkablePart(..), + Unlinked, +#endif Linkable(..), unload, -- * Hooks @@ -537,6 +542,9 @@ import GHC.Utils.Error (mkPlainErrorMsgEnvelope) import GHC.Utils.Panic import GHC.Utils.TmpFs import Language.Haskell.Syntax hiding (FunDep) +#if MIN_VERSION_ghc(9,11,0) +import System.OsPath.Types (OsPath) +#endif -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -549,7 +557,11 @@ import GHC.Types.Avail (greNamePrintableName) import GHC.Hs (SrcSpanAnn') #endif +#if !MIN_VERSION_ghc(9,11,0) mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation +#else +mkHomeModLocation :: DynFlags -> ModuleName -> OsPath -> IO Module.ModLocation +#endif mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan @@ -709,7 +721,7 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE #endif ,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)} -collectHsBindsBinders :: CollectPass p => Bag (XRec p (HsBindLR p idR)) -> [IdP p] +collectHsBindsBinders :: CollectPass p => LHsBinds p -> [IdP p] collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x @@ -790,3 +802,8 @@ mkSimpleTarget df fp = Target (TargetFile fp Nothing) True (homeUnitId_ df) Noth #if MIN_VERSION_ghc(9,7,0) lookupGlobalRdrEnv gre_env occ = lookupGRE gre_env (LookupOccName occ AllRelevantGREs) #endif + + +#if MIN_VERSION_ghc(9,11,0) +type Unlinked = LinkablePart +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs b/ghcide/src/Development/IDE/GHC/Compat/Driver.hs index c88d0963d6..2e934d71bd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Driver.hs @@ -40,10 +40,12 @@ import GHC.Utils.Logger import GHC.Utils.Outputable import GHC.Utils.Panic.Plain +#if !MIN_VERSION_ghc(9,11,0) hscTypecheckRenameWithDiagnostics :: HscEnv -> ModSummary -> HsParsedModule -> IO ((TcGblEnv, RenamedStuff), Messages GhcMessage) hscTypecheckRenameWithDiagnostics hsc_env mod_summary rdr_module = runHsc' hsc_env $ hsc_typecheck True mod_summary (Just rdr_module) +#endif -- ============================================================================ -- DO NOT EDIT - Refer to top of file diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index e76de880d5..39cf9e0d45 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -21,7 +21,11 @@ import GHC.Iface.Errors.Types (IfaceMessage) #endif writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () +#if MIN_VERSION_ghc(9,11,0) +writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) (Iface.flagsToIfCompression $ hsc_dflags env) fp iface +#else writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) fp iface +#endif cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc cannotFindModule env modname fr = diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 25d23bcad4..bfa519b5e0 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -16,14 +16,18 @@ module Development.IDE.GHC.Compat.Parser ( Development.IDE.GHC.Compat.Parser.pm_mod_summary, Development.IDE.GHC.Compat.Parser.pm_extra_src_files, -- * API Annotations +#if !MIN_VERSION_ghc(9,11,0) Anno.AnnKeywordId(..), +#endif pattern EpaLineComment, pattern EpaBlockComment ) where import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Util +#if !MIN_VERSION_ghc(9,11,0) import qualified GHC.Parser.Annotation as Anno +#endif import qualified GHC.Parser.Lexer as Lexer import GHC.Types.SrcLoc (PsSpan (..)) diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index f2b58ee02e..f8c6a53df1 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -87,14 +87,18 @@ readBinCoreFile name_cache fat_hi_path = do return (file, fp) -- | Write a core file -writeBinCoreFile :: FilePath -> CoreFile -> IO Fingerprint -writeBinCoreFile core_path fat_iface = do +writeBinCoreFile :: DynFlags -> FilePath -> CoreFile -> IO Fingerprint +writeBinCoreFile dflag core_path fat_iface = do bh <- openBinMem initBinMemSize let quietTrace = QuietBinIFace +#if !MIN_VERSION_ghc(9,11,0) putWithUserData quietTrace bh fat_iface +#else + putWithUserData (Iface.flagsToIfCompression dflag) quietTrace bh fat_iface +#endif -- And send the result to the file writeBinMem bh core_path From e7160a975f544edcce675a95122acaae7ae7b09c Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 16 Mar 2025 14:44:34 +0800 Subject: [PATCH 02/46] update --- ghcide/src/Development/IDE/GHC/CoreFile.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index f8c6a53df1..c9c24b73e5 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -24,6 +24,9 @@ import qualified Development.IDE.GHC.Compat.Util as Util import GHC.Core import GHC.CoreToIface import GHC.Fingerprint +#if MIN_VERSION_ghc(9,11,0) +import qualified GHC.Iface.Load as Iface +#endif import GHC.Iface.Binary import GHC.Iface.Env import GHC.Iface.Recomp.Binary (fingerprintBinMem) @@ -97,7 +100,7 @@ writeBinCoreFile dflag core_path fat_iface = do #if !MIN_VERSION_ghc(9,11,0) putWithUserData quietTrace bh fat_iface #else - putWithUserData (Iface.flagsToIfCompression dflag) quietTrace bh fat_iface + putWithUserData quietTrace (Iface.flagsToIfCompression dflag) bh fat_iface #endif -- And send the result to the file From 03f6b3c0d387fa260a0dd2d7e3f691ad95d3d68e Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 16 Mar 2025 19:30:27 +0800 Subject: [PATCH 03/46] some more update --- ghcide/src/Development/IDE/Core/Compile.hs | 18 +++++++++++-- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 18 ++++++++++--- ghcide/src/Development/IDE/GHC/CoreFile.hs | 6 ++--- ghcide/src/Development/IDE/GHC/Orphans.hs | 25 ++++++++++++++----- .../src/Development/IDE/Import/FindImports.hs | 15 ++++++++--- 5 files changed, 64 insertions(+), 18 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index de48f1fb79..907952b8b8 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -294,6 +294,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do mods_transitive_list = mapMaybe nodeKeyToInstalledModule $ Set.toList mods_transitive + -- todo: 9.12 ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) ; lbs <- getLinkables [toNormalizedFilePath' file | installedMod <- mods_transitive_list @@ -430,7 +431,14 @@ mkHiFileResultNoCompile session tcm = do details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv iface' <- mkIfaceTc hsc_env_tmp sf details ms Nothing tcGblEnv - let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface] +#if MIN_VERSION_ghc(9,11,0) + let iface = set_mi_top_env Nothing iface' + -- todo: 9.12, since usages are not expose anymore, we can't update mi_usages. +#else + let iface = iface' { + mi_globals = Nothing + , mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface] +#endif pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing mkHiFileResultCompile @@ -462,7 +470,13 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do #if MIN_VERSION_ghc(9,4,2) Nothing #endif - let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] + let final_iface = final_iface' { +#if MIN_VERSION_ghc(9,11,0) + mi_top_env = Nothing +#else + mi_globals = Nothing +#endif + , mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] -- Write the core file now core_file <- do diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index fadc8887a2..9a4b1404d3 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -68,6 +68,7 @@ module Development.IDE.GHC.Compat.Core ( IfaceExport, IfaceTyCon(..), ModIface, + pattern GHC.ModIface, ModIface_(..), HscSource(..), WhereFrom(..), @@ -365,6 +366,10 @@ module Development.IDE.GHC.Compat.Core ( getKey, module GHC.Driver.Env.KnotVars, module GHC.Linker.Types, +#if MIN_VERSION_ghc(9,11,0) + pattern LM, +#endif + module GHC.Types.Unique.Map, module GHC.Utils.TmpFs, module GHC.Unit.Finder.Types, @@ -544,6 +549,7 @@ import GHC.Utils.TmpFs import Language.Haskell.Syntax hiding (FunDep) #if MIN_VERSION_ghc(9,11,0) import System.OsPath.Types (OsPath) +import System.OsPath (unsafeEncodeUtf) #endif -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -557,12 +563,13 @@ import GHC.Types.Avail (greNamePrintableName) import GHC.Hs (SrcSpanAnn') #endif -#if !MIN_VERSION_ghc(9,11,0) mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation -#else -mkHomeModLocation :: DynFlags -> ModuleName -> OsPath -> IO Module.ModLocation +mkHomeModLocation df mn f = do +#if MIN_VERSION_ghc(9,11,0) + f <- return $ unsafeEncodeUtf f #endif -mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f + pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f + pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan @@ -806,4 +813,7 @@ lookupGlobalRdrEnv gre_env occ = lookupGRE gre_env (LookupOccName occ AllRelevan #if MIN_VERSION_ghc(9,11,0) type Unlinked = LinkablePart +pattern LM a b c = Linkable a b c #endif +-- pattern LM :: Linkable -> [Linkable] -> [Linkable] -> Linkable + diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index c9c24b73e5..5d13c06293 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -25,7 +25,7 @@ import GHC.Core import GHC.CoreToIface import GHC.Fingerprint #if MIN_VERSION_ghc(9,11,0) -import qualified GHC.Iface.Load as Iface +import qualified GHC.Iface.Load as Iface #endif import GHC.Iface.Binary import GHC.Iface.Env @@ -91,7 +91,7 @@ readBinCoreFile name_cache fat_hi_path = do -- | Write a core file writeBinCoreFile :: DynFlags -> FilePath -> CoreFile -> IO Fingerprint -writeBinCoreFile dflag core_path fat_iface = do +writeBinCoreFile _dflag core_path fat_iface = do bh <- openBinMem initBinMemSize let quietTrace = @@ -100,7 +100,7 @@ writeBinCoreFile dflag core_path fat_iface = do #if !MIN_VERSION_ghc(9,11,0) putWithUserData quietTrace bh fat_iface #else - putWithUserData quietTrace (Iface.flagsToIfCompression dflag) bh fat_iface + putWithUserData quietTrace (Iface.flagsToIfCompression _dflag) bh fat_iface #endif -- And send the result to the file diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 2ee19beeb2..ccaecab4c9 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -51,22 +51,35 @@ instance Show ModDetails where show = const "" instance NFData ModDetails where rnf = rwhnf instance NFData SafeHaskellMode where rnf = rwhnf instance Show Linkable where show = unpack . printOutputable +#if MIN_VERSION_ghc(9,11,0) +instance NFData LinkableObjectSort where rnf = rwhnf +#else instance NFData Linkable where rnf (LM a b c) = rnf a `seq` rnf b `seq` rnf c +#endif instance NFData Unlinked where +#if MIN_VERSION_ghc(9,11,0) + rnf (DotO f l) = rnf f `seq` rnf l + rnf (LazyBCOs a b) = seqCompiledByteCode a `seq` liftRnf rwhnf b + rnf (BCOs a) = seqCompiledByteCode a +#else rnf (DotO f) = rnf f + rnf (BCOs a b) = seqCompiledByteCode a `seq` liftRnf rwhnf b + rnf (LoadedBCOs us) = rnf us +#endif rnf (DotA f) = rnf f rnf (DotDLL f) = rnf f - rnf (BCOs a b) = seqCompiledByteCode a `seq` liftRnf rwhnf b #if MIN_VERSION_ghc(9,5,0) rnf (CoreBindings wcb) = rnf wcb - rnf (LoadedBCOs us) = rnf us - -instance NFData WholeCoreBindings where - rnf (WholeCoreBindings bs m ml) = rnf bs `seq` rnf m `seq` rnf ml - instance NFData ModLocation where rnf (ModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 +#endif +#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,11,0) +instance NFData WholeCoreBindings where + rnf (WholeCoreBindings bs m ml) = rnf bs `seq` rnf m `seq` rnf ml +#else +instance NFData WholeCoreBindings where + rnf (WholeCoreBindings bs m ml wf) = rnf bs `seq` rnf m `seq` rnf ml `seq` rnf wf #endif instance Show PackageFlag where show = unpack . printOutputable diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 7fa287836b..3d392cb1df 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -26,6 +26,9 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import GHC.Types.PkgQual import GHC.Unit.State +#if MIN_VERSION_ghc(9,11,0) +import GHC.Driver.DynFlags +#endif import System.FilePath @@ -91,13 +94,19 @@ locateModuleFile import_dirss exts targetFor isSource modName = do | isSource = ext ++ "-boot" | otherwise = ext +reexportedModulesFrom :: DynFlags -> S.Set ModuleName +reexportedModulesFrom flag = +#if MIN_VERSION_ghc(9,11,0) + S.fromList $ reexportFrom <$> +#endif + reexportedModules flag + -- | This function is used to map a package name to a set of import paths. -- 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 (UnitId, ([FilePath], S.Set ModuleName)) -mkImportDirs _env (i, flags) = Just (i, (importPaths flags, reexportedModules flags)) - +mkImportDirs _env (i, flags) = Just (i, (importPaths flags, reexportedModulesFrom flags)) -- | locate a module in either the file system or the package database. Where we go from *daml to -- Haskell locateModule @@ -146,7 +155,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do -- about which module unit a imports. -- Without multi-component support it is hard to recontruct the dependency environment so -- unit a will have both unit b and unit c in scope. - map (\uid -> let this_df = homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue) in (uid, importPaths this_df, reexportedModules this_df)) hpt_deps + map (\uid -> let this_df = homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue) in (uid, importPaths this_df, reexportedModulesFrom this_df)) hpt_deps ue = hsc_unit_env env units = homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId_ dflags) ue hpt_deps :: [UnitId] From a767490eea5d28dccaad9e07c73a40718a051a1d Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 16 Mar 2025 20:18:28 +0800 Subject: [PATCH 04/46] cope with lookupCache function for module location --- ghcide/src/Development/IDE/Core/Compile.hs | 46 +++++++++++++++------- 1 file changed, 32 insertions(+), 14 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 907952b8b8..33a7ac710d 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -207,6 +207,15 @@ typecheckModule (IdeDefer defer) hsc tc_helpers pm = do where demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id +lookupCache :: HscEnv -> InstalledModule -> IO (Maybe InstalledFindResult) +lookupCache hsc_env installedMod = do +#if MIN_VERSION_ghc(9,11,0) + lookupFinderCache (hsc_FC hsc_env) installedMod +#else + ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) + ; return $ lookupInstalledModuleEnv moduleLocs installedMod +#endif + -- | Install hooks to capture the splices as well as the runtime module dependencies captureSplicesAndDeps :: TypecheckHelpers -> HscEnv -> (HscEnv -> IO a) -> IO (a, Splices, ModuleEnv BS.ByteString) captureSplicesAndDeps TypecheckHelpers{..} env k = do @@ -294,14 +303,17 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do mods_transitive_list = mapMaybe nodeKeyToInstalledModule $ Set.toList mods_transitive - -- todo: 9.12 - ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) - ; lbs <- getLinkables [toNormalizedFilePath' file + -- todo: 9.12 this is inefficient + + ; lbs <- getLinkables =<< + sequence + [toNormalizedFilePath' <$> file | installedMod <- mods_transitive_list - , let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs installedMod - file = case ifr of - InstalledFound loc _ -> - fromJust $ ml_hs_file loc + , let file :: IO FilePath + file = do + ifr'<- lookupCache hsc_env installedMod + case ifr' of + Just (InstalledFound loc _) | Just l <- ml_hs_file loc -> return l _ -> panic "hscCompileCoreExprHook: module not found" ] ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env @@ -920,14 +932,19 @@ handleGenerationErrors' dflags source action = -- transitive dependencies will be contained in envs) mergeEnvs :: HscEnv -> ModuleGraph -> ModSummary -> [HomeModInfo] -> [HscEnv] -> IO HscEnv mergeEnvs env mg ms extraMods envs = do +#if !MIN_VERSION_ghc(9,11,0) 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 + newFinderCache <- concatFC curFinderCache (map hsc_FC envs) +#endif return $! loadModulesHome extraMods $ let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in (hscUpdateHUG (const newHug) env){ +#if !MIN_VERSION_ghc(9,11,0) hsc_FC = newFinderCache, +#endif hsc_mod_graph = mg } @@ -940,6 +957,7 @@ mergeEnvs env mg ms extraMods envs = do | HsSrcFile <- mi_hsc_src (hm_iface a) = a | otherwise = b +#if !MIN_VERSION_ghc(9,11,0) -- Prefer non-boot files over non-boot files -- otherwise we can get errors like https://gitlab.haskell.org/ghc/ghc/-/issues/19816 -- if a boot file shadows over a non-boot file @@ -953,6 +971,7 @@ mergeEnvs env mg ms extraMods envs = do fcModules' <- newIORef $! foldl' (plusInstalledModuleEnv combineModuleLocations) cur fcModules fcFiles' <- newIORef $! Map.unions fcFiles pure $ FinderCache fcModules' fcFiles' +#endif withBootSuffix :: HscSource -> ModLocation -> ModLocation @@ -1384,15 +1403,14 @@ parseRuntimeDeps anns = mkModuleEnv $ mapMaybe go anns -- See Note [Recompilation avoidance in the presence of TH] checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do - moduleLocs <- liftIO $ readIORef (fcModuleCache $ hsc_FC hsc_env) let go (mod, hash) = do - ifr <- lookupInstalledModuleEnv moduleLocs $ Compat.installedModule (toUnitId $ moduleUnit mod) (moduleName mod) + ifr <- lookupCache hsc_env $ Compat.installedModule (toUnitId $ moduleUnit mod) (moduleName mod) case ifr of - InstalledFound loc _ -> do - hs <- ml_hs_file loc - pure (toNormalizedFilePath' hs,hash) - _ -> Nothing - hs_files = mapM go (moduleEnvToList runtime_deps) + Just (InstalledFound loc _) | Just hs <- ml_hs_file loc -> + pure $ Just (toNormalizedFilePath' hs,hash) + _ -> return Nothing + hs_files' = liftIO $ mapM go (moduleEnvToList runtime_deps) + hs_files <- fmap sequence hs_files' case hs_files of Nothing -> error "invalid module graph" Just fs -> do From 316079c20f2ed18d01ca3fdf579ba6f635288c6f Mon Sep 17 00:00:00 2001 From: Patrick Date: Sun, 16 Mar 2025 23:53:19 +0800 Subject: [PATCH 05/46] ghcide and ghcide-test built --- ghcide/src/Development/IDE/Core/Compile.hs | 117 +++++++++++++++--- .../src/Development/IDE/Core/PluginUtils.hs | 10 +- ghcide/src/Development/IDE/Core/Rules.hs | 24 +++- ghcide/src/Development/IDE/GHC/Compat.hs | 12 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 14 ++- ghcide/src/Development/IDE/GHC/Orphans.hs | 1 + .../src/Development/IDE/Plugin/TypeLenses.hs | 2 +- 7 files changed, 158 insertions(+), 22 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 33a7ac710d..300f994ecf 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -62,11 +62,17 @@ import qualified Data.HashMap.Strict as HashMap import Data.IntMap (IntMap) import Data.IORef import Data.List.Extra +#if MIN_VERSION_ghc(9,11,0) +import qualified Data.List.NonEmpty as NE +#endif import qualified Data.Map.Strict as Map import Data.Maybe import Data.Proxy (Proxy (Proxy)) import qualified Data.Text as T import Data.Time (UTCTime (..)) +#if MIN_VERSION_ghc(9,11,0) +import Data.Time (getCurrentTime) +#endif import Data.Tuple.Extra (dupe) import Debug.Trace import Development.IDE.Core.FileStore (resetInterfaceStore) @@ -132,6 +138,10 @@ import Development.IDE.Core.FileStore (shareFilePath) #endif import Development.IDE.GHC.Compat.Driver (hscTypecheckRenameWithDiagnostics) +#if MIN_VERSION_ghc(9,11,0) +import GHC.Unit.Module.ModIface +import GHC.Unit.Finder (initFinderCache) +#endif --Simple constants to make sure the source is consistently named sourceTypecheck :: T.Text @@ -210,7 +220,7 @@ typecheckModule (IdeDefer defer) hsc tc_helpers pm = do lookupCache :: HscEnv -> InstalledModule -> IO (Maybe InstalledFindResult) lookupCache hsc_env installedMod = do #if MIN_VERSION_ghc(9,11,0) - lookupFinderCache (hsc_FC hsc_env) installedMod + lookupFinderCache (hsc_FC hsc_env) (GWIB installedMod NotBoot) #else ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) ; return $ lookupInstalledModuleEnv moduleLocs installedMod @@ -279,7 +289,11 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do ; bcos <- byteCodeGen hsc_env (icInteractiveModule ictxt) stg_expr - [] Nothing + [] + Nothing +#if MIN_VERSION_ghc(9,11,0) + [] +#endif -- Exclude wired-in names because we may not have read -- their interface files, so getLinkDeps will fail @@ -319,9 +333,16 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env {- load it -} +#if MIN_VERSION_ghc(9,11,0) + -- ; u <- uniqFromTag 'I' + ; let this_mod = mkInteractiveModule "interactive" + ; bco_time <- getCurrentTime + ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan $ Linkable bco_time this_mod $ NE.singleton $ BCOs bcos +#else ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos - ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs, lbss, pkgs) +#endif + ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs, lbss, pkgs) ; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb]) ; return hval } @@ -445,6 +466,7 @@ mkHiFileResultNoCompile session tcm = do iface' <- mkIfaceTc hsc_env_tmp sf details ms Nothing tcGblEnv #if MIN_VERSION_ghc(9,11,0) let iface = set_mi_top_env Nothing iface' + -- todo: 9.12, since usages are not expose anymore, we can't update mi_usages. #else let iface = iface' { @@ -470,25 +492,37 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do (guts, details) <- tidyProgram tidy_opts simplified_guts pure (details, guts) + -- (tcg_import_decls tc_result) + let !partial_iface = force $ mkPartialIface session #if MIN_VERSION_ghc(9,5,0) (cg_binds guts) #endif details ms +#if MIN_VERSION_ghc(9,11,0) + (tcg_import_decls $ tmrTypechecked tcm) +#endif simplified_guts + let (iface_stubs, iface_files) + | gopt Opt_WriteIfSimplifiedCore dflags = (cg_foreign guts, cg_foreign_files guts) + | otherwise = (NoStubs, []) final_iface' <- mkFullIface session partial_iface Nothing #if MIN_VERSION_ghc(9,4,2) Nothing #endif - let final_iface = final_iface' { #if MIN_VERSION_ghc(9,11,0) - mi_top_env = Nothing + iface_stubs iface_files +#endif + +#if MIN_VERSION_ghc(9,11,0) + let final_iface = set_mi_top_env Nothing final_iface' #else + let final_iface = final_iface' { mi_globals = Nothing -#endif , mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] +#endif -- Write the core file now core_file <- do @@ -652,10 +686,14 @@ generateObjectCode session summary guts = do case obj of Nothing -> throwGhcExceptionIO $ Panic "compileFile didn't generate object code" Just x -> pure x +#if MIN_VERSION_ghc(9,11,0) + let unlinked = DotO dot_o_fp ModuleObject +#else let unlinked = DotO dot_o_fp +#endif -- Need time to be the modification time for recompilation checking t <- liftIO $ getModificationTime dot_o_fp - let linkable = LM t mod [unlinked] + let linkable = LM t mod (pure unlinked) pure (map snd warnings, linkable) @@ -665,15 +703,24 @@ generateByteCode :: CoreFileTime -> HscEnv -> ModSummary -> CgGuts -> IO (IdeRes generateByteCode (CoreFileTime time) hscEnv summary guts = do fmap (either (, Nothing) (second Just)) $ catchSrcErrors (hsc_dflags hscEnv) "bytecode" $ do +#if MIN_VERSION_ghc(9,11,0) + (warnings, (_, bytecode)) <- +#else (warnings, (_, bytecode, sptEntries)) <- +#endif withWarnings "bytecode" $ \_tweak -> do let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) -- TODO: maybe settings ms_hspp_opts is unnecessary? summary' = summary { ms_hspp_opts = hsc_dflags session } hscInteractive session (mkCgInteractiveGuts guts) (ms_location summary') +#if MIN_VERSION_ghc(9,11,0) + let unlinked = BCOs bytecode + let linkable = LM time (ms_mod summary) (pure unlinked) +#else let unlinked = BCOs bytecode sptEntries let linkable = LM time (ms_mod summary) [unlinked] +#endif pure (map snd warnings, linkable) demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule @@ -774,13 +821,22 @@ atomicFileWrite se targetPath write = do (write tempFilePath >>= \x -> renameFile tempFilePath targetPath >> atomically (resetInterfaceStore se (toNormalizedFilePath' targetPath)) >> pure x) `onException` cleanUp +#if !MIN_VERSION_ghc(9,11,0) generateHieAsts :: HscEnv -> TcModuleResult -> IO ([FileDiagnostic], Maybe (HieASTs Type)) +#else +generateHieAsts :: HscEnv -> TcModuleResult -> IO ([FileDiagnostic], Maybe ((HieASTs Type), NameEntityInfo)) +#endif generateHieAsts hscEnv tcm = handleGenerationErrors' dflags "extended interface generation" $ runHsc hscEnv $ do -- These varBinds use unitDataConId but it could be anything as the id name is not used -- during the hie file generation process. It's a workaround for the fact that the hie modules -- don't export an interface which allows for additional information to be added to hie files. - let fake_splice_binds = Util.listToBag (map (mkVarBind unitDataConId) (spliceExpressions $ tmrTopLevelSplices tcm)) + let + fake_splice_binds = +#if !MIN_VERSION_ghc(9,11,0) + Util.listToBag +#endif + (map (mkVarBind unitDataConId) (spliceExpressions $ tmrTopLevelSplices tcm)) real_binds = tcg_binds $ tmrTypechecked tcm ts = tmrTypechecked tcm :: TcGblEnv top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind @@ -788,7 +844,12 @@ generateHieAsts hscEnv tcm = tcs = tcg_tcs ts :: [TyCon] pure $ Just $ +#if MIN_VERSION_ghc(9,11,0) + GHC.enrichHie (fake_splice_binds ++ real_binds) (tmrRenamed tcm) top_ev_binds insts tcs + (tcg_type_env $ tmrTypechecked tcm) +#else GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs +#endif where dflags = hsc_dflags hscEnv @@ -876,7 +937,13 @@ indexHieFile se mod_summary srcPath !hash hf = do toJSON $ fromNormalizedFilePath srcPath whenJust mdone $ \_ -> progressUpdate indexProgressReporting ProgressCompleted -writeAndIndexHieFile :: HscEnv -> ShakeExtras -> ModSummary -> NormalizedFilePath -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic] +writeAndIndexHieFile :: HscEnv -> ShakeExtras -> ModSummary -> NormalizedFilePath -> [GHC.AvailInfo] +#if MIN_VERSION_ghc(9,11,0) + -> (HieASTs Type, NameEntityInfo) +#else + -> HieASTs Type +#endif + -> BS.ByteString -> IO [FileDiagnostic] writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source = handleGenerationErrors dflags "extended interface write/compression" $ do hf <- runHsc hscEnv $ @@ -932,11 +999,10 @@ handleGenerationErrors' dflags source action = -- transitive dependencies will be contained in envs) mergeEnvs :: HscEnv -> ModuleGraph -> ModSummary -> [HomeModInfo] -> [HscEnv] -> IO HscEnv mergeEnvs env mg ms extraMods envs = do -#if !MIN_VERSION_ghc(9,11,0) 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 - +#if !MIN_VERSION_ghc(9,11,0) newFinderCache <- concatFC curFinderCache (map hsc_FC envs) #endif return $! loadModulesHome extraMods $ @@ -957,13 +1023,12 @@ mergeEnvs env mg ms extraMods envs = do | HsSrcFile <- mi_hsc_src (hm_iface a) = a | otherwise = b -#if !MIN_VERSION_ghc(9,11,0) -- Prefer non-boot files over non-boot files -- otherwise we can get errors like https://gitlab.haskell.org/ghc/ghc/-/issues/19816 -- if a boot file shadows over a non-boot file combineModuleLocations a@(InstalledFound ml _) _ | Just fp <- ml_hs_file ml, not ("boot" `isSuffixOf` fp) = a combineModuleLocations _ b = b - +#if !MIN_VERSION_ghc(9,11,0) concatFC :: FinderCacheState -> [FinderCache] -> IO FinderCache concatFC cur xs = do fcModules <- mapM (readIORef . fcModuleCache) xs @@ -971,9 +1036,31 @@ mergeEnvs env mg ms extraMods envs = do fcModules' <- newIORef $! foldl' (plusInstalledModuleEnv combineModuleLocations) cur fcModules fcFiles' <- newIORef $! Map.unions fcFiles pure $ FinderCache fcModules' fcFiles' +#else + addFinderCacheState :: FinderCacheState -> FinderCache -> IO () + addFinderCacheState state cache = mapM_ ((\(m, r) -> addToFinderCache cache m r)) (first (\x -> GWIB x NotBoot) <$> installedModuleEnvElts state) + + mergeFinderCache :: FinderCache -> FinderCache -> FinderCache + mergeFinderCache c2 c1 = FinderCache + { flushFinderCaches = \u -> flushFinderCaches c1 u + , addToFinderCache = \m r -> addToFinderCache c1 m r + , lookupFinderCache = \m -> do + lookupFinderCache c1 m >>= \case + Just r -> return (Just r) + Nothing -> lookupFinderCache c2 m + , lookupFileCache = \f -> do + lookupFileCache c1 f `catchIO` \_ -> lookupFileCache c2 f + } + -- use mergeFinderCache and addFinderCacheState + concatFC :: FinderCacheState -> [FinderCache] -> IO FinderCache + concatFC state caches = do + finderCache <- initFinderCache + addFinderCacheState state finderCache + return $ foldr mergeFinderCache finderCache caches #endif + withBootSuffix :: HscSource -> ModLocation -> ModLocation withBootSuffix HsBootFile = addBootSuffixLocnOut withBootSuffix _ = id @@ -1453,7 +1540,9 @@ coreFileToCgGuts session iface details core_file = do -- Implicit binds aren't saved, so we need to regenerate them ourselves. let _implicit_binds = concatMap getImplicitBinds tyCons -- only used if GHC < 9.6 tyCons = typeEnvTyCons (md_types details) -#if MIN_VERSION_ghc(9,5,0) +#if MIN_VERSION_ghc(9,11,0) + pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty Nothing [] +#elif MIN_VERSION_ghc(9,5,0) -- In GHC 9.6, the implicit binds are tidied and part of core_binds pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #else diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 6ba633df26..2b8e2cbfef 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -52,7 +52,7 @@ import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import Development.IDE.Types.Diagnostics -import Development.IDE.Types.Location (NormalizedFilePath) +import Development.IDE.Types.Location (NormalizedFilePath, Range) import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error @@ -62,6 +62,8 @@ import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message (SMethod (..)) import qualified Language.LSP.Protocol.Types as LSP import qualified StmContainers.Map as STM +import qualified Language.LSP.Protocol.Lens as L +import Ide.Types (FormattingMethod, FormattingHandler, PluginHandlers, PluginMethodHandler, mkPluginHandler, FormattingType (FormatText, FormatRange)) -- ---------------------------------------------------------------------------- -- Action wrappers @@ -180,6 +182,12 @@ fromCurrentRangeE mapping = maybeToExceptT (PluginInvalidUserState "fromCurrentR fromCurrentRangeMT :: Monad m => PositionMapping -> LSP.Range -> MaybeT m LSP.Range fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping + +-- todo:9.12 same as Ide.PluginUtils (rangesOverlap), migrate later +-- import Ide.PluginUtils (rangesOverlap) +rangesOverlap :: Range -> Range -> Bool +rangesOverlap r1 r2 = + r1 ^. L.start <= r2 ^. L.end && r2 ^. L.start <= r1 ^. L.end -- ---------------------------------------------------------------------------- -- Diagnostics -- ---------------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 5650300a4c..716adc1be6 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -519,7 +519,12 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult) getHieAstRuleDefinition f hsc tmr = do - (diags, masts) <- liftIO $ generateHieAsts hsc tmr +#if MIN_VERSION_ghc(9,11,0) + (diags, mastsFull) <- liftIO $ generateHieAsts hsc tmr + let masts = fst <$> mastsFull +#else + (diags, mastsFull@masts) <- liftIO $ generateHieAsts hsc tmr +#endif se <- getShakeExtras isFoi <- use_ IsFileOfInterest f @@ -529,7 +534,7 @@ getHieAstRuleDefinition f hsc tmr = do LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/reference/ready")) $ toJSON $ fromNormalizedFilePath f pure [] - _ | Just asts <- masts -> do + _ | Just asts <- mastsFull -> do source <- getSourceFileSource f let exports = tcg_exports $ tmrTypechecked tmr modSummary = tmrModSummary tmr @@ -1063,7 +1068,12 @@ getLinkableRule recorder = else pure Nothing case mobj_time of Just obj_t - | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod hirModSummary) [DotO obj_file])) + | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod hirModSummary) + $ pure (DotO obj_file +#if MIN_VERSION_ghc(9,11,0) + ModuleObject +#endif + ))) _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) hirModSummary hirModIface hirModDetails bin_core (error "object doesn't have time") -- Record the linkable so we know not to unload it, and unload old versions whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do @@ -1080,7 +1090,13 @@ getLinkableRule recorder = --just before returning it to be loaded. This has a substantial effect on recompile --times as the number of loaded modules and splices increases. -- - unload (hscEnv session) (map (\(mod', time') -> LM time' mod' []) $ moduleEnvToList to_keep) + unload (hscEnv session) (map (\(mod', time') -> LM time' mod' +#if MIN_VERSION_ghc(9,11,0) + $ pure (DotO obj_file ModuleObject)) +#else + $ pure (DotO obj_file)) +#endif + $ moduleEnvToList to_keep) return (to_keep, ()) return (fileHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure fileHash)) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 5f66625ee5..8336ecafcd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -338,10 +338,20 @@ type NameCacheUpdater = NameCache mkHieFile' :: ModSummary -> [Avail.AvailInfo] +#if MIN_VERSION_ghc(9,11,0) + -> (HieASTs Type, NameEntityInfo) +#else -> HieASTs Type +#endif -> BS.ByteString -> Hsc HieFile -mkHieFile' ms exports asts src = do +mkHieFile' ms exports +#if MIN_VERSION_ghc(9,11,0) + (asts, entityInfo) +#else + asts +#endif + src = do let Just src_file = ml_hs_file $ ms_location ms (asts',arr) = compressTypes asts return $ HieFile diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 9a4b1404d3..ef857888cb 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -167,6 +167,7 @@ module Development.IDE.GHC.Compat.Core ( Development.IDE.GHC.Compat.Core.initTidyOpts, driverNoStop, tidyProgram, + tidyOpenType, ImportedModsVal(..), importedByUser, GHC.TypecheckedSource, @@ -427,7 +428,8 @@ import GHC.Core.Predicate import GHC.Core.TyCo.Ppr import qualified GHC.Core.TyCo.Rep as TyCoRep import GHC.Core.TyCon -import GHC.Core.Type +import GHC.Core.Type hiding (tidyOpenType) +import qualified GHC.Core.Type as GHC.Core.Type import GHC.Core.Unify import GHC.Core.Utils import GHC.Driver.CmdLine (Warn (..)) @@ -547,6 +549,7 @@ import GHC.Utils.Error (mkPlainErrorMsgEnvelope) import GHC.Utils.Panic import GHC.Utils.TmpFs import Language.Haskell.Syntax hiding (FunDep) +import GHC.Types.Var.Env (TidyEnv) #if MIN_VERSION_ghc(9,11,0) import System.OsPath.Types (OsPath) import System.OsPath (unsafeEncodeUtf) @@ -814,6 +817,15 @@ lookupGlobalRdrEnv gre_env occ = lookupGRE gre_env (LookupOccName occ AllRelevan #if MIN_VERSION_ghc(9,11,0) type Unlinked = LinkablePart pattern LM a b c = Linkable a b c +{-# COMPLETE LM #-} +-- state that it is complete #endif -- pattern LM :: Linkable -> [Linkable] -> [Linkable] -> Linkable + +tidyOpenType :: TidyEnv -> Type -> Type +#if !MIN_VERSION_ghc(9,11,0) +tidyOpenType x = snd . GHC.Core.Type.tidyOpenType x +#else +tidyOpenType = GHC.Core.Type.tidyOpenType +#endif diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index ccaecab4c9..598fa956ea 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -53,6 +53,7 @@ instance NFData SafeHaskellMode where rnf = rwhnf instance Show Linkable where show = unpack . printOutputable #if MIN_VERSION_ghc(9,11,0) instance NFData LinkableObjectSort where rnf = rwhnf +instance NFData Linkable where rnf (LM a b c) = rnf a `seq` rnf b `seq` rnf c #else instance NFData Linkable where rnf (LM a b c) = rnf a `seq` rnf b `seq` rnf c #endif diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index a1aa237de8..5c281eb4f8 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -321,7 +321,7 @@ gblBindingType (Just hsc) (Just gblEnv) = do let name = idName identifier hasSig name $ do env <- tcInitTidyEnv - let (_, ty) = tidyOpenType env (idType identifier) + let ty = tidyOpenType env (idType identifier) pure $ GlobalBindingTypeSig name (printName name <> " :: " <> showDoc (pprSigmaType ty)) (name `elemNameSet` exports) patToSig p = do let name = patSynName p From f822964401e1cedcd698fc4cddc5c5f9df8feda4 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 00:55:18 +0800 Subject: [PATCH 06/46] remove unused import of rangesOverlap from PluginUtils --- ghcide/src/Development/IDE/Core/PluginUtils.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 2b8e2cbfef..e16a3cc342 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -56,7 +56,6 @@ import Development.IDE.Types.Location (NormalizedFilePath, Range import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error -import Ide.PluginUtils (rangesOverlap) import Ide.Types import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message (SMethod (..)) From 0f5df9433aea8f8b02db60462f18b0a8feb137f2 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 01:33:25 +0800 Subject: [PATCH 07/46] managed to build in 9.12.2 without `SMethod_TextDocumentImplementation` --- ghcide/src/Development/IDE/Core/PluginUtils.hs | 3 +-- ghcide/src/Development/IDE/GHC/Compat.hs | 5 ++++- ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs | 4 ++-- ghcide/test/exe/UnitTests.hs | 4 ++-- 4 files changed, 9 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index e16a3cc342..a7185b7101 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -56,13 +56,12 @@ import Development.IDE.Types.Location (NormalizedFilePath, Range import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error -import Ide.Types import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message (SMethod (..)) import qualified Language.LSP.Protocol.Types as LSP import qualified StmContainers.Map as STM import qualified Language.LSP.Protocol.Lens as L -import Ide.Types (FormattingMethod, FormattingHandler, PluginHandlers, PluginMethodHandler, mkPluginHandler, FormattingType (FormatText, FormatRange)) +import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) -- ---------------------------------------------------------------------------- -- Action wrappers diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 8336ecafcd..81b821e022 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -454,13 +454,16 @@ data GhcVersion | GHC96 | GHC98 | GHC910 + | GHC912 deriving (Eq, Ord, Show, Enum) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion -#if MIN_VERSION_GLASGOW_HASKELL(9,10,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,12,0,0) +ghcVersion = GHC912 +#elif MIN_VERSION_GLASGOW_HASKELL(9,10,0,0) ghcVersion = GHC910 #elif MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) ghcVersion = GHC98 diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index ada0f9e682..8fe0f9e412 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -51,8 +51,8 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) Hover.gotoDefinition recorder ide TextDocumentPositionParams{..}) <> mkPluginHandler SMethod_TextDocumentTypeDefinition (\ide _ TypeDefinitionParams{..} -> Hover.gotoTypeDefinition recorder ide TextDocumentPositionParams{..}) - <> mkPluginHandler SMethod_TextDocumentImplementation (\ide _ ImplementationParams{..} -> - Hover.gotoImplementation recorder ide TextDocumentPositionParams{..}) + -- <> mkPluginHandler SMethod_TextDocumentImplementation (\ide _ ImplementationParams{..} -> + -- Hover.gotoImplementation recorder ide TextDocumentPositionParams{..}) <> mkPluginHandler SMethod_TextDocumentDocumentHighlight (\ide _ DocumentHighlightParams{..} -> Hover.documentHighlight recorder ide TextDocumentPositionParams{..}) <> mkPluginHandler SMethod_TextDocumentReferences (Hover.references recorder) diff --git a/ghcide/test/exe/UnitTests.hs b/ghcide/test/exe/UnitTests.hs index b2940ab27f..c59ec449b4 100644 --- a/ghcide/test/exe/UnitTests.hs +++ b/ghcide/test/exe/UnitTests.hs @@ -30,7 +30,7 @@ import System.IO.Extra hiding (withTempDir) import System.Mem (performGC) import Test.Hls (IdeState, def, runSessionWithServerInTmpDir, - waitForProgressDone) + waitForProgressDone, GhcVersion (GHC912), knownBrokenForGhcVersions) import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit @@ -97,7 +97,7 @@ tests = do let msg = printf "Timestamps do not have millisecond resolution: %dus" resolution_us assertBool msg (resolution_us <= 1000) , Progress.tests - , FuzzySearch.tests + , knownBrokenForGhcVersions [GHC912] "referenceImplementation get stuck" FuzzySearch.tests ] findResolution_us :: Int -> IO Int From e795722fd5777aa6e07b9f797e95f0f6faed5f70 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 08:48:31 +0800 Subject: [PATCH 08/46] add os-string dependency to ghcide.cabal --- ghcide/ghcide.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index af9a191406..6e2d8ee5c8 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -92,6 +92,7 @@ library , mtl , opentelemetry >=0.6.1 , optparse-applicative + , os-string , parallel , prettyprinter >=1.7 , prettyprinter-ansi-terminal From 97178a2779ea9f4e96620b7f87b201143b2f54d6 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 09:21:41 +0800 Subject: [PATCH 09/46] update --- ghcide/session-loader/Development/IDE/Session.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index a1768be564..50a30c6ad2 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -124,6 +124,10 @@ import GHC.Types.Error (errMsgDiagnostic, singleMessage) import GHC.Unit.State +#if MIN_VERSION_ghc(9,13,0) +import GHC.Driver.Make (checkHomeUnitsClosed) +#endif + data Log = LogSettingInitialDynFlags | LogGetInitialGhcLibDirDefaultCradleFail !CradleError !FilePath !(Maybe FilePath) !(Cradle Void) @@ -782,6 +786,11 @@ toFlagsMap TargetDetails{..} = setNameCache :: NameCache -> HscEnv -> HscEnv setNameCache nc hsc = hsc { hsc_NC = nc } +#if MIN_VERSION_ghc(9,13,0) +-- Moved back to implementation in GHC. +checkHomeUnitsClosed' :: UnitEnv -> OS.Set UnitId -> [DriverMessages] +checkHomeUnitsClosed' ue _ = checkHomeUnitsClosed ue +#elif MIN_VERSION_ghc(9,3,0) -- This function checks the important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -- GHC had an implementation of this function, but it was horribly inefficient @@ -838,6 +847,7 @@ checkHomeUnitsClosed' ue home_id_set Just depends -> let todo'' = (depends OS.\\ done) `OS.union` todo' in DigraphNode uid uid (OS.toList depends) : go (OS.insert uid done) todo'' +#endif -- | Create a mapping from FilePaths to HscEnvEqs -- This combines all the components we know about into From 8721e995c09ae38a3c272791b7ca570aedb18949 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 11:05:39 +0800 Subject: [PATCH 10/46] update ghcide --- ghcide/src/Development/IDE/Core/Compile.hs | 293 +++++++++++++----- ghcide/src/Development/IDE/Core/RuleTypes.hs | 8 + ghcide/src/Development/IDE/Core/Rules.hs | 75 +++-- ghcide/src/Development/IDE/GHC/CPP.hs | 10 +- ghcide/src/Development/IDE/GHC/Compat.hs | 25 +- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 40 ++- .../src/Development/IDE/GHC/Compat/Units.hs | 44 ++- ghcide/src/Development/IDE/GHC/CoreFile.hs | 22 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 16 +- .../IDE/Import/DependencyInformation.hs | 1 + .../src/Development/IDE/Import/FindImports.hs | 7 +- 11 files changed, 404 insertions(+), 137 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 300f994ecf..5143d3da11 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -143,6 +143,16 @@ import GHC.Unit.Module.ModIface import GHC.Unit.Finder (initFinderCache) #endif +#if MIN_VERSION_ghc(9,13,0) +import GHC.Unit.Home.Graph as HUG +import GHC.Unit.Home.PackageTable +import GHC.Driver.Env (hscInsertHPT) +#endif + +import Development.IDE.Import.DependencyInformation +import GHC.Driver.Env ( hsc_all_home_unit_ids ) +import Development.IDE.Import.FindImports + --Simple constants to make sure the source is consistently named sourceTypecheck :: T.Text sourceTypecheck = "typecheck" @@ -178,9 +188,10 @@ computePackageDeps env pkg = do ] Just pkgInfo -> return $ Right $ unitDepends pkgInfo -newtype TypecheckHelpers +data TypecheckHelpers = TypecheckHelpers { getLinkables :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files + , getModuleGraph :: IO DependencyInformation } typecheckModule :: IdeDefer @@ -316,33 +327,41 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do -- If we don't support multiple home units, ModuleNames are sufficient because all the units will be the same mods_transitive_list = mapMaybe nodeKeyToInstalledModule $ Set.toList mods_transitive - - -- todo: 9.12 this is inefficient - - ; lbs <- getLinkables =<< - sequence - [toNormalizedFilePath' <$> file +#if MIN_VERSION_ghc(9,11,0) + ; moduleLocs <- getModuleGraph +#else + ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) +#endif + ; lbs <- getLinkables [file | installedMod <- mods_transitive_list - , let file :: IO FilePath - file = do - ifr'<- lookupCache hsc_env installedMod - case ifr' of - Just (InstalledFound loc _) | Just l <- ml_hs_file loc -> return l +#if MIN_VERSION_ghc(9,11,0) + , let file = fromJust $ lookupModuleFile (installedMod { moduleUnit = RealUnit (Definite $ moduleUnit installedMod) }) moduleLocs +#else + , let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs installedMod + file = toNormalizedFilePath' $ case ifr of + InstalledFound loc _ -> + fromJust $ ml_hs_file loc _ -> panic "hscCompileCoreExprHook: module not found" +#endif ] +#if MIN_VERSION_ghc(9,13,0) + ; loadModulesHome (map linkableHomeMod lbs) hsc_env +#else ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env +#endif {- load it -} #if MIN_VERSION_ghc(9,11,0) - -- ; u <- uniqFromTag 'I' - ; let this_mod = mkInteractiveModule "interactive" ; bco_time <- getCurrentTime - ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan $ Linkable bco_time this_mod $ NE.singleton $ BCOs bcos + ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env) hsc_env srcspan $ + Linkable bco_time (icInteractiveModule ictxt) $ NE.singleton $ BCOs bcos + ; let hval = ((expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs), lbss, pkgs) #else + {- 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) #endif - ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs, lbss, pkgs) ; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb]) ; return hval } @@ -359,10 +378,19 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do -- Compute the transitive set of linkables required getTransitiveMods hsc_env needed_mods +#if MIN_VERSION_ghc(9,13,0) + = Set.unions (Set.fromList (map moduleToNodeKey mods) : [ Set.fromList $ map mkNodeKey dep + | m <- mods + , Just dep <- + [mgReachable (hsc_mod_graph hsc_env) (moduleToNodeKey m)] + ]) + where mods = nonDetEltsUniqSet needed_mods -- OK because we put them into a set immediately after +#else = 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 +#endif -- | Add a Hook to the DynFlags which captures and returns the -- typechecked splices before they are run. This information @@ -464,14 +492,13 @@ mkHiFileResultNoCompile session tcm = do details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv iface' <- mkIfaceTc hsc_env_tmp sf details ms Nothing tcGblEnv + -- See Note [Clearing mi_globals after generating an iface] + let iface = iface' #if MIN_VERSION_ghc(9,11,0) - let iface = set_mi_top_env Nothing iface' - - -- todo: 9.12, since usages are not expose anymore, we can't update mi_usages. + & set_mi_top_env Nothing + & set_mi_usages (filterUsages (mi_usages iface')) #else - let iface = iface' { - mi_globals = Nothing - , mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface] + { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } #endif pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing @@ -504,24 +531,21 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do (tcg_import_decls $ tmrTypechecked tcm) #endif simplified_guts - let (iface_stubs, iface_files) - | gopt Opt_WriteIfSimplifiedCore dflags = (cg_foreign guts, cg_foreign_files guts) - | otherwise = (NoStubs, []) final_iface' <- mkFullIface session partial_iface Nothing #if MIN_VERSION_ghc(9,4,2) Nothing #endif #if MIN_VERSION_ghc(9,11,0) - iface_stubs iface_files + NoStubs [] #endif - + -- See Note [Clearing mi_globals after generating an iface] + let final_iface = final_iface' #if MIN_VERSION_ghc(9,11,0) - let final_iface = set_mi_top_env Nothing final_iface' + & set_mi_top_env Nothing + & set_mi_usages (filterUsages (mi_usages final_iface')) #else - let final_iface = final_iface' { - mi_globals = Nothing - , mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] + {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} #endif -- Write the core file now @@ -530,7 +554,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do core_file = codeGutsToCoreFile iface_hash guts iface_hash = getModuleHash final_iface core_hash1 <- atomicFileWrite se core_fp $ \fp -> - writeBinCoreFile (ms_hspp_opts ms) fp core_file + writeBinCoreFile (hsc_dflags session) fp core_file -- We want to drop references to guts and read in a serialized, compact version -- of the core file from disk (as it is deserialised lazily) -- This is because we don't want to keep the guts in memory for every file in @@ -716,11 +740,10 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = do (ms_location summary') #if MIN_VERSION_ghc(9,11,0) let unlinked = BCOs bytecode - let linkable = LM time (ms_mod summary) (pure unlinked) #else let unlinked = BCOs bytecode sptEntries - let linkable = LM time (ms_mod summary) [unlinked] #endif + let linkable = LM time (ms_mod summary) $ pure unlinked pure (map snd warnings, linkable) demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule @@ -831,25 +854,27 @@ generateHieAsts hscEnv tcm = -- These varBinds use unitDataConId but it could be anything as the id name is not used -- during the hie file generation process. It's a workaround for the fact that the hie modules -- don't export an interface which allows for additional information to be added to hie files. - let - fake_splice_binds = + let fake_splice_binds = #if !MIN_VERSION_ghc(9,11,0) - Util.listToBag + Util.listToBag $ #endif - (map (mkVarBind unitDataConId) (spliceExpressions $ tmrTopLevelSplices tcm)) + map (mkVarBind unitDataConId) (spliceExpressions $ tmrTopLevelSplices tcm) real_binds = tcg_binds $ tmrTypechecked tcm + all_binds = +#if MIN_VERSION_ghc(9,11,0) + fake_splice_binds ++ real_binds +#else + fake_splice_binds `Util.unionBags` real_binds +#endif ts = tmrTypechecked tcm :: TcGblEnv top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind insts = tcg_insts ts :: [ClsInst] tcs = tcg_tcs ts :: [TyCon] - - pure $ Just $ + hie_asts = GHC.enrichHie all_binds (tmrRenamed tcm) top_ev_binds insts tcs #if MIN_VERSION_ghc(9,11,0) - GHC.enrichHie (fake_splice_binds ++ real_binds) (tmrRenamed tcm) top_ev_binds insts tcs - (tcg_type_env $ tmrTypechecked tcm) -#else - GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs + $ tcg_type_env ts #endif + pure $ Just hie_asts where dflags = hsc_dflags hscEnv @@ -997,20 +1022,103 @@ handleGenerationErrors' dflags source action = -- 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) -mergeEnvs :: HscEnv -> ModuleGraph -> ModSummary -> [HomeModInfo] -> [HscEnv] -> IO HscEnv -mergeEnvs env mg ms extraMods envs = do +mergeEnvs :: HscEnv + -> ModuleGraph + -> DependencyInformation + -> ModSummary + -> [HomeModInfo] + -> [HscEnv] + -> IO HscEnv +mergeEnvs env mg dep_info ms extraMods envs = do +#if MIN_VERSION_ghc(9,13,0) + newHug <- sequence $ foldl' mergeHUG (pure <$> hsc_HUG env) (map (fmap pure . hsc_HUG) envs) + let hsc_env' = (hscUpdateHUG (const newHug) env){ + hsc_mod_graph = mg, + hsc_FC = (hsc_FC env) + { addToFinderCache = \im val -> + if moduleUnit im `elem` hsc_all_home_unit_ids env + then pure () + else addToFinderCache (hsc_FC env) im val + , lookupFinderCache = \im -> + if moduleUnit im `elem` hsc_all_home_unit_ids env + then case lookupModuleFile (im { moduleUnit = RealUnit (Definite $ moduleUnit im) }) dep_info of + Nothing -> pure Nothing + Just fs -> let ml = fromJust $ do + id <- lookupPathToId (depPathIdMap dep_info) fs + artifactModLocation (idToModLocation (depPathIdMap dep_info) id) + in pure $ Just $ InstalledFound ml + else lookupFinderCache (hsc_FC env) im + {- + , lookupFileCache = \fp -> + case lookup fp dependentHashes of + Just res -> return res + Nothing -> lookupFileCache (hsc_FC env) fp + -} + } + } + loadModulesHome extraMods hsc_env' + return hsc_env' + + where + mergeHUG :: UnitEnvGraph (IO HomeUnitEnv) -> UnitEnvGraph (IO HomeUnitEnv) -> UnitEnvGraph (IO HomeUnitEnv) + mergeHUG (UnitEnvGraph a) (UnitEnvGraph b) = UnitEnvGraph $ Map.unionWith mergeHUE a b + mergeHUE a b = do + a_v <- a + hpt_b <- readIORef . hptInternalTableRef . homeUnitEnv_hpt =<< b + hpt_a <- readIORef . hptInternalTableRef . homeUnitEnv_hpt $ a_v + result <- hptInternalTableFromRef =<< (newIORef $! mergeUDFM hpt_a hpt_b) + return $! a_v { homeUnitEnv_hpt = result } + mergeUDFM = plusUDFM_C combineModules + combineModules a b + | HsSrcFile <- mi_hsc_src (hm_iface a) = a + | otherwise = b + +#elif MIN_VERSION_ghc(9,11,0) + return $! loadModulesHome extraMods $ + let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in + (hscUpdateHUG (const newHug) env){ + hsc_mod_graph = mg, + hsc_FC = (hsc_FC env) + { addToFinderCache = \gwib@(GWIB im _) val -> + if moduleUnit im `elem` hsc_all_home_unit_ids env + then pure () + else addToFinderCache (hsc_FC env) gwib val + , lookupFinderCache = \gwib@(GWIB im _) -> + if moduleUnit im `elem` hsc_all_home_unit_ids env + then case lookupModuleFile (im { moduleUnit = RealUnit (Definite $ moduleUnit im) }) dep_info of + Nothing -> pure Nothing + Just fs -> let ml = fromJust $ do + id <- lookupPathToId (depPathIdMap dep_info) fs + artifactModLocation (idToModLocation (depPathIdMap dep_info) id) + in pure $ Just $ InstalledFound ml im + else lookupFinderCache (hsc_FC env) gwib + {- + , lookupFileCache = \fp -> + case lookup fp dependentHashes of + Just res -> return res + Nothing -> lookupFileCache (hsc_FC env) fp + -} + } + } + + 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 + +#elif MIN_VERSION_ghc(9,3,0) 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 -#if !MIN_VERSION_ghc(9,11,0) newFinderCache <- concatFC curFinderCache (map hsc_FC envs) -#endif return $! loadModulesHome extraMods $ let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in (hscUpdateHUG (const newHug) env){ -#if !MIN_VERSION_ghc(9,11,0) hsc_FC = newFinderCache, -#endif hsc_mod_graph = mg } @@ -1028,7 +1136,7 @@ mergeEnvs env mg ms extraMods envs = do -- if a boot file shadows over a non-boot file combineModuleLocations a@(InstalledFound ml _) _ | Just fp <- ml_hs_file ml, not ("boot" `isSuffixOf` fp) = a combineModuleLocations _ b = b -#if !MIN_VERSION_ghc(9,11,0) + concatFC :: FinderCacheState -> [FinderCache] -> IO FinderCache concatFC cur xs = do fcModules <- mapM (readIORef . fcModuleCache) xs @@ -1036,30 +1144,32 @@ mergeEnvs env mg ms extraMods envs = do fcModules' <- newIORef $! foldl' (plusInstalledModuleEnv combineModuleLocations) cur fcModules fcFiles' <- newIORef $! Map.unions fcFiles pure $ FinderCache fcModules' fcFiles' -#else - addFinderCacheState :: FinderCacheState -> FinderCache -> IO () - addFinderCacheState state cache = mapM_ ((\(m, r) -> addToFinderCache cache m r)) (first (\x -> GWIB x NotBoot) <$> installedModuleEnvElts state) - - mergeFinderCache :: FinderCache -> FinderCache -> FinderCache - mergeFinderCache c2 c1 = FinderCache - { flushFinderCaches = \u -> flushFinderCaches c1 u - , addToFinderCache = \m r -> addToFinderCache c1 m r - , lookupFinderCache = \m -> do - lookupFinderCache c1 m >>= \case - Just r -> return (Just r) - Nothing -> lookupFinderCache c2 m - , lookupFileCache = \f -> do - lookupFileCache c1 f `catchIO` \_ -> lookupFileCache c2 f - } - -- use mergeFinderCache and addFinderCacheState - concatFC :: FinderCacheState -> [FinderCache] -> IO FinderCache - concatFC state caches = do - finderCache <- initFinderCache - addFinderCacheState state finderCache - return $ foldr mergeFinderCache finderCache caches -#endif +#else + prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs + let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms)) + ifr = InstalledFound (ms_location ms) im + newFinderCache <- newIORef $! Compat.extendInstalledModuleEnv prevFinderCache im ifr + return $! loadModulesHome extraMods $ + env{ + hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs, + hsc_FC = newFinderCache, + hsc_mod_graph = mg + } + where + mergeUDFM = plusUDFM_C combineModules + combineModules a b + | HsSrcFile <- mi_hsc_src (hm_iface a) = a + | otherwise = b + -- required because 'FinderCache': + -- 1) doesn't have a 'Monoid' instance, + -- 2) is abstract and doesn't export constructors + -- To work around this, we coerce to the underlying type + -- 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 @@ -1104,16 +1214,24 @@ getModSummaryFromImports env fp _modTime mContents = do 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 ppEnv) 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 -- Force bits that might keep the string buffer and DynFlags alive unnecessarily @@ -1134,7 +1252,9 @@ getModSummaryFromImports env fp _modTime mContents = do { ms_mod = modl , ms_hie_date = Nothing , ms_dyn_obj_date = Nothing +#if !MIN_VERSION_ghc(9,13,0) , ms_ghc_prim_import = ghc_prim_import +#endif , ms_hs_hash = _src_hash , ms_hsc_src = sourceType @@ -1369,6 +1489,7 @@ data RecompilationInfo m , old_value :: Maybe (HiFileResult, FileVersion) , get_file_version :: NormalizedFilePath -> m (Maybe FileVersion) , get_linkable_hashes :: [NormalizedFilePath] -> m [BS.ByteString] + , get_module_graph :: m DependencyInformation , regenerate :: Maybe LinkableType -> m ([FileDiagnostic], Maybe HiFileResult) -- ^ Action to regenerate an interface } @@ -1425,7 +1546,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do _read_dflags = hsc_dflags sessionWithMsDynFlags read_result <- liftIO $ readIface _read_dflags _ncu mod iface_file case read_result of - Util.Failed{} -> return Nothing + Util.Failed{} -> return Nothing -- important to call `shareUsages` here before checkOldIface -- consults `mi_usages` Util.Succeeded iface -> return $ Just (shareUsages iface) @@ -1451,7 +1572,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do | not (mi_used_th iface) = emptyModuleEnv | otherwise = parseRuntimeDeps (md_anns details) -- Peform the fine grained recompilation check for TH - maybe_recomp <- checkLinkableDependencies session get_linkable_hashes runtime_deps + maybe_recomp <- checkLinkableDependencies session get_linkable_hashes get_module_graph runtime_deps case maybe_recomp of Just msg -> do_regenerate msg Nothing @@ -1488,16 +1609,22 @@ parseRuntimeDeps anns = mkModuleEnv $ mapMaybe go anns -- the runtime dependencies of the module, to check if any of them are out of date -- Hopefully 'runtime_deps' will be empty if the module didn't actually use TH -- See Note [Recompilation avoidance in the presence of TH] -checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) -checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do +checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) +checkLinkableDependencies hsc_env get_linkable_hashes get_module_graph runtime_deps = do +#if MIN_VERSION_ghc(9,11,0) + graph <- get_module_graph + let go (mod, hash) = (,hash) <$> lookupModuleFile mod graph +#else + moduleLocs <- liftIO $ readIORef (fcModuleCache $ hsc_FC hsc_env) let go (mod, hash) = do - ifr <- lookupCache hsc_env $ Compat.installedModule (toUnitId $ moduleUnit mod) (moduleName mod) + ifr <- lookupInstalledModuleEnv moduleLocs $ Compat.installedModule (toUnitId $ moduleUnit mod) (moduleName mod) case ifr of - Just (InstalledFound loc _) | Just hs <- ml_hs_file loc -> - pure $ Just (toNormalizedFilePath' hs,hash) - _ -> return Nothing - hs_files' = liftIO $ mapM go (moduleEnvToList runtime_deps) - hs_files <- fmap sequence hs_files' + InstalledFound loc _ -> do + hs <- ml_hs_file loc + pure (toNormalizedFilePath' hs,hash) + _ -> Nothing +#endif + hs_files = mapM go (moduleEnvToList runtime_deps) case hs_files of Nothing -> error "invalid module graph" Just fs -> do diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index fd6ef75cda..012912bc5f 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -282,6 +282,8 @@ type instance RuleResult GetFileContents = (FileVersion, Maybe Rope) type instance RuleResult GetFileExists = Bool +type instance RuleResult GetFileHash = Fingerprint + type instance RuleResult AddWatchedFile = Bool @@ -337,6 +339,12 @@ data GetFileExists = GetFileExists instance NFData GetFileExists instance Hashable GetFileExists +data GetFileHash = GetFileHash + deriving (Eq, Show, Typeable, Generic) + +instance NFData GetFileHash +instance Hashable GetFileHash + data FileOfInterestStatus = OnDisk | Modified { firstOpen :: !Bool -- ^ was this file just opened diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 716adc1be6..2da64235f5 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -615,6 +615,13 @@ knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorde fs <- knownTargets pure (LBS.toStrict $ B.encode $ hash fs, unhashed fs) +getFileHashRule :: Recorder (WithPriority Log) -> Rules () +getFileHashRule recorder = + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileHash file -> do + void $ use_ GetModificationTime file + fileHash <- liftIO $ Util.getFileHash (fromNormalizedFilePath file) + return (Just (fingerprintToBS fileHash), ([], Just fileHash)) + getModuleGraphRule :: Recorder (WithPriority Log) -> Rules () getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetModuleGraph -> do fs <- toKnownFiles <$> useNoFile_ GetKnownTargets @@ -651,6 +658,7 @@ typeCheckRuleDefinition hsc pm = do unlift <- askUnliftIO let dets = TypecheckHelpers { getLinkables = unliftIO unlift . uses_ GetLinkable + , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph } addUsageDependencies $ liftIO $ typecheckModule defer hsc dets pm @@ -762,7 +770,8 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs) liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes return $ mkModuleGraph module_graph_nodes - session' <- liftIO $ mergeEnvs hsc mg ms inLoadOrder depSessions + de <- useNoFile_ GetModuleGraph + session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new -- ExportsMap when it is called. We only need to create the ExportsMap once per @@ -791,9 +800,11 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco , old_value = m_old , get_file_version = use GetModificationTime_{missingFileDiagnostics = False} , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs + , get_module_graph = useNoFile_ GetModuleGraph , regenerate = regenerateHiFile session f ms } - r <- loadInterface (hscEnv session) ms linkableType recompInfo + hsc_env' <- setFileCacheHook (hscEnv session) + r <- loadInterface hsc_env' ms linkableType recompInfo case r of (diags, Nothing) -> return (Nothing, (diags, Nothing)) (diags, Just x) -> do @@ -892,8 +903,9 @@ getModSummaryRule displayTHWarning recorder = do generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts) generateCore runSimplifier file = do packageState <- hscEnv <$> use_ GhcSessionDeps file + hsc' <- setFileCacheHook packageState tm <- use_ TypeCheck file - liftIO $ compileModule runSimplifier packageState (tmrModSummary tm) (tmrTypechecked tm) + liftIO $ compileModule runSimplifier hsc' (tmrModSummary tm) (tmrTypechecked tm) generateCoreRule :: Recorder (WithPriority Log) -> Rules () generateCoreRule recorder = @@ -908,14 +920,15 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ tmr <- use_ TypeCheck f linkableType <- getLinkableType f hsc <- hscEnv <$> use_ GhcSessionDeps f + hsc' <- setFileCacheHook hsc let compile = fmap ([],) $ use GenerateCore f se <- getShakeExtras - (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr + (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc' linkableType compile tmr let fp = hiFileFingerPrint <$> mbHiFile hiDiags <- case mbHiFile of Just hiFile | OnDisk <- status - , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc hiFile + , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc' hiFile _ -> pure [] return (fp, (diags++hiDiags, mbHiFile)) NotFOI -> do @@ -939,12 +952,21 @@ incrementRebuildCount = do count <- getRebuildCountVar <$> getIdeGlobalAction liftIO $ atomically $ modifyTVar' count (+1) +setFileCacheHook :: HscEnv -> Action HscEnv +setFileCacheHook old_hsc_env = do +#if MIN_VERSION_ghc(9,11,0) + unlift <- askUnliftIO + return $ old_hsc_env { hsc_FC = (hsc_FC old_hsc_env) { lookupFileCache = unliftIO unlift . use_ GetFileHash . toNormalizedFilePath' } } +#else + return old_hsc_env +#endif + -- | Also generates and indexes the `.hie` file, along with the `.o` file if needed -- Invariant maintained is that if the `.hi` file was successfully written, then the -- `.hie` and `.o` file (if needed) were also successfully written regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult) regenerateHiFile sess f ms compNeeded = do - let hsc = hscEnv sess + hsc <- setFileCacheHook (hscEnv sess) opt <- getIdeOptions -- Embed haddocks in the interface file @@ -1040,9 +1062,17 @@ usePropertyByPathAction path plId p = do getLinkableRule :: Recorder (WithPriority Log) -> Rules () getLinkableRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetLinkable f -> do - HiFileResult{hirModSummary, hirModIface, hirModDetails, hirCoreFp} <- use_ GetModIface f - let obj_file = ml_obj_file (ms_location hirModSummary) - core_file = ml_core_file (ms_location hirModSummary) + ModSummaryResult{msrModSummary = ms} <- use_ GetModSummary f + HiFileResult{hirModIface, hirModDetails, hirCoreFp} <- use_ GetModIface f + let obj_file = ml_obj_file (ms_location ms) + core_file = ml_core_file (ms_location ms) +#if MIN_VERSION_ghc(9,11,0) + mkLinkable t mod l = Linkable t mod (pure l) + dotO o = DotO o ModuleObject +#else + mkLinkable t mod l = LM t mod [l] + dotO = DotO +#endif case hirCoreFp of Nothing -> error $ "called GetLinkable for a file without a linkable: " ++ show f Just (bin_core, fileHash) -> do @@ -1055,7 +1085,7 @@ getLinkableRule recorder = core_t <- liftIO $ getModTime core_file (warns, hmi) <- case linkableType of -- Bytecode needs to be regenerated from the core file - BCOLinkable -> liftIO $ coreFileToLinkable linkableType (hscEnv session) hirModSummary hirModIface hirModDetails bin_core (posixSecondsToUTCTime core_t) + BCOLinkable -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms hirModIface hirModDetails bin_core (posixSecondsToUTCTime core_t) -- Object code can be read from the disk ObjectLinkable -> do -- object file is up to date if it is newer than the core file @@ -1068,15 +1098,15 @@ getLinkableRule recorder = else pure Nothing case mobj_time of Just obj_t - | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod hirModSummary) - $ pure (DotO obj_file + | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ mkLinkable (posixSecondsToUTCTime obj_t) (ms_mod ms) (dotO obj_file))) + _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms hirModIface hirModDetails bin_core (error "object doesn't have time") + -- Record the linkable so we know not to unload it, and unload old versions + whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) #if MIN_VERSION_ghc(9,11,0) - ModuleObject + $ \(Linkable time mod _) -> do +#else + $ \(LM time mod _) -> do #endif - ))) - _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) hirModSummary hirModIface hirModDetails bin_core (error "object doesn't have time") - -- Record the linkable so we know not to unload it, and unload old versions - whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction liftIO $ modifyVar compiledLinkables $ \old -> do let !to_keep = extendModuleEnv old mod time @@ -1090,13 +1120,9 @@ getLinkableRule recorder = --just before returning it to be loaded. This has a substantial effect on recompile --times as the number of loaded modules and splices increases. -- - unload (hscEnv session) (map (\(mod', time') -> LM time' mod' -#if MIN_VERSION_ghc(9,11,0) - $ pure (DotO obj_file ModuleObject)) -#else - $ pure (DotO obj_file)) -#endif - $ moduleEnvToList to_keep) + --We use a dummy DotA linkable part to fake a NativeCode linkable. + --The unload function doesn't care about the exact linkable parts. + unload (hscEnv session) (map (\(mod', time') -> mkLinkable time' mod' (DotA "dummy")) $ moduleEnvToList to_keep) return (to_keep, ()) return (fileHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure fileHash)) @@ -1200,6 +1226,7 @@ mainRule recorder RulesConfig{..} = do getModIfaceRule recorder getModSummaryRule templateHaskellWarning recorder getModuleGraphRule recorder + getFileHashRule recorder knownFilesRule recorder getClientSettingsRule recorder getHieAstsRule recorder diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 289794d2a5..1b236dffb6 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -22,7 +22,11 @@ import GHC.Settings -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,5,0) +#if !MIN_VERSION_ghc(9,3,0) +import qualified GHC.Driver.Pipeline as Pipeline +#endif + +#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,5,0) import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif @@ -34,6 +38,10 @@ import qualified GHC.SysTools.Cpp as Pipeline import qualified GHC.SysTools.Tasks as Pipeline #endif +#if MIN_VERSION_ghc(9,10,0) +import qualified GHC.SysTools.Tasks as Pipeline +#endif + addOptP :: String -> DynFlags -> DynFlags addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 81b821e022..6ea302d35b 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -180,14 +180,19 @@ import GHC.StgToByteCode import GHC.Types.CostCentre import GHC.Types.IPE import GHC.Types.SrcLoc (combineRealSrcSpans) +#if !MIN_VERSION_ghc(9,13,0) import GHC.Unit.Home.ModInfo (HomePackageTable, lookupHpt) -import GHC.Unit.Module.Deps (Dependencies (dep_direct_mods), - Usage (..)) +#endif import GHC.Unit.Module.ModIface -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + +import GHC.Driver.Config.Stg.Pipeline +import GHC.Unit.Module.Deps (Dependencies (dep_direct_mods), + Usage (..)) + #if !MIN_VERSION_ghc(9,5,0) import GHC.Core.Lint (lintInteractiveExpr) #endif @@ -204,6 +209,13 @@ import GHC.Driver.Config.CoreToStg.Prep (initCorePrepConfig) import GHC.Tc.Zonk.TcType (tcInitTidyEnv) #endif +#if MIN_VERSION_ghc(9,13,0) +import GHC.Unit.Home.PackageTable (lookupHpt, HomePackageTable) +import GHC.Unit.Home.Graph +import Control.Monad (forM_) +#endif + + #if !MIN_VERSION_ghc(9,7,0) liftZonkM :: a -> a liftZonkM = id @@ -501,9 +513,18 @@ mkAstNode n = Node (SourcedNodeInfo $ Map.singleton GeneratedInfo n) loadModulesHome :: [HomeModInfo] -> HscEnv +#if MIN_VERSION_ghc(9,13,0) + -> IO () +#else -> HscEnv +#endif loadModulesHome mod_infos e = +#if MIN_VERSION_ghc(9,13,0) + forM_ mod_infos $ + flip hscInsertHPT (e { hsc_type_env_vars = emptyKnotVars }) +#else hscUpdateHUG (\hug -> foldl' (flip addHomeModInfoToHug) hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars }) +#endif recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int recDotDot x = diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index ef857888cb..dad67918ca 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -68,8 +68,12 @@ module Development.IDE.GHC.Compat.Core ( IfaceExport, IfaceTyCon(..), ModIface, - pattern GHC.ModIface, ModIface_(..), +#if MIN_VERSION_ghc(9,11,0) + pattern ModIface, + set_mi_top_env, + set_mi_usages, +#endif HscSource(..), WhereFrom(..), loadInterface, @@ -543,17 +547,19 @@ import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface (IfaceExport, ModIface, - ModIface_ (..), mi_fix) + ModIface_ (..), mi_fix +#if MIN_VERSION_ghc(9,11,0) + , pattern ModIface + , set_mi_top_env + , set_mi_usages +#endif + ) import GHC.Unit.Module.ModSummary (ModSummary (..)) import GHC.Utils.Error (mkPlainErrorMsgEnvelope) import GHC.Utils.Panic import GHC.Utils.TmpFs import Language.Haskell.Syntax hiding (FunDep) import GHC.Types.Var.Env (TidyEnv) -#if MIN_VERSION_ghc(9,11,0) -import System.OsPath.Types (OsPath) -import System.OsPath (unsafeEncodeUtf) -#endif -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -562,16 +568,26 @@ import System.OsPath (unsafeEncodeUtf) import GHC.Types.Avail (greNamePrintableName) #endif -#if !MIN_VERSION_ghc(9,9,0) -import GHC.Hs (SrcSpanAnn') +#if MIN_VERSION_ghc(9,12,0) +import System.OsString +import System.FilePath (splitExtension) +#endif + +#if MIN_VERSION_ghc(9,13,0) +import GHC.Unit.Home.PackageTable #endif mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation -mkHomeModLocation df mn f = do -#if MIN_VERSION_ghc(9,11,0) - f <- return $ unsafeEncodeUtf f +#if MIN_VERSION_ghc(9,13,0) +mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn (unsafeEncodeUtf basename) (unsafeEncodeUtf ext) HsSrcFile + where + (basename, ext) = splitExtension f +#elif MIN_VERSION_ghc(9,11,0) +mkHomeModLocation df mn f = + pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn (unsafeEncodeUtf f) +#else +mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f #endif - pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index f7f634e448..b2423c10ed 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -81,6 +81,48 @@ type PreloadUnitClosure = UniqSet UnitId unitState :: HscEnv -> UnitState unitState = ue_units . hsc_unit_env +#if MIN_VERSION_ghc(9,13,0) +createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> IO HomeUnitGraph +createUnitEnvFromFlags unitDflags = do + emptyHpt <- emptyHomePackageTable + let + newInternalUnitEnv dflags = mkHomeUnitEnv emptyUnitState Nothing dflags emptyHpt Nothing + unitEnvList = NE.map (\dflags -> (homeUnitId_ dflags, newInternalUnitEnv dflags)) unitDflags + return $ + 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 + initial_home_graph <- createUnitEnvFromFlags (dflags0 NE.:| unitDflags) + let 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 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 dflags1 $ hscSetUnitEnv unit_env env +#else createUnitEnvFromFlags :: NE.NonEmpty DynFlags -> HomeUnitGraph createUnitEnvFromFlags unitDflags = let @@ -120,7 +162,7 @@ initUnits unitDflags env = do , ue_eps = ue_eps (hsc_unit_env env) } pure $ hscSetFlags dflags1 $ hscSetUnitEnv unit_env env - +#endif explicitUnits :: UnitState -> [Unit] explicitUnits ue = diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 5d13c06293..c2b24f6d04 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -24,11 +24,11 @@ import qualified Development.IDE.GHC.Compat.Util as Util import GHC.Core import GHC.CoreToIface import GHC.Fingerprint +import GHC.Iface.Binary +import GHC.Iface.Env #if MIN_VERSION_ghc(9,11,0) import qualified GHC.Iface.Load as Iface #endif -import GHC.Iface.Binary -import GHC.Iface.Env import GHC.Iface.Recomp.Binary (fingerprintBinMem) import GHC.IfaceToCore import GHC.Types.Id.Make @@ -91,17 +91,19 @@ readBinCoreFile name_cache fat_hi_path = do -- | Write a core file writeBinCoreFile :: DynFlags -> FilePath -> CoreFile -> IO Fingerprint -writeBinCoreFile _dflag core_path fat_iface = do +writeBinCoreFile _dflags core_path fat_iface = do bh <- openBinMem initBinMemSize let quietTrace = QuietBinIFace -#if !MIN_VERSION_ghc(9,11,0) - putWithUserData quietTrace bh fat_iface -#else - putWithUserData quietTrace (Iface.flagsToIfCompression _dflag) bh fat_iface + putWithUserData + quietTrace +#if MIN_VERSION_ghc(9,11,0) + (Iface.flagsToIfCompression _dflags) #endif + bh + fat_iface -- And send the result to the file writeBinMem bh core_path @@ -148,7 +150,11 @@ getClassImplicitBinds cls | (op, val_index) <- classAllSelIds cls `zip` [0..] ] get_defn :: Id -> CoreBind -get_defn identifier = NonRec identifier (unfoldingTemplate (realIdUnfolding identifier)) +get_defn identifier = NonRec identifier templ + where + templ = case maybeUnfoldingTemplate (realIdUnfolding identifier) of + Nothing -> error "get_dfn: no unfolding template" + Just x -> x toIfaceTopBndr1 :: Module -> Id -> IfaceId toIfaceTopBndr1 mod identifier diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 598fa956ea..200e926339 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -71,16 +71,22 @@ instance NFData Unlinked where rnf (DotDLL f) = rnf f #if MIN_VERSION_ghc(9,5,0) rnf (CoreBindings wcb) = rnf wcb -instance NFData ModLocation where - rnf (ModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 #endif -#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,11,0) +#if MIN_VERSION_ghc(9,5,0) instance NFData WholeCoreBindings where +#if MIN_VERSION_ghc(9,11,0) + rnf (WholeCoreBindings bs m ml f) = rnf bs `seq` rnf m `seq` rnf ml `seq` rnf f +#else rnf (WholeCoreBindings bs m ml) = rnf bs `seq` rnf m `seq` rnf ml +#endif + +instance NFData ModLocation where +#if MIN_VERSION_ghc(9,11,0) + rnf (OsPathModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 #else -instance NFData WholeCoreBindings where - rnf (WholeCoreBindings bs m ml wf) = rnf bs `seq` rnf m `seq` rnf ml `seq` rnf wf + rnf (ModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 +#endif #endif instance Show PackageFlag where show = unpack . printOutputable diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 5372a1364a..d6e0f5614c 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -20,6 +20,7 @@ module Development.IDE.Import.DependencyInformation , insertImport , pathToId , idToPath + , idToModLocation , reachableModules , processDependencyInformation , transitiveDeps diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 3d392cb1df..ee9e632073 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -106,7 +106,12 @@ reexportedModulesFrom flag = -- 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 (UnitId, ([FilePath], S.Set ModuleName)) -mkImportDirs _env (i, flags) = Just (i, (importPaths flags, reexportedModulesFrom flags)) +#if MIN_VERSION_ghc(9,11,0) +mkImportDirs _env (i, flags) = Just (i, (importPaths flags, S.fromList $ map reexportTo $ reexportedModules flags)) +#else +mkImportDirs _env (i, flags) = Just (i, (importPaths flags, reexportedModules flags)) +#endif + -- | locate a module in either the file system or the package database. Where we go from *daml to -- Haskell locateModule From 8730bf7ee44c53f47fc551345e19cc5b54bd22f6 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 11:09:28 +0800 Subject: [PATCH 11/46] fix tidyOpenType --- plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index 18c9dbae26..62fbe62a19 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -221,5 +221,5 @@ getInstanceBindTypeSigsRule recorder = do let name = idName id whenMaybe (isBindingName name) $ do env <- tcInitTidyEnv - let (_, ty) = tidyOpenType env (idType id) + let ty = tidyOpenType env (idType id) pure $ InstanceBindTypeSig name ty From fa0d4de608e3078328c0ad24e7ddb12c8377d87e Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 11:39:15 +0800 Subject: [PATCH 12/46] fix SrcSpanAnn --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index dad67918ca..082df395d9 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -548,6 +548,9 @@ import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface (IfaceExport, ModIface, ModIface_ (..), mi_fix +#if !MIN_VERSION_ghc(9,9,0) +import GHC.Hs (SrcSpanAnn') +#endif #if MIN_VERSION_ghc(9,11,0) , pattern ModIface , set_mi_top_env From 58b7a525dd12576d5b29b91543832279e2f5d150 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 11:42:50 +0800 Subject: [PATCH 13/46] fix: enable gotoImplementation handler in GhcIde plugin --- ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index 8fe0f9e412..ada0f9e682 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -51,8 +51,8 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) Hover.gotoDefinition recorder ide TextDocumentPositionParams{..}) <> mkPluginHandler SMethod_TextDocumentTypeDefinition (\ide _ TypeDefinitionParams{..} -> Hover.gotoTypeDefinition recorder ide TextDocumentPositionParams{..}) - -- <> mkPluginHandler SMethod_TextDocumentImplementation (\ide _ ImplementationParams{..} -> - -- Hover.gotoImplementation recorder ide TextDocumentPositionParams{..}) + <> mkPluginHandler SMethod_TextDocumentImplementation (\ide _ ImplementationParams{..} -> + Hover.gotoImplementation recorder ide TextDocumentPositionParams{..}) <> mkPluginHandler SMethod_TextDocumentDocumentHighlight (\ide _ DocumentHighlightParams{..} -> Hover.documentHighlight recorder ide TextDocumentPositionParams{..}) <> mkPluginHandler SMethod_TextDocumentReferences (Hover.references recorder) From af99f16c55a5aeb69af006e17a9a654a68fb0745 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 11:58:14 +0800 Subject: [PATCH 14/46] remove index and allow newer --- cabal.project | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index d63c47ff99..065fa4ba37 100644 --- a/cabal.project +++ b/cabal.project @@ -8,7 +8,6 @@ packages: ./hls-test-utils -index-state: 2024-12-02T00:00:00Z tests: True test-show-details: direct @@ -59,3 +58,7 @@ if impl(ghc >= 9.8.4) && impl(ghc < 9.8.5) ghc-lib-parser:filepath constraints: ghc-lib-parser==9.8.4.20241130 + +allow-newer: + base + , ghc From 9bd6a85f2713abecfa104258b72c649668f623d5 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 12:19:36 +0800 Subject: [PATCH 15/46] chore: update index-state in cabal.project --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 065fa4ba37..f05987862a 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils - +index-state: 2025-03-17T00:00:00Z tests: True test-show-details: direct From d806855f736a723d910f923c870049ab9bcc976a Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 12:29:58 +0800 Subject: [PATCH 16/46] fix: conditionally allow newer base and ghc versions for GHC 9.12.2 --- cabal.project | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/cabal.project b/cabal.project index f05987862a..187f06ad77 100644 --- a/cabal.project +++ b/cabal.project @@ -59,6 +59,7 @@ if impl(ghc >= 9.8.4) && impl(ghc < 9.8.5) constraints: ghc-lib-parser==9.8.4.20241130 -allow-newer: - base - , ghc +if impl(ghc >= 9.12.2) + allow-newer: + base + , ghc From 83f5690b112ced37926a880ff3e5779c27859aa7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 12:30:18 +0800 Subject: [PATCH 17/46] fix: update GHC version constraint to allow newer base and ghc versions for GHC 9.12.0 --- cabal.project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal.project b/cabal.project index 187f06ad77..353b78ea73 100644 --- a/cabal.project +++ b/cabal.project @@ -59,7 +59,7 @@ if impl(ghc >= 9.8.4) && impl(ghc < 9.8.5) constraints: ghc-lib-parser==9.8.4.20241130 -if impl(ghc >= 9.12.2) +if impl(ghc >= 9.12.0) allow-newer: base , ghc From 39f43688ef52f4f084c9448a6233974f97dc2ab3 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 13:09:40 +0800 Subject: [PATCH 18/46] fix: adjust import statements for compatibility with GHC versioning --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 082df395d9..90c80e47bd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -537,6 +537,7 @@ import GHC.Types.TyThing import GHC.Types.TyThing.Ppr import GHC.Types.Unique import GHC.Types.Unique.Map +import GHC.Types.Var.Env (TidyEnv) import GHC.Unit.Env import GHC.Unit.Finder hiding (mkHomeModLocation) import qualified GHC.Unit.Finder as GHC @@ -548,9 +549,6 @@ import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts import GHC.Unit.Module.ModIface (IfaceExport, ModIface, ModIface_ (..), mi_fix -#if !MIN_VERSION_ghc(9,9,0) -import GHC.Hs (SrcSpanAnn') -#endif #if MIN_VERSION_ghc(9,11,0) , pattern ModIface , set_mi_top_env @@ -562,15 +560,16 @@ import GHC.Utils.Error (mkPlainErrorMsgEnvelope) import GHC.Utils.Panic import GHC.Utils.TmpFs import Language.Haskell.Syntax hiding (FunDep) -import GHC.Types.Var.Env (TidyEnv) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] - - #if !MIN_VERSION_ghc(9,7,0) import GHC.Types.Avail (greNamePrintableName) #endif +#if !MIN_VERSION_ghc(9,9,0) +import GHC.Hs (SrcSpanAnn') +#endif + #if MIN_VERSION_ghc(9,12,0) import System.OsString import System.FilePath (splitExtension) From e7dd3de11cad980248fb053b67ccc67a960c01b4 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 13:48:08 +0800 Subject: [PATCH 19/46] fix: restore rnf implementation for LoadedBCOs in GHC 9.5.0+ --- ghcide/src/Development/IDE/GHC/Orphans.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 200e926339..f80e1a8bbf 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -65,12 +65,12 @@ instance NFData Unlinked where #else rnf (DotO f) = rnf f rnf (BCOs a b) = seqCompiledByteCode a `seq` liftRnf rwhnf b - rnf (LoadedBCOs us) = rnf us #endif rnf (DotA f) = rnf f rnf (DotDLL f) = rnf f #if MIN_VERSION_ghc(9,5,0) rnf (CoreBindings wcb) = rnf wcb + rnf (LoadedBCOs us) = rnf us #endif #if MIN_VERSION_ghc(9,5,0) From 3414636a6be9f337073e66746cdf2bcfe65aa62a Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 13:55:22 +0800 Subject: [PATCH 20/46] fix: update conditional compilation for GHC version checks --- .../session-loader/Development/IDE/Session.hs | 2 +- ghcide/src/Development/IDE/Core/Compile.hs | 27 +------------------ 2 files changed, 2 insertions(+), 27 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 50a30c6ad2..4245b98cd9 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -790,7 +790,7 @@ setNameCache nc hsc = hsc { hsc_NC = nc } -- Moved back to implementation in GHC. checkHomeUnitsClosed' :: UnitEnv -> OS.Set UnitId -> [DriverMessages] checkHomeUnitsClosed' ue _ = checkHomeUnitsClosed ue -#elif MIN_VERSION_ghc(9,3,0) +#else -- This function checks the important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -- GHC had an implementation of this function, but it was horribly inefficient diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 5143d3da11..85063d4fee 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -1110,7 +1110,7 @@ mergeEnvs env mg dep_info ms extraMods envs = do | HsSrcFile <- mi_hsc_src (hm_iface a) = a | otherwise = b -#elif MIN_VERSION_ghc(9,3,0) +#else 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 @@ -1144,31 +1144,6 @@ mergeEnvs env mg dep_info ms extraMods envs = do fcModules' <- newIORef $! foldl' (plusInstalledModuleEnv combineModuleLocations) cur fcModules fcFiles' <- newIORef $! Map.unions fcFiles pure $ FinderCache fcModules' fcFiles' - -#else - prevFinderCache <- concatFC <$> mapM (readIORef . hsc_FC) envs - let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms)) - ifr = InstalledFound (ms_location ms) im - newFinderCache <- newIORef $! Compat.extendInstalledModuleEnv prevFinderCache im ifr - return $! loadModulesHome extraMods $ - env{ - hsc_HPT = foldMapBy mergeUDFM emptyUDFM hsc_HPT envs, - hsc_FC = newFinderCache, - hsc_mod_graph = mg - } - - where - mergeUDFM = plusUDFM_C combineModules - combineModules a b - | HsSrcFile <- mi_hsc_src (hm_iface a) = a - | otherwise = b - -- required because 'FinderCache': - -- 1) doesn't have a 'Monoid' instance, - -- 2) is abstract and doesn't export constructors - -- To work around this, we coerce to the underlying type - -- 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 From 7c56c86884cdefd703b5052564fa51e505da0fdf Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 13:58:28 +0800 Subject: [PATCH 21/46] fix: simplify import handling for GHC version checks --- ghcide/src/Development/IDE/Core/Compile.hs | 12 +----------- ghcide/src/Development/IDE/GHC/CPP.hs | 6 +----- 2 files changed, 2 insertions(+), 16 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 85063d4fee..e443bf61fc 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -1188,25 +1188,15 @@ getModSummaryFromImports env fp _modTime mContents = do implicit_prelude imps - convImport (L _ i) = ( -#if !MIN_VERSION_ghc(9,3,0) - fmap sl_fs -#endif - (ideclPkgQual i) - , reLoc $ ideclName i) + convImport (L _ i) = (ideclPkgQual i, reLoc $ ideclName i) msrImports = implicit_imports ++ imps -#if MIN_VERSION_ghc(9,3,0) rn_pkg_qual = renameRawPkgQual (hsc_unit_env ppEnv) rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn)) srcImports = rn_imps $ map convImport src_idecls 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 -- Force bits that might keep the string buffer and DynFlags alive unnecessarily diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 1b236dffb6..b2ed0b9c65 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -22,11 +22,7 @@ import GHC.Settings -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] -#if !MIN_VERSION_ghc(9,3,0) -import qualified GHC.Driver.Pipeline as Pipeline -#endif - -#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,5,0) +#if !MIN_VERSION_ghc(9,5,0) import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif From 5aea80d16125e6a92d50f03dd26f026cf7264674 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 13:59:07 +0800 Subject: [PATCH 22/46] fix: remove redundant import for GHC version 9.10.0 --- ghcide/src/Development/IDE/GHC/CPP.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index b2ed0b9c65..289794d2a5 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -34,10 +34,6 @@ import qualified GHC.SysTools.Cpp as Pipeline import qualified GHC.SysTools.Tasks as Pipeline #endif -#if MIN_VERSION_ghc(9,10,0) -import qualified GHC.SysTools.Tasks as Pipeline -#endif - addOptP :: String -> DynFlags -> DynFlags addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s From 4f684845cd13cc6ea05d760ee332642da62c865c Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 14:02:48 +0800 Subject: [PATCH 23/46] fix: update import statements and remove redundant rangesOverlap function --- ghcide/src/Development/IDE/Core/PluginUtils.hs | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index a7185b7101..21dd98294b 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -60,8 +60,8 @@ import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message (SMethod (..)) import qualified Language.LSP.Protocol.Types as LSP import qualified StmContainers.Map as STM -import qualified Language.LSP.Protocol.Lens as L -import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) +import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) +import Ide.PluginUtils (rangesOverlap) -- ---------------------------------------------------------------------------- -- Action wrappers @@ -181,11 +181,6 @@ fromCurrentRangeMT :: Monad m => PositionMapping -> LSP.Range -> MaybeT m LSP.Ra fromCurrentRangeMT mapping = MaybeT . pure . fromCurrentRange mapping --- todo:9.12 same as Ide.PluginUtils (rangesOverlap), migrate later --- import Ide.PluginUtils (rangesOverlap) -rangesOverlap :: Range -> Range -> Bool -rangesOverlap r1 r2 = - r1 ^. L.start <= r2 ^. L.end && r2 ^. L.start <= r1 ^. L.end -- ---------------------------------------------------------------------------- -- Diagnostics -- ---------------------------------------------------------------------------- From 2b164441824d392f3a3d1e7e4b77177ab4820c3f Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 14:03:08 +0800 Subject: [PATCH 24/46] fix: clean up import statements in PluginUtils.hs --- ghcide/src/Development/IDE/Core/PluginUtils.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 21dd98294b..a00523e3dd 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -56,12 +56,12 @@ import Development.IDE.Types.Location (NormalizedFilePath, Range import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error +import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) +import Ide.PluginUtils (rangesOverlap) import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message (SMethod (..)) import qualified Language.LSP.Protocol.Types as LSP import qualified StmContainers.Map as STM -import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) -import Ide.PluginUtils (rangesOverlap) -- ---------------------------------------------------------------------------- -- Action wrappers From 82e244167e56e8d0f4994b6f11e0a5616788eb76 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 14:03:15 +0800 Subject: [PATCH 25/46] fix: reorder import statements in PluginUtils.hs for clarity --- ghcide/src/Development/IDE/Core/PluginUtils.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index a00523e3dd..c49877c043 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -56,8 +56,8 @@ import Development.IDE.Types.Location (NormalizedFilePath, Range import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error -import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) import Ide.PluginUtils (rangesOverlap) +import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message (SMethod (..)) import qualified Language.LSP.Protocol.Types as LSP From 581cff3c5925322696927d3133e9d26a5e7492c4 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 14:05:29 +0800 Subject: [PATCH 26/46] fix: update NFData instance for GHC version checks in Orphans.hs --- ghcide/src/Development/IDE/GHC/Orphans.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index f80e1a8bbf..e9b44a6b0d 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -70,6 +70,8 @@ instance NFData Unlinked where rnf (DotDLL f) = rnf f #if MIN_VERSION_ghc(9,5,0) rnf (CoreBindings wcb) = rnf wcb +#endif +#if MIN_VERSION_ghc(9,5,0) && !MIN_VERSION_ghc(9,11,0) rnf (LoadedBCOs us) = rnf us #endif From a3c4a8dde482e4ec68213e6501b5d9e036def4bc Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 14:10:32 +0800 Subject: [PATCH 27/46] fix: reorganize import statements in PluginUtils.hs for improved readability --- ghcide/src/Development/IDE/Core/PluginUtils.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index c49877c043..25f7865e66 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -52,12 +52,18 @@ import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import Development.IDE.Types.Diagnostics -import Development.IDE.Types.Location (NormalizedFilePath, Range) +import Development.IDE.Types.Location (NormalizedFilePath, + Range) import qualified Development.IDE.Types.Location as Location import qualified Ide.Logger as Logger import Ide.Plugin.Error -import Ide.PluginUtils (rangesOverlap) -import Ide.Types (FormattingHandler, PluginHandlers, FormattingMethod, PluginMethodHandler, mkPluginHandler, FormattingType (..)) +import Ide.PluginUtils (rangesOverlap) +import Ide.Types (FormattingHandler, + FormattingMethod, + FormattingType (..), + PluginHandlers, + PluginMethodHandler, + mkPluginHandler) import qualified Language.LSP.Protocol.Lens as LSP import Language.LSP.Protocol.Message (SMethod (..)) import qualified Language.LSP.Protocol.Types as LSP From ad3188ce6d4d3bc3b98e77c544f2f151c43c8e4b Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 14:16:56 +0800 Subject: [PATCH 28/46] format --- ghcide/test/exe/UnitTests.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/ghcide/test/exe/UnitTests.hs b/ghcide/test/exe/UnitTests.hs index c59ec449b4..f26d394ce0 100644 --- a/ghcide/test/exe/UnitTests.hs +++ b/ghcide/test/exe/UnitTests.hs @@ -28,9 +28,11 @@ import Network.URI import qualified Progress import System.IO.Extra hiding (withTempDir) import System.Mem (performGC) -import Test.Hls (IdeState, def, +import Test.Hls (GhcVersion (GHC912), + IdeState, def, + knownBrokenForGhcVersions, runSessionWithServerInTmpDir, - waitForProgressDone, GhcVersion (GHC912), knownBrokenForGhcVersions) + waitForProgressDone) import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit From 09537059f596b1f00496c7069fa7592a5783ac97 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 14:56:10 +0800 Subject: [PATCH 29/46] format --- ghcide/src/Development/IDE/GHC/CoreFile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index c2b24f6d04..015c5e3aff 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -154,7 +154,7 @@ get_defn identifier = NonRec identifier templ where templ = case maybeUnfoldingTemplate (realIdUnfolding identifier) of Nothing -> error "get_dfn: no unfolding template" - Just x -> x + Just x -> x toIfaceTopBndr1 :: Module -> Id -> IfaceId toIfaceTopBndr1 mod identifier From 5145231ec100b2f642c76822c995fa6c2ccb6a1d Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 16:23:50 +0800 Subject: [PATCH 30/46] wobbles --- haskell-language-server.cabal | 64 +++++++++++++++++------------------ 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 5f011472fb..10e1cdfaeb 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -106,10 +106,10 @@ flag dynamic flag cabalfmt description: Enable cabal-fmt plugin default: True - manual: True + manual: False common cabalfmt - if flag(cabalfmt) + if flag(cabalfmt) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-cabal-fmt-plugin cpp-options: -Dhls_cabalfmt @@ -140,7 +140,7 @@ library hls-cabal-fmt-plugin -- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-fmt-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(cabalfmt) + if !flag(cabalfmt) || !flag(cabal) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-cabal-fmt-plugin/test @@ -165,7 +165,7 @@ test-suite hls-cabal-fmt-plugin-tests flag cabalgild description: Enable cabal-gild plugin default: True - manual: True + manual: False common cabalgild if flag(cabalgild) @@ -198,7 +198,7 @@ library hls-cabal-gild-plugin -- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-gild-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(cabalgild) + if !flag(cabalgild) || !flag(cabal) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-cabal-gild-plugin/test @@ -224,7 +224,7 @@ test-suite hls-cabal-gild-plugin-tests flag cabal description: Enable cabal plugin default: True - manual: True + manual: False common cabal if flag(cabal) @@ -322,7 +322,7 @@ test-suite hls-cabal-plugin-tests flag class description: Enable class plugin default: True - manual: True + manual: False common class if flag(class) @@ -384,7 +384,7 @@ test-suite hls-class-plugin-tests flag callHierarchy description: Enable call hierarchy plugin default: True - manual: True + manual: False common callHierarchy if flag(callHierarchy) @@ -444,7 +444,7 @@ test-suite hls-call-hierarchy-plugin-tests flag eval description: Enable eval plugin default: True - manual: True + manual: False common eval if flag(eval) @@ -533,7 +533,7 @@ common importLens flag importLens description: Enable importLens plugin default: True - manual: True + manual: False library hls-explicit-imports-plugin import: defaults, pedantic, warnings @@ -583,7 +583,7 @@ test-suite hls-explicit-imports-plugin-tests flag rename description: Enable rename plugin default: True - manual: True + manual: False common rename if flag(rename) @@ -641,7 +641,7 @@ test-suite hls-rename-plugin-tests flag retrie description: Enable retrie plugin default: True - manual: True + manual: False common retrie if flag(retrie) && impl(ghc < 9.10) @@ -710,7 +710,7 @@ flag ghc-lib flag hlint description: Enable hlint plugin default: True - manual: True + manual: False common hlint if flag(hlint) && impl(ghc < 9.10) @@ -791,7 +791,7 @@ test-suite hls-hlint-plugin-tests flag stan description: Enable stan plugin default: True - manual: True + manual: False common stan if flag(stan) @@ -854,7 +854,7 @@ test-suite hls-stan-plugin-tests flag moduleName description: Enable moduleName plugin default: True - manual: True + manual: False common moduleName if flag(moduleName) @@ -900,7 +900,7 @@ test-suite hls-module-name-plugin-tests flag pragmas description: Enable pragmas plugin default: True - manual: True + manual: False common pragmas if flag(pragmas) @@ -951,7 +951,7 @@ test-suite hls-pragmas-plugin-tests flag splice description: Enable splice plugin default: True - manual: True + manual: False common splice if flag(splice) && impl(ghc < 9.10) @@ -1008,7 +1008,7 @@ test-suite hls-splice-plugin-tests flag alternateNumberFormat description: Enable Alternate Number Format plugin default: True - manual: True + manual: False common alternateNumberFormat if flag(alternateNumberFormat) @@ -1072,7 +1072,7 @@ test-suite hls-alternate-number-format-plugin-tests flag qualifyImportedNames description: Enable qualifyImportedNames plugin default: True - manual: True + manual: False common qualifyImportedNames if flag(qualifyImportedNames) @@ -1121,7 +1121,7 @@ test-suite hls-qualify-imported-names-plugin-tests flag codeRange description: Enable Code Range plugin default: True - manual: True + manual: False common codeRange if flag(codeRange) @@ -1182,7 +1182,7 @@ test-suite hls-code-range-plugin-tests flag changeTypeSignature description: Enable changeTypeSignature plugin default: True - manual: True + manual: False common changeTypeSignature if flag(changeTypeSignature) @@ -1237,7 +1237,7 @@ test-suite hls-change-type-signature-plugin-tests flag gadt description: Enable gadt plugin default: True - manual: True + manual: False common gadt if flag(gadt) @@ -1290,7 +1290,7 @@ test-suite hls-gadt-plugin-tests flag explicitFixity description: Enable explicitFixity plugin default: True - manual: True + manual: False common explicitFixity if flag(explicitFixity) @@ -1337,7 +1337,7 @@ test-suite hls-explicit-fixity-plugin-tests flag explicitFields description: Enable explicitFields plugin default: True - manual: True + manual: False common explicitFields if flag(explicitFields) @@ -1388,7 +1388,7 @@ test-suite hls-explicit-record-fields-plugin-tests flag overloadedRecordDot description: Enable overloadedRecordDot plugin default: True - manual: True + manual: False common overloadedRecordDot if flag(overloadedRecordDot) @@ -1437,7 +1437,7 @@ test-suite hls-overloaded-record-dot-plugin-tests flag floskell description: Enable floskell plugin default: True - manual: True + manual: False common floskell if flag(floskell) && impl(ghc < 9.10) @@ -1481,7 +1481,7 @@ test-suite hls-floskell-plugin-tests flag fourmolu description: Enable fourmolu plugin default: True - manual: True + manual: False common fourmolu if flag(fourmolu) @@ -1537,7 +1537,7 @@ test-suite hls-fourmolu-plugin-tests flag ormolu description: Enable ormolu plugin default: True - manual: True + manual: False common ormolu if flag(ormolu) @@ -1594,7 +1594,7 @@ test-suite hls-ormolu-plugin-tests flag stylishHaskell description: Enable stylishHaskell plugin default: True - manual: True + manual: False common stylishHaskell if flag(stylishHaskell) && impl(ghc < 9.10) @@ -1641,7 +1641,7 @@ test-suite hls-stylish-haskell-plugin-tests flag refactor description: Enable refactor plugin default: True - manual: True + manual: False common refactor if flag(refactor) @@ -1744,7 +1744,7 @@ test-suite hls-refactor-plugin-tests flag semanticTokens description: Enable semantic tokens plugin default: True - manual: True + manual: False common semanticTokens if flag(semanticTokens) @@ -1823,7 +1823,7 @@ test-suite hls-semantic-tokens-plugin-tests flag notes description: Enable notes plugin default: True - manual: True + manual: False common notes if flag(notes) From 0c4fff995fa9ff39b59636933e8802506b616937 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 18:44:08 +0800 Subject: [PATCH 31/46] disable all plugins for 9.12.0 --- cabal.project | 2 +- ghcide/cabal.project | 7 +- haskell-language-server.cabal | 221 +++++++++++++++++----------------- 3 files changed, 114 insertions(+), 116 deletions(-) diff --git a/cabal.project b/cabal.project index 353b78ea73..6f6d6d716e 100644 --- a/cabal.project +++ b/cabal.project @@ -59,7 +59,7 @@ if impl(ghc >= 9.8.4) && impl(ghc < 9.8.5) constraints: ghc-lib-parser==9.8.4.20241130 -if impl(ghc >= 9.12.0) +if impl(ghc >= 9.11.0) allow-newer: base , ghc diff --git a/ghcide/cabal.project b/ghcide/cabal.project index 593b6f12d6..5d7ae19b2d 100644 --- a/ghcide/cabal.project +++ b/ghcide/cabal.project @@ -1,6 +1,7 @@ packages: ./ -allow-newer: - base - , ghc +if impl(ghc >= 9.12.0) + allow-newer: + base + , ghc diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 10e1cdfaeb..f296bd437c 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -106,7 +106,7 @@ flag dynamic flag cabalfmt description: Enable cabal-fmt plugin default: True - manual: False + manual: True common cabalfmt if flag(cabalfmt) && impl(ghc < 9.11) @@ -121,7 +121,7 @@ flag isolateCabalfmtTests library hls-cabal-fmt-plugin import: defaults, pedantic, warnings - if !flag(cabalfmt) + if !flag(cabalfmt) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.CabalFmt hs-source-dirs: plugins/hls-cabal-fmt-plugin/src @@ -140,7 +140,7 @@ library hls-cabal-fmt-plugin -- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-fmt-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(cabalfmt) || !flag(cabal) + if !flag(cabalfmt) || !flag(cabal) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-cabal-fmt-plugin/test @@ -165,10 +165,10 @@ test-suite hls-cabal-fmt-plugin-tests flag cabalgild description: Enable cabal-gild plugin default: True - manual: False + manual: True common cabalgild - if flag(cabalgild) + if flag(cabalgild) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-cabal-gild-plugin cpp-options: -Dhls_cabalgild @@ -180,7 +180,7 @@ flag isolateCabalGildTests library hls-cabal-gild-plugin import: defaults, pedantic, warnings - if !flag(cabalgild) + if !flag(cabalgild) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.CabalGild hs-source-dirs: plugins/hls-cabal-gild-plugin/src @@ -198,7 +198,7 @@ library hls-cabal-gild-plugin -- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-gild-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(cabalgild) || !flag(cabal) + if !flag(cabalgild) || !flag(cabal) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-cabal-gild-plugin/test @@ -224,16 +224,16 @@ test-suite hls-cabal-gild-plugin-tests flag cabal description: Enable cabal plugin default: True - manual: False + manual: True common cabal - if flag(cabal) + if flag(cabal) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-cabal-plugin cpp-options: -Dhls_cabal library hls-cabal-plugin import: defaults, pedantic, warnings - if !flag(cabal) + if !flag(cabal) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Cabal @@ -289,7 +289,7 @@ library hls-cabal-plugin test-suite hls-cabal-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(cabal) + if !flag(cabal) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-cabal-plugin/test @@ -322,16 +322,16 @@ test-suite hls-cabal-plugin-tests flag class description: Enable class plugin default: True - manual: False + manual: True common class - if flag(class) + if flag(class) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-class-plugin cpp-options: -Dhls_class library hls-class-plugin import: defaults, pedantic, warnings - if !flag(class) + if !flag(class) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Class other-modules: Ide.Plugin.Class.CodeAction @@ -363,7 +363,7 @@ library hls-class-plugin test-suite hls-class-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(class) + if !flag(class) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-class-plugin/test @@ -384,16 +384,16 @@ test-suite hls-class-plugin-tests flag callHierarchy description: Enable call hierarchy plugin default: True - manual: False + manual: True common callHierarchy - if flag(callHierarchy) + if flag(callHierarchy) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-call-hierarchy-plugin cpp-options: -Dhls_callHierarchy library hls-call-hierarchy-plugin import: defaults, pedantic, warnings - if !flag(callHierarchy) + if !flag(callHierarchy) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.CallHierarchy other-modules: @@ -419,7 +419,7 @@ library hls-call-hierarchy-plugin test-suite hls-call-hierarchy-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(callHierarchy) + if !flag(callHierarchy) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-call-hierarchy-plugin/test @@ -444,16 +444,16 @@ test-suite hls-call-hierarchy-plugin-tests flag eval description: Enable eval plugin default: True - manual: False + manual: True common eval - if flag(eval) + if flag(eval) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-eval-plugin cpp-options: -Dhls_eval library hls-eval-plugin import: defaults, pedantic, warnings - if !flag(eval) + if !flag(eval) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Eval @@ -502,7 +502,7 @@ library hls-eval-plugin test-suite hls-eval-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(eval) + if !flag(eval) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-eval-plugin/test @@ -525,19 +525,20 @@ test-suite hls-eval-plugin-tests -- import lens plugin ----------------------------- +flag importLens + description: Enable importLens plugin + default: True + manual: True + common importLens - if flag(importLens) + if flag(importLens) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-explicit-imports-plugin cpp-options: -Dhls_importLens -flag importLens - description: Enable importLens plugin - default: True - manual: False library hls-explicit-imports-plugin import: defaults, pedantic, warnings - if !flag(importlens) + if !flag(importlens) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.ExplicitImports hs-source-dirs: plugins/hls-explicit-imports-plugin/src @@ -561,7 +562,7 @@ library hls-explicit-imports-plugin test-suite hls-explicit-imports-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(importlens) + if !flag(importlens) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-explicit-imports-plugin/test @@ -583,16 +584,16 @@ test-suite hls-explicit-imports-plugin-tests flag rename description: Enable rename plugin default: True - manual: False + manual: True common rename - if flag(rename) + if flag(rename) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-rename-plugin cpp-options: -Dhls_rename library hls-rename-plugin import: defaults, pedantic, warnings - if !flag(rename) + if !flag(rename) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Rename hs-source-dirs: plugins/hls-rename-plugin/src @@ -617,7 +618,7 @@ library hls-rename-plugin test-suite hls-rename-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(rename) + if !flag(rename) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-rename-plugin/test @@ -641,7 +642,7 @@ test-suite hls-rename-plugin-tests flag retrie description: Enable retrie plugin default: True - manual: False + manual: True common retrie if flag(retrie) && impl(ghc < 9.10) @@ -710,7 +711,7 @@ flag ghc-lib flag hlint description: Enable hlint plugin default: True - manual: False + manual: True common hlint if flag(hlint) && impl(ghc < 9.10) @@ -720,7 +721,7 @@ common hlint library hls-hlint-plugin import: defaults, pedantic, warnings -- https://github.com/ndmitchell/hlint/pull/1594 - if !(flag(hlint) && impl(ghc < 9.10)) + if !(flag(hlint)) || impl(ghc > 9.10) buildable: False exposed-modules: Ide.Plugin.Hlint hs-source-dirs: plugins/hls-hlint-plugin/src @@ -764,7 +765,7 @@ library hls-hlint-plugin test-suite hls-hlint-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !(flag(hlint) && impl(ghc < 9.10)) + if (!flag(hlint)) || impl(ghc > 9.10) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-hlint-plugin/test @@ -791,18 +792,16 @@ test-suite hls-hlint-plugin-tests flag stan description: Enable stan plugin default: True - manual: False + manual: True common stan - if flag(stan) + if flag(stan) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-stan-plugin cpp-options: -Dhls_stan library hls-stan-plugin import: defaults, pedantic, warnings - if flag(stan) - buildable: True - else + if !flag(stan) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Stan hs-source-dirs: plugins/hls-stan-plugin/src @@ -828,9 +827,7 @@ library hls-stan-plugin test-suite hls-stan-plugin-tests import: defaults, pedantic, test-defaults, warnings - if flag(stan) - buildable: True - else + if !flag(stan) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-stan-plugin/test @@ -854,16 +851,16 @@ test-suite hls-stan-plugin-tests flag moduleName description: Enable moduleName plugin default: True - manual: False + manual: True common moduleName - if flag(moduleName) + if flag(moduleName) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-module-name-plugin cpp-options: -Dhls_moduleName library hls-module-name-plugin import: defaults, pedantic, warnings - if !flag(modulename) + if !flag(modulename) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.ModuleName hs-source-dirs: plugins/hls-module-name-plugin/src @@ -882,7 +879,7 @@ library hls-module-name-plugin test-suite hls-module-name-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(modulename) + if !flag(modulename) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-module-name-plugin/test @@ -900,16 +897,16 @@ test-suite hls-module-name-plugin-tests flag pragmas description: Enable pragmas plugin default: True - manual: False + manual: True common pragmas - if flag(pragmas) + if flag(pragmas) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-pragmas-plugin cpp-options: -Dhls_pragmas library hls-pragmas-plugin import: defaults, pedantic, warnings - if !flag(pragmas) + if !flag(pragmas) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Pragmas hs-source-dirs: plugins/hls-pragmas-plugin/src @@ -929,7 +926,7 @@ library hls-pragmas-plugin test-suite hls-pragmas-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(pragmas) + if !flag(pragmas) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-pragmas-plugin/test @@ -951,7 +948,7 @@ test-suite hls-pragmas-plugin-tests flag splice description: Enable splice plugin default: True - manual: False + manual: True common splice if flag(splice) && impl(ghc < 9.10) @@ -1008,16 +1005,16 @@ test-suite hls-splice-plugin-tests flag alternateNumberFormat description: Enable Alternate Number Format plugin default: True - manual: False + manual: True common alternateNumberFormat - if flag(alternateNumberFormat) + if flag(alternateNumberFormat) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-alternate-number-format-plugin cpp-options: -Dhls_alternateNumberFormat library hls-alternate-number-format-plugin import: defaults, pedantic, warnings - if !flag(alternateNumberFormat) + if !flag(alternateNumberFormat) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.AlternateNumberFormat, Ide.Plugin.Conversion other-modules: Ide.Plugin.Literals @@ -1044,7 +1041,7 @@ library hls-alternate-number-format-plugin test-suite hls-alternate-number-format-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(alternateNumberFormat) + if !flag(alternateNumberFormat) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-alternate-number-format-plugin/test @@ -1072,16 +1069,16 @@ test-suite hls-alternate-number-format-plugin-tests flag qualifyImportedNames description: Enable qualifyImportedNames plugin default: True - manual: False + manual: True common qualifyImportedNames - if flag(qualifyImportedNames) + if flag(qualifyImportedNames) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-qualify-imported-names-plugin cpp-options: -Dhls_qualifyImportedNames library hls-qualify-imported-names-plugin import: defaults, pedantic, warnings - if !flag(qualifyImportedNames) + if !flag(qualifyImportedNames) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.QualifyImportedNames hs-source-dirs: plugins/hls-qualify-imported-names-plugin/src @@ -1102,7 +1099,7 @@ library hls-qualify-imported-names-plugin test-suite hls-qualify-imported-names-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(qualifyImportedNames) + if !flag(qualifyImportedNames) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-qualify-imported-names-plugin/test @@ -1121,16 +1118,16 @@ test-suite hls-qualify-imported-names-plugin-tests flag codeRange description: Enable Code Range plugin default: True - manual: False + manual: True common codeRange - if flag(codeRange) + if flag(codeRange) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-code-range-plugin cpp-options: -Dhls_codeRange library hls-code-range-plugin import: defaults, pedantic, warnings - if !flag(codeRange) + if !flag(codeRange) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.CodeRange @@ -1155,7 +1152,7 @@ library hls-code-range-plugin test-suite hls-code-range-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(codeRange) + if !flag(codeRange) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-code-range-plugin/test @@ -1182,16 +1179,16 @@ test-suite hls-code-range-plugin-tests flag changeTypeSignature description: Enable changeTypeSignature plugin default: True - manual: False + manual: True common changeTypeSignature - if flag(changeTypeSignature) + if flag(changeTypeSignature) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-change-type-signature-plugin cpp-options: -Dhls_changeTypeSignature library hls-change-type-signature-plugin import: defaults, pedantic, warnings - if !flag(changeTypeSignature) + if !flag(changeTypeSignature) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.ChangeTypeSignature hs-source-dirs: plugins/hls-change-type-signature-plugin/src @@ -1214,7 +1211,7 @@ library hls-change-type-signature-plugin test-suite hls-change-type-signature-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(changeTypeSignature) + if !flag(changeTypeSignature) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-change-type-signature-plugin/test @@ -1237,16 +1234,16 @@ test-suite hls-change-type-signature-plugin-tests flag gadt description: Enable gadt plugin default: True - manual: False + manual: True common gadt - if flag(gadt) + if flag(gadt) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-gadt-plugin cpp-options: -Dhls_gadt library hls-gadt-plugin import: defaults, pedantic, warnings - if !flag(gadt) + if !flag(gadt) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.GADT other-modules: Ide.Plugin.GHC @@ -1271,7 +1268,7 @@ library hls-gadt-plugin test-suite hls-gadt-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(gadt) + if !flag(gadt) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-gadt-plugin/test @@ -1290,16 +1287,16 @@ test-suite hls-gadt-plugin-tests flag explicitFixity description: Enable explicitFixity plugin default: True - manual: False + manual: True common explicitFixity - if flag(explicitFixity) + if flag(explicitFixity) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-explicit-fixity-plugin cpp-options: -DexplicitFixity library hls-explicit-fixity-plugin import: defaults, pedantic, warnings - if !flag(explicitFixity) + if !flag(explicitFixity) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.ExplicitFixity hs-source-dirs: plugins/hls-explicit-fixity-plugin/src @@ -1318,7 +1315,7 @@ library hls-explicit-fixity-plugin test-suite hls-explicit-fixity-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(explicitFixity) + if !flag(explicitFixity) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-explicit-fixity-plugin/test @@ -1337,16 +1334,16 @@ test-suite hls-explicit-fixity-plugin-tests flag explicitFields description: Enable explicitFields plugin default: True - manual: False + manual: True common explicitFields - if flag(explicitFields) + if flag(explicitFields) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-explicit-record-fields-plugin cpp-options: -DexplicitFields library hls-explicit-record-fields-plugin import: defaults, pedantic, warnings - if !flag(explicitFields) + if !flag(explicitFields) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.ExplicitFields build-depends: @@ -1368,7 +1365,7 @@ library hls-explicit-record-fields-plugin test-suite hls-explicit-record-fields-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(explicitFields) + if !flag(explicitFields) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-explicit-record-fields-plugin/test @@ -1388,16 +1385,16 @@ test-suite hls-explicit-record-fields-plugin-tests flag overloadedRecordDot description: Enable overloadedRecordDot plugin default: True - manual: False + manual: True common overloadedRecordDot - if flag(overloadedRecordDot) + if flag(overloadedRecordDot) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-overloaded-record-dot-plugin cpp-options: -Dhls_overloaded_record_dot library hls-overloaded-record-dot-plugin import: defaults, pedantic, warnings - if !flag(overloadedRecordDot) + if !flag(overloadedRecordDot) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.OverloadedRecordDot build-depends: @@ -1417,7 +1414,7 @@ library hls-overloaded-record-dot-plugin test-suite hls-overloaded-record-dot-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(overloadedRecordDot) + if !flag(overloadedRecordDot) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-overloaded-record-dot-plugin/test @@ -1437,7 +1434,7 @@ test-suite hls-overloaded-record-dot-plugin-tests flag floskell description: Enable floskell plugin default: True - manual: False + manual: True common floskell if flag(floskell) && impl(ghc < 9.10) @@ -1481,16 +1478,16 @@ test-suite hls-floskell-plugin-tests flag fourmolu description: Enable fourmolu plugin default: True - manual: False + manual: True common fourmolu - if flag(fourmolu) + if flag(fourmolu) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-fourmolu-plugin cpp-options: -Dhls_fourmolu library hls-fourmolu-plugin import: defaults, pedantic, warnings - if !flag(fourmolu) + if !flag(fourmolu) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Fourmolu hs-source-dirs: plugins/hls-fourmolu-plugin/src @@ -1511,7 +1508,7 @@ library hls-fourmolu-plugin test-suite hls-fourmolu-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(fourmolu) + if !flag(fourmolu) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-fourmolu-plugin/test @@ -1537,16 +1534,16 @@ test-suite hls-fourmolu-plugin-tests flag ormolu description: Enable ormolu plugin default: True - manual: False + manual: True common ormolu - if flag(ormolu) + if flag(ormolu) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-ormolu-plugin cpp-options: -Dhls_ormolu library hls-ormolu-plugin import: defaults, pedantic, warnings - if !flag(ormolu) + if !flag(ormolu) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Ormolu hs-source-dirs: plugins/hls-ormolu-plugin/src @@ -1567,7 +1564,7 @@ library hls-ormolu-plugin test-suite hls-ormolu-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(ormolu) + if !flag(ormolu) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-ormolu-plugin/test @@ -1594,7 +1591,7 @@ test-suite hls-ormolu-plugin-tests flag stylishHaskell description: Enable stylishHaskell plugin default: True - manual: False + manual: True common stylishHaskell if flag(stylishHaskell) && impl(ghc < 9.10) @@ -1641,16 +1638,16 @@ test-suite hls-stylish-haskell-plugin-tests flag refactor description: Enable refactor plugin default: True - manual: False + manual: True common refactor - if flag(refactor) + if flag(refactor) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-refactor-plugin cpp-options: -Dhls_refactor library hls-refactor-plugin import: defaults, pedantic, warnings - if !flag(refactor) + if !flag(refactor) || impl(ghc > 9.11) buildable: False exposed-modules: Development.IDE.GHC.ExactPrint Development.IDE.GHC.Compat.ExactPrint @@ -1710,7 +1707,7 @@ library hls-refactor-plugin test-suite hls-refactor-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(refactor) + if !flag(refactor) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-refactor-plugin/test @@ -1744,16 +1741,16 @@ test-suite hls-refactor-plugin-tests flag semanticTokens description: Enable semantic tokens plugin default: True - manual: False + manual: True common semanticTokens - if flag(semanticTokens) + if flag(semanticTokens) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-semantic-tokens-plugin cpp-options: -Dhls_semanticTokens library hls-semantic-tokens-plugin import: defaults, pedantic, warnings - if !flag(semanticTokens) + if !flag(semanticTokens) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.SemanticTokens @@ -1794,7 +1791,7 @@ library hls-semantic-tokens-plugin test-suite hls-semantic-tokens-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(semanticTokens) + if !flag(semanticTokens) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-semantic-tokens-plugin/test @@ -1823,16 +1820,16 @@ test-suite hls-semantic-tokens-plugin-tests flag notes description: Enable notes plugin default: True - manual: False + manual: True common notes - if flag(notes) + if flag(notes) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-notes-plugin cpp-options: -Dhls_notes library hls-notes-plugin import: defaults, pedantic, warnings - if !flag(notes) + if !flag(notes) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Notes @@ -1860,7 +1857,7 @@ library hls-notes-plugin test-suite hls-notes-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(notes) + if !flag(notes) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-notes-plugin/test @@ -2063,14 +2060,14 @@ test-suite func-test default-extensions: OverloadedStrings -- Duplicating inclusion plugin conditions until tests are moved to their own packages - if flag(eval) + if flag(eval) && impl(ghc < 9.11) cpp-options: -Dhls_eval -- formatters if flag(floskell) && impl(ghc < 9.10) cpp-options: -Dhls_floskell - if flag(fourmolu) + if flag(fourmolu) && impl(ghc < 9.11) cpp-options: -Dhls_fourmolu - if flag(ormolu) + if flag(ormolu) && impl(ghc < 9.11) cpp-options: -Dhls_ormolu test-suite wrapper-test From d342cdf4a1ebb2dbbc78b490072508fd4a80328b Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 18:44:59 +0800 Subject: [PATCH 32/46] fix: update GHC versions in release workflow to include 9.12.2 --- .github/workflows/release.yaml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/release.yaml b/.github/workflows/release.yaml index fc3f98bcca..60c2cd8fc4 100644 --- a/.github/workflows/release.yaml +++ b/.github/workflows/release.yaml @@ -30,7 +30,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.10.1", "9.8.2", "9.6.6", "9.4.8"] + ghc: ["9.12.2", "9.10.1", "9.8.2", "9.6.6", "9.4.8"] platform: [ { image: "debian:9" , installCmd: "sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && sed -i 's|security.debian.org|archive.debian.org/|g' /etc/apt/sources.list && sed -i /-updates/d /etc/apt/sources.list && apt-get update && apt-get install -y" , toolRequirements: "libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip libffi-dev libncurses-dev libncurses5 libtinfo5 patchelf" @@ -213,7 +213,7 @@ jobs: strategy: fail-fast: true matrix: - ghc: ["9.10.1", "9.8.2", "9.6.6", "9.4.8"] + ghc: ["9.12.2", "9.10.1", "9.8.2", "9.6.6", "9.4.8"] steps: - uses: docker://arm64v8/ubuntu:focal name: Cleanup (aarch64 linux) @@ -273,7 +273,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.10.1", "9.8.2", "9.6.6", "9.4.8"] + ghc: ["9.12.2", "9.10.1", "9.8.2", "9.6.6", "9.4.8"] steps: - name: Checkout code uses: actions/checkout@v3 @@ -318,7 +318,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.10.1", "9.8.2", "9.6.6", "9.4.8"] + ghc: ["9.12.2", "9.10.1", "9.8.2", "9.6.6", "9.4.8"] steps: - name: Checkout code uses: actions/checkout@v3 @@ -363,7 +363,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ["9.10.1", "9.8.2", "9.6.6", "9.4.8"] + ghc: ["9.12.2", "9.10.1", "9.8.2", "9.6.6", "9.4.8"] steps: - name: install windows deps shell: pwsh From b488aa31cee8b989c0aa07092442d949e3a59e23 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 18:54:22 +0800 Subject: [PATCH 33/46] disable plugins for 9.12.2 --- .github/workflows/supported-ghc-versions.json | 2 +- .github/workflows/test.yml | 58 +++++++++---------- 2 files changed, 30 insertions(+), 30 deletions(-) diff --git a/.github/workflows/supported-ghc-versions.json b/.github/workflows/supported-ghc-versions.json index b530e284e0..2816bb4e77 100644 --- a/.github/workflows/supported-ghc-versions.json +++ b/.github/workflows/supported-ghc-versions.json @@ -1 +1 @@ -["9.10", "9.8", "9.6", "9.4"] +["9.12.2", "9.10", "9.8", "9.6", "9.4"] diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 544a9c6e78..41c7b2a44d 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -134,125 +134,125 @@ jobs: HLS_WRAPPER_TEST_EXE: hls-wrapper run: cabal test wrapper-test - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-class-plugin run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-pragmas-plugin run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-eval-plugin run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-splice-plugin run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-stan-plugin run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-explicit-imports-plugin test suite run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests - - if: matrix.test && matrix.os != 'windows-latest' + - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc != '9.12' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-module-name-plugin test suite run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-alternate-number-format-plugin test suite run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-qualify-imported-names-plugin test suite run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-code-range-plugin test suite run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-change-type-signature test suite run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-gadt-plugin test suit run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-explicit-fixity-plugin test suite run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-explicit-record-fields-plugin test suite run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests # versions need to be limited since the tests depend on cabal-fmt which only builds with ghc <9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-cabal-fmt-plugin test suite run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-cabal-gild-plugin test suite run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-cabal-plugin test suite run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-retrie-plugin test suite run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-overloaded-record-dot-plugin test suite run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-semantic-tokens-plugin test suite run: cabal test hls-semantic-tokens-plugin-tests || cabal test hls-semantic-tokens-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-notes-plugin test suite run: cabal test hls-notes-plugin-tests || cabal test hls-notes-plugin-tests From d7b5f005ef566321272c0a8f4ab66b01303a56d3 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 18:59:34 +0800 Subject: [PATCH 34/46] bump haskell-actions/setup to version 2.7.10 in build and benchmark workflows --- .github/actions/setup-build/action.yml | 2 +- .github/workflows/bench.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/actions/setup-build/action.yml b/.github/actions/setup-build/action.yml index 975fa90617..9237cadfbe 100644 --- a/.github/actions/setup-build/action.yml +++ b/.github/actions/setup-build/action.yml @@ -31,7 +31,7 @@ runs: sudo chown -R $USER /usr/local/.ghcup shell: bash - - uses: haskell-actions/setup@v2.7.9 + - uses: haskell-actions/setup@v2.7.10 id: HaskEnvSetup with: ghc-version : ${{ inputs.ghc }} diff --git a/.github/workflows/bench.yml b/.github/workflows/bench.yml index cb345c806e..0ac0ca68d0 100644 --- a/.github/workflows/bench.yml +++ b/.github/workflows/bench.yml @@ -127,7 +127,7 @@ jobs: example: ['cabal', 'lsp-types'] steps: - - uses: haskell-actions/setup@v2.7.9 + - uses: haskell-actions/setup@v2.7.10 with: ghc-version : ${{ matrix.ghc }} cabal-version: ${{ matrix.cabal }} From acdce95c977c5f91dc5f21a20ee2c103f2546c53 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 20:13:14 +0800 Subject: [PATCH 35/46] refactor: remove unused import from Compat.hs --- ghcide/src/Development/IDE/GHC/Compat.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 6ea302d35b..c1d3ac30ec 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -188,8 +188,6 @@ import GHC.Unit.Module.ModIface -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] - -import GHC.Driver.Config.Stg.Pipeline import GHC.Unit.Module.Deps (Dependencies (dep_direct_mods), Usage (..)) From fb977944a0873f9060ca610f5f2f164c3d7fa8db Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 20:16:00 +0800 Subject: [PATCH 36/46] refactor: qualify Data.Text import in ExceptionTests.hs --- ghcide/test/exe/ExceptionTests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/ExceptionTests.hs b/ghcide/test/exe/ExceptionTests.hs index 756e7e0547..a95f91e97c 100644 --- a/ghcide/test/exe/ExceptionTests.hs +++ b/ghcide/test/exe/ExceptionTests.hs @@ -8,7 +8,7 @@ import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as A import Data.Default (Default (..)) -import Data.Text as T +import qualified Data.Text as T import Development.IDE.Core.Shake (IdeState (..)) import qualified Development.IDE.LSP.Notifications as Notifications import Development.IDE.Plugin.HLS (toResponseError) From 5b3619f8a439ddf0bef53cf4ea47f7d27bda2a53 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 20:16:40 +0800 Subject: [PATCH 37/46] disable bench to proceed --- cabal.project | 18 ++++++++++++++++-- ghcide/cabal.project | 2 +- haskell-language-server.cabal | 2 ++ hie-compat/hie-compat.cabal | 2 +- shake-bench/shake-bench.cabal | 2 ++ 5 files changed, 22 insertions(+), 4 deletions(-) diff --git a/cabal.project b/cabal.project index 6f6d6d716e..36f3c01b8f 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ packages: ./hls-plugin-api ./hls-test-utils -index-state: 2025-03-17T00:00:00Z +index-state: 2025-03-17T11:03:01Z tests: True test-show-details: direct @@ -59,7 +59,21 @@ if impl(ghc >= 9.8.4) && impl(ghc < 9.8.5) constraints: ghc-lib-parser==9.8.4.20241130 -if impl(ghc >= 9.11.0) +-- keep it here for easy debugging when trying to support new GHC versions +if impl(ghc >= 9.13.0) allow-newer: base , ghc + +source-repository-package + type: git + location: https://github.com/soulomoon/HieDb.git + tag: 9111fd0f2e4d2d5186c4de7afb7ea9f3a2941105 +-- todo remove this once the PR is released +-- https://github.com/wz1000/HieDb/pull/80 + + +source-repository-package + type: git + location: https://github.com/maoe/ghc-trace-events.git + tag: f18107dec920564f7cbcde52e17d0b4b41add5a3 diff --git a/ghcide/cabal.project b/ghcide/cabal.project index 5d7ae19b2d..06b0de6b87 100644 --- a/ghcide/cabal.project +++ b/ghcide/cabal.project @@ -1,7 +1,7 @@ packages: ./ -if impl(ghc >= 9.12.0) +if impl(ghc >= 9.11.0) allow-newer: base , ghc diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index f296bd437c..c1ba55b30a 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -2090,6 +2090,8 @@ test-suite wrapper-test benchmark benchmark import: defaults, warnings + if impl(ghc > 9.11) + buildable: False -- Depends on shake-bench which is unbuildable after this point type: exitcode-stdio-1.0 ghc-options: -threaded diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index bb96ab88fb..2b361df887 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -24,7 +24,7 @@ source-repository head library default-language: GHC2021 build-depends: - base < 4.21, array, bytestring, containers, directory, filepath, transformers + base < 4.22, array, bytestring, containers, directory, filepath, transformers build-depends: ghc >= 8.10, ghc-boot ghc-options: -Wall -Wno-name-shadowing diff --git a/shake-bench/shake-bench.cabal b/shake-bench/shake-bench.cabal index eccd84edeb..c381089aba 100644 --- a/shake-bench/shake-bench.cabal +++ b/shake-bench/shake-bench.cabal @@ -16,6 +16,8 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library + if impl(ghc > 9.11) + buildable: False exposed-modules: Development.Benchmark.Rules hs-source-dirs: src build-depends: From 596bb42796124dde27f91b2b3754fa7233949254 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 17 Mar 2025 22:06:34 +0800 Subject: [PATCH 38/46] feat: add entityInfo to mkHieFile' for GHC 9.11.0 compatibility --- ghcide/src/Development/IDE/GHC/Compat.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index c1d3ac30ec..50b1380b62 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -372,6 +372,9 @@ mkHieFile' ms exports -- mkIfaceExports sorts the AvailInfos for stability , hie_exports = mkIfaceExports exports , hie_hs_src = src +#if MIN_VERSION_ghc(9,11,0) + , hie_entity_infos = entityInfo +#endif } addIncludePathsQuote :: FilePath -> DynFlags -> DynFlags From 36299b2d82727714cf6ebbbcb3bba84972d64487 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 18 Mar 2025 13:00:36 +0800 Subject: [PATCH 39/46] fix template haskell 9.12.2 --- ghcide/src/Development/IDE/Core/Compile.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index e443bf61fc..be5d7cdafd 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -353,7 +353,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do {- load it -} #if MIN_VERSION_ghc(9,11,0) ; bco_time <- getCurrentTime - ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env) hsc_env srcspan $ + ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan $ Linkable bco_time (icInteractiveModule ictxt) $ NE.singleton $ BCOs bcos ; let hval = ((expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs), lbss, pkgs) #else @@ -733,11 +733,13 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = do (warnings, (_, bytecode, sptEntries)) <- #endif withWarnings "bytecode" $ \_tweak -> do - let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) - -- TODO: maybe settings ms_hspp_opts is unnecessary? - summary' = summary { ms_hspp_opts = hsc_dflags session } - hscInteractive session (mkCgInteractiveGuts guts) - (ms_location summary') + let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) + -- TODO: maybe settings ms_hspp_opts is unnecessary? + summary' = summary {ms_hspp_opts = hsc_dflags session} + hscInteractive + session + (mkCgInteractiveGuts guts) + (ms_location summary') #if MIN_VERSION_ghc(9,11,0) let unlinked = BCOs bytecode #else @@ -1630,14 +1632,14 @@ coreFileToCgGuts session iface details core_file = do }) 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 -- only used if GHC < 9.6 - tyCons = typeEnvTyCons (md_types details) + let tyCons = typeEnvTyCons (md_types details) #if MIN_VERSION_ghc(9,11,0) pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty Nothing [] #elif MIN_VERSION_ghc(9,5,0) -- In GHC 9.6, the implicit binds are tidied and part of core_binds pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #else + let _implicit_binds = concatMap getImplicitBinds tyCons -- only used if GHC < 9.6 pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #endif From 37a4d6b98089257fa9272cf982582a888cde81ac Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 18 Mar 2025 13:17:54 +0800 Subject: [PATCH 40/46] fix: add conditional import for DuplicateRecordFields and FieldSelectors for GHC versions below 9.5.0 --- ghcide/src/Development/IDE/GHC/Orphans.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index e9b44a6b0d..e3facf41bf 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -25,8 +25,10 @@ import GHC.Data.Bag import GHC.Data.FastString import qualified GHC.Data.StringBuffer as SB import GHC.Parser.Annotation +#if !MIN_VERSION_ghc(9,5,0) import GHC.Types.FieldLabel (DuplicateRecordFields (DuplicateRecordFields, NoDuplicateRecordFields), FieldSelectors (FieldSelectors, NoFieldSelectors)) +#endif import GHC.Types.PkgQual import GHC.Types.SrcLoc From 8c810cff00414f0ab787475f7eb8ceec0bf3dbbb Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 18 Mar 2025 14:10:45 +0800 Subject: [PATCH 41/46] enable semanticTokens and notes --- .github/workflows/test.yml | 4 ++-- ghcide/src/Development/IDE/GHC/Compat.hs | 1 - ghcide/test/exe/UnitTests.hs | 4 ++-- haskell-language-server.cabal | 12 ++++++------ .../src/Ide/Plugin/SemanticTokens/Tokenize.hs | 12 +++++++++++- .../test/SemanticTokensTest.hs | 2 +- 6 files changed, 22 insertions(+), 13 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 41c7b2a44d..34c5315c62 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -248,11 +248,11 @@ jobs: name: Test hls-overloaded-record-dot-plugin test suite run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test name: Test hls-semantic-tokens-plugin test suite run: cabal test hls-semantic-tokens-plugin-tests || cabal test hls-semantic-tokens-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test name: Test hls-notes-plugin test suite run: cabal test hls-notes-plugin-tests || cabal test hls-notes-plugin-tests diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 50b1380b62..79a06c5b69 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -125,7 +125,6 @@ import Compat.HieUtils import Control.Applicative ((<|>)) import qualified Data.ByteString as BS import Data.Coerce (coerce) -import Data.List (foldl') import qualified Data.Map as Map import qualified Data.Set as S import Data.String (IsString (fromString)) diff --git a/ghcide/test/exe/UnitTests.hs b/ghcide/test/exe/UnitTests.hs index f26d394ce0..23d866660a 100644 --- a/ghcide/test/exe/UnitTests.hs +++ b/ghcide/test/exe/UnitTests.hs @@ -30,7 +30,7 @@ import System.IO.Extra hiding (withTempDir) import System.Mem (performGC) import Test.Hls (GhcVersion (GHC912), IdeState, def, - knownBrokenForGhcVersions, + ignoreForGhcVersions, runSessionWithServerInTmpDir, waitForProgressDone) import Test.Tasty @@ -99,7 +99,7 @@ tests = do let msg = printf "Timestamps do not have millisecond resolution: %dus" resolution_us assertBool msg (resolution_us <= 1000) , Progress.tests - , knownBrokenForGhcVersions [GHC912] "referenceImplementation get stuck" FuzzySearch.tests + , ignoreForGhcVersions [GHC912] "Fuzzy search: ignore since referenceImplementation get stuck for ghc912" $ FuzzySearch.tests ] findResolution_us :: Int -> IO Int diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c1ba55b30a..c94133dfee 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -1744,13 +1744,13 @@ flag semanticTokens manual: True common semanticTokens - if flag(semanticTokens) && impl(ghc < 9.11) + if flag(semanticTokens) && impl(ghc < 9.13) build-depends: haskell-language-server:hls-semantic-tokens-plugin cpp-options: -Dhls_semanticTokens library hls-semantic-tokens-plugin import: defaults, pedantic, warnings - if !flag(semanticTokens) || impl(ghc > 9.11) + if !flag(semanticTokens) || impl(ghc > 9.13) buildable: False exposed-modules: Ide.Plugin.SemanticTokens @@ -1791,7 +1791,7 @@ library hls-semantic-tokens-plugin test-suite hls-semantic-tokens-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(semanticTokens) || impl(ghc > 9.11) + if !flag(semanticTokens) || impl(ghc > 9.13) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-semantic-tokens-plugin/test @@ -1823,13 +1823,13 @@ flag notes manual: True common notes - if flag(notes) && impl(ghc < 9.11) + if flag(notes) && impl(ghc < 9.13) build-depends: haskell-language-server:hls-notes-plugin cpp-options: -Dhls_notes library hls-notes-plugin import: defaults, pedantic, warnings - if !flag(notes) || impl(ghc > 9.11) + if !flag(notes) || impl(ghc > 9.13) buildable: False exposed-modules: Ide.Plugin.Notes @@ -1857,7 +1857,7 @@ library hls-notes-plugin test-suite hls-notes-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(notes) || impl(ghc > 9.11) + if !flag(notes) || impl(ghc > 9.13) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-notes-plugin/test diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs index 2ed11be333..15f3930b08 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs @@ -20,7 +20,17 @@ import qualified Data.Text.Rope as Char import qualified Data.Text.Utf16.Rope as Utf16 import Data.Text.Utf16.Rope.Mixed (Rope) import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat (HieAST (nodeChildren, nodeSpan, sourcedNodeInfo), + Identifier, + NodeInfo (NodeInfo), + NodeOrigin (SourceInfo), + RealSrcLoc, RealSrcSpan, + SourcedNodeInfo (getSourcedNodeInfo), + nameOccName, occNameString, + realSrcSpanEnd, + realSrcSpanStart, srcLocCol, + srcLocLine, srcSpanEndLine, + srcSpanStartLine) import Development.IDE.GHC.Error (realSrcSpanToCodePointRange) import Ide.Plugin.SemanticTokens.Types (HsSemanticTokenType (TModule), RangeHsSemanticTokenTypes (..)) diff --git a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs index eacd47e2d2..3a2e553b44 100644 --- a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs +++ b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs @@ -10,7 +10,7 @@ import Data.Functor (void) import qualified Data.List as T import Data.Map.Strict as Map hiding (map) import Data.String (fromString) -import Data.Text hiding (length, map, +import Data.Text hiding (length, map, show, unlines) import qualified Data.Text as Text import qualified Data.Text.Utf16.Rope.Mixed as Rope From 91f1cbc7f23e1cd35ecceb933aefafc2c040877e Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 18 Mar 2025 15:31:13 +0800 Subject: [PATCH 42/46] fix import --- ghcide/src/Development/IDE/GHC/Compat.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 79a06c5b69..cae6c72bd0 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -125,6 +125,9 @@ import Compat.HieUtils import Control.Applicative ((<|>)) import qualified Data.ByteString as BS import Data.Coerce (coerce) +#if !MIN_VERSION_ghc(9,7,0) +import Data.List (foldl') +#endif import qualified Data.Map as Map import qualified Data.Set as S import Data.String (IsString (fromString)) From 1c620b2a003c8f9c931a50ffc0b04e7d5ddd997f Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 18 Mar 2025 15:31:39 +0800 Subject: [PATCH 43/46] fix import --- ghcide/src/Development/IDE/GHC/Compat.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index cae6c72bd0..cc0d29b3fa 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -125,7 +125,7 @@ import Compat.HieUtils import Control.Applicative ((<|>)) import qualified Data.ByteString as BS import Data.Coerce (coerce) -#if !MIN_VERSION_ghc(9,7,0) +#if !MIN_VERSION_ghc(9,9,0) import Data.List (foldl') #endif import qualified Data.Map as Map From 8405a21f0b62287bb72a37dd5ab25513d2f43485 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 18 Mar 2025 15:33:58 +0800 Subject: [PATCH 44/46] fix version bound in matrix --- .github/workflows/test.yml | 54 +++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 34c5315c62..217b7b36ad 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -134,117 +134,117 @@ jobs: HLS_WRAPPER_TEST_EXE: hls-wrapper run: cabal test wrapper-test - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-class-plugin run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-pragmas-plugin run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-eval-plugin run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' name: Test hls-splice-plugin run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-stan-plugin run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-explicit-imports-plugin test suite run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests - - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc != '9.12' + - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc < '9.11' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-module-name-plugin test suite run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-alternate-number-format-plugin test suite run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-qualify-imported-names-plugin test suite run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-code-range-plugin test suite run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-change-type-signature test suite run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-gadt-plugin test suit run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-explicit-fixity-plugin test suite run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-explicit-record-fields-plugin test suite run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests # versions need to be limited since the tests depend on cabal-fmt which only builds with ghc <9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' name: Test hls-cabal-fmt-plugin test suite run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-cabal-gild-plugin test suite run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-cabal-plugin test suite run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' name: Test hls-retrie-plugin test suite run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests - - if: matrix.test && matrix.ghc != '9.12' + - if: matrix.test && matrix.ghc < '9.11' name: Test hls-overloaded-record-dot-plugin test suite run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests From a366ad7f97e8e8b8c413cec6db2163ed52c6851d Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 18 Mar 2025 15:50:22 +0800 Subject: [PATCH 45/46] fix CI --- .github/workflows/test.yml | 54 +++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 217b7b36ad..714f7bc51b 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -134,117 +134,117 @@ jobs: HLS_WRAPPER_TEST_EXE: hls-wrapper run: cabal test wrapper-test - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12.2' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-class-plugin run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-pragmas-plugin run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-eval-plugin run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12.2' name: Test hls-splice-plugin run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-stan-plugin run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12.2' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-explicit-imports-plugin test suite run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests - - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc < '9.11' + - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc != '9.12.2' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12.2' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-module-name-plugin test suite run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-alternate-number-format-plugin test suite run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-qualify-imported-names-plugin test suite run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-code-range-plugin test suite run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-change-type-signature test suite run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-gadt-plugin test suit run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-explicit-fixity-plugin test suite run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-explicit-record-fields-plugin test suite run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests # versions need to be limited since the tests depend on cabal-fmt which only builds with ghc <9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12.2' name: Test hls-cabal-fmt-plugin test suite run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-cabal-gild-plugin test suite run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-cabal-plugin test suite run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12.2' name: Test hls-retrie-plugin test suite run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests - - if: matrix.test && matrix.ghc < '9.11' + - if: matrix.test && matrix.ghc != '9.12.2' name: Test hls-overloaded-record-dot-plugin test suite run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests From 1349bcd1239c9e56ea28810d5adb7805cbb1ca14 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 25 Mar 2025 00:35:21 +0800 Subject: [PATCH 46/46] enable call hierarchy --- haskell-language-server.cabal | 7 ++++--- plugins/hls-call-hierarchy-plugin/test/Main.hs | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c94133dfee..eede5ec4ed 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -387,13 +387,13 @@ flag callHierarchy manual: True common callHierarchy - if flag(callHierarchy) && impl(ghc < 9.11) + if flag(callHierarchy) && impl(ghc < 9.13) build-depends: haskell-language-server:hls-call-hierarchy-plugin cpp-options: -Dhls_callHierarchy library hls-call-hierarchy-plugin import: defaults, pedantic, warnings - if !flag(callHierarchy) || impl(ghc > 9.11) + if !flag(callHierarchy) || impl(ghc > 9.13) buildable: False exposed-modules: Ide.Plugin.CallHierarchy other-modules: @@ -419,7 +419,7 @@ library hls-call-hierarchy-plugin test-suite hls-call-hierarchy-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(callHierarchy) || impl(ghc > 9.11) + if !flag(callHierarchy) || impl(ghc > 9.13) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-call-hierarchy-plugin/test @@ -1778,6 +1778,7 @@ library hls-semantic-tokens-plugin , transformers , bytestring , syb + , time , array , deepseq , dlist diff --git a/plugins/hls-call-hierarchy-plugin/test/Main.hs b/plugins/hls-call-hierarchy-plugin/test/Main.hs index f356a0e278..5eed229c98 100644 --- a/plugins/hls-call-hierarchy-plugin/test/Main.hs +++ b/plugins/hls-call-hierarchy-plugin/test/Main.hs @@ -114,13 +114,13 @@ prepareCallHierarchyTests = [ testCase "1" $ do let contents = T.unlines ["{-# LANGUAGE TypeFamilies #-}", "data family A"] -- Since GHC 9.10 the range also includes the family name (and its parameters if any) - range = mkRange 1 0 1 (if ghcVersion == GHC910 then 13 else 11) + range = mkRange 1 0 1 (if ghcVersion `elem` [GHC912, GHC910] then 13 else 11) selRange = mkRange 1 12 1 13 expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected , testCase "2" $ do let contents = T.unlines [ "{-# LANGUAGE TypeFamilies #-}" , "data family A a"] - range = mkRange 1 0 1 (if ghcVersion == GHC910 then 15 else 11) + range = mkRange 1 0 1 (if ghcVersion `elem` [GHC912, GHC910] then 15 else 11) selRange = mkRange 1 12 1 13 expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected