diff --git a/patches/ghcide-2.9.0.0.patch b/patches/ghcide-2.9.0.0.patch index c9f61d3ae08627a4dc76c9ca222a5b8618a5a0d1..f0afd7b3fdcdb6e9534f930fe45e555bb2336a4c 100644 --- a/patches/ghcide-2.9.0.0.patch +++ b/patches/ghcide-2.9.0.0.patch @@ -11,25 +11,26 @@ index 26b9256..5da5a51 100644 , prettyprinter >=1.7 , prettyprinter-ansi-terminal diff --git a/src/Development/IDE/Core/Compile.hs b/src/Development/IDE/Core/Compile.hs -index af1c97a..5c450e1 100644 +index af1c97a..29d892c 100644 --- a/src/Development/IDE/Core/Compile.hs +++ b/src/Development/IDE/Core/Compile.hs -@@ -473,7 +473,13 @@ mkHiFileResultNoCompile session tcm = do +@@ -473,7 +473,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] -+ let iface = iface' { mi_usages = filterUsages (mi_usages iface') ++ -- See Note [Clearing mi_globals after generating an iface] ++ let iface = iface' +#if MIN_VERSION_ghc(9,11,0) -+ , mi_top_env = Nothing ++ & set_mi_top_env Nothing ++ & set_mi_usages (filterUsages (mi_usages iface')) +#else -+ , mi_globals = Nothing ++ { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } +#endif -+ } -- See Note [Clearing mi_globals after generating an iface] pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing mkHiFileResultCompile -@@ -500,6 +506,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do +@@ -500,6 +507,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do details #if MIN_VERSION_ghc(9,3,0) ms @@ -39,22 +40,23 @@ index af1c97a..5c450e1 100644 #endif simplified_guts -@@ -507,7 +516,13 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do +@@ -507,7 +517,14 @@ 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' { 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 ++ & set_mi_top_env Nothing ++ & set_mi_usages (filterUsages (mi_usages final_iface')) +#else -+ , mi_globals = Nothing ++ {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} +#endif -+ } -- See Note [Clearing mi_globals after generating an iface] -- Write the core file now core_file <- do -@@ -515,7 +530,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do +@@ -515,7 +532,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 -> @@ -63,6 +65,35 @@ index af1c97a..5c450e1 100644 -- 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 +@@ -828,8 +845,18 @@ 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 = 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 ++ 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] +@@ -840,7 +867,7 @@ generateHieAsts hscEnv tcm = + #else + Just <$> + #endif +- GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs ++ GHC.enrichHie all_binds (tmrRenamed tcm) top_ev_binds insts tcs + where + dflags = hsc_dflags hscEnv + run _ts = -- ts is only used in GHC 9.2 diff --git a/src/Development/IDE/Core/RuleTypes.hs b/src/Development/IDE/Core/RuleTypes.hs index 3d60669..499a7e2 100644 --- a/src/Development/IDE/Core/RuleTypes.hs @@ -92,10 +123,37 @@ index b0ec869..13b1992 100644 addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s diff --git a/src/Development/IDE/GHC/Compat/Core.hs b/src/Development/IDE/GHC/Compat/Core.hs -index 06f798d..7a8e79a 100644 +index 06f798d..04dfcc0 100644 --- a/src/Development/IDE/GHC/Compat/Core.hs +++ b/src/Development/IDE/GHC/Compat/Core.hs -@@ -564,8 +564,14 @@ import GHC.Utils.TmpFs +@@ -72,6 +72,11 @@ module Development.IDE.GHC.Compat.Core ( + IfaceTyCon(..), + ModIface, + ModIface_(..), ++#if MIN_VERSION_ghc(9,11,0) ++ pattern ModIface, ++ set_mi_top_env, ++ set_mi_usages, ++#endif + HscSource(..), + WhereFrom(..), + loadInterface, +@@ -530,7 +535,13 @@ 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 Language.Haskell.Syntax hiding (FunDep) + +@@ -564,8 +575,14 @@ import GHC.Utils.TmpFs import GHC.Types.Avail (greNamePrintableName) #endif @@ -111,7 +169,7 @@ index 06f798d..7a8e79a 100644 mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f #else mkHomeModLocation = GHC.mkHomeModLocation -@@ -744,7 +750,7 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE +@@ -744,7 +761,7 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE #endif ,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)}