From b29a78ef6926101338f62e84f456dac8659dc9d2 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Thu, 16 Dec 2021 09:29:51 +0100
Subject: [PATCH] Bump ghc-head (#1445)
* Update after NoExtCon -> DataConCantHappen rename
* Update html-test for Data.List revert
* Fix for new Plugins datatype
Co-authored-by: Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io>
Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com>
---
haddock-api/src/Haddock/GhcUtils.hs | 2 +-
haddock-api/src/Haddock/Interface.hs | 14 ++++++++------
haddock-api/src/Haddock/Types.hs | 24 ++++++++++++------------
html-test/ref/Identifiers.html | 10 +++++-----
4 files changed, 26 insertions(+), 24 deletions(-)
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 599404a012..85e6fcf4d1 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -114,7 +114,7 @@ pretty = showPpr
-- instantiated at DocNameI instead of (GhcPass _).
-- | Like 'hsTyVarName' from GHC API, but not instantiated at (GhcPass _)
-hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ NoExtCon, UnXRec n)
+hsTyVarBndrName :: forall flag n. (XXTyVarBndr n ~ DataConCantHappen, UnXRec n)
=> HsTyVarBndr flag n -> IdP n
hsTyVarBndrName (UserTyVar _ _ name) = unXRec @n name
hsTyVarBndrName (KindedTyVar _ _ name _) = unXRec @n name
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index ba7d9d3047..e493471111 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -56,11 +56,11 @@ import qualified Data.Set as Set
import GHC hiding (verbosity)
import GHC.Data.FastString (unpackFS)
import GHC.Data.Graph.Directed
-import GHC.Driver.Env (hscUpdateFlags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units)
+import GHC.Driver.Env
import GHC.Driver.Monad (modifySession, withTimingM)
import GHC.Driver.Session hiding (verbosity)
import GHC.HsToCore.Docs (getMainDeclBinder)
-import GHC.Plugins (Outputable, Plugin (..), PluginWithArgs (..), StaticPlugin (..), defaultPlugin, keepRenamedSource)
+import GHC.Plugins
import GHC.Tc.Types (TcGblEnv (..), TcM)
import GHC.Tc.Utils.Env (tcLookupGlobal)
import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv)
@@ -145,10 +145,12 @@ createIfaces verbosity modules flags instIfaceMap = do
let
installHaddockPlugin :: HscEnv -> HscEnv
- installHaddockPlugin hsc_env = hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) $ hsc_env
- { hsc_static_plugins =
- haddockPlugin : hsc_static_plugins hsc_env
- }
+ installHaddockPlugin hsc_env =
+ let
+ old_plugins = hsc_plugins hsc_env
+ new_plugins = old_plugins { staticPlugins = haddockPlugin : staticPlugins old_plugins }
+ hsc_env' = hsc_env { hsc_plugins = new_plugins }
+ in hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) hsc_env'
-- Note that we would rather use withTempSession but as long as we
-- have the separate attachInstances step we need to keep the session
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 0537518563..30f583b05f 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -319,7 +319,7 @@ type instance NoGhcTc DocNameI = DocNameI
type instance IdP DocNameI = DocName
instance CollectPass DocNameI where
- collectXXPat _ _ ext = noExtCon ext
+ collectXXPat _ _ ext = dataConCantHappen ext
instance NamedThing DocName where
getName (Documented name _) = name
@@ -760,11 +760,11 @@ type instance XXType DocNameI = HsCoreTy
type instance XHsForAllVis DocNameI = NoExtField
type instance XHsForAllInvis DocNameI = NoExtField
-type instance XXHsForAllTelescope DocNameI = NoExtCon
+type instance XXHsForAllTelescope DocNameI = DataConCantHappen
type instance XUserTyVar DocNameI = NoExtField
type instance XKindedTyVar DocNameI = NoExtField
-type instance XXTyVarBndr DocNameI = NoExtCon
+type instance XXTyVarBndr DocNameI = DataConCantHappen
type instance XCFieldOcc DocNameI = DocName
type instance XXFieldOcc DocNameI = NoExtField
@@ -780,7 +780,7 @@ type instance XForeignExport DocNameI = NoExtField
type instance XForeignImport DocNameI = NoExtField
type instance XConDeclGADT DocNameI = NoExtField
type instance XConDeclH98 DocNameI = NoExtField
-type instance XXConDecl DocNameI = NoExtCon
+type instance XXConDecl DocNameI = DataConCantHappen
type instance XDerivD DocNameI = NoExtField
type instance XInstD DocNameI = NoExtField
@@ -791,10 +791,10 @@ type instance XTyClD DocNameI = NoExtField
type instance XNoSig DocNameI = NoExtField
type instance XCKindSig DocNameI = NoExtField
type instance XTyVarSig DocNameI = NoExtField
-type instance XXFamilyResultSig DocNameI = NoExtCon
+type instance XXFamilyResultSig DocNameI = DataConCantHappen
type instance XCFamEqn DocNameI _ = NoExtField
-type instance XXFamEqn DocNameI _ = NoExtCon
+type instance XXFamEqn DocNameI _ = DataConCantHappen
type instance XCClsInstDecl DocNameI = NoExtField
type instance XCDerivDecl DocNameI = NoExtField
@@ -811,23 +811,23 @@ type instance XClassDecl DocNameI = NoExtField
type instance XDataDecl DocNameI = NoExtField
type instance XSynDecl DocNameI = NoExtField
type instance XFamDecl DocNameI = NoExtField
-type instance XXFamilyDecl DocNameI = NoExtCon
-type instance XXTyClDecl DocNameI = NoExtCon
+type instance XXFamilyDecl DocNameI = DataConCantHappen
+type instance XXTyClDecl DocNameI = DataConCantHappen
type instance XHsWC DocNameI _ = NoExtField
type instance XHsOuterExplicit DocNameI _ = NoExtField
type instance XHsOuterImplicit DocNameI = NoExtField
-type instance XXHsOuterTyVarBndrs DocNameI = NoExtCon
+type instance XXHsOuterTyVarBndrs DocNameI = DataConCantHappen
type instance XHsSig DocNameI = NoExtField
-type instance XXHsSigType DocNameI = NoExtCon
+type instance XXHsSigType DocNameI = DataConCantHappen
type instance XHsQTvs DocNameI = NoExtField
type instance XConDeclField DocNameI = NoExtField
-type instance XXConDeclField DocNameI = NoExtCon
+type instance XXConDeclField DocNameI = DataConCantHappen
-type instance XXPat DocNameI = NoExtCon
+type instance XXPat DocNameI = DataConCantHappen
type instance XCInjectivityAnn DocNameI = NoExtField
diff --git a/html-test/ref/Identifiers.html b/html-test/ref/Identifiers.html
index b177266d4e..76487140a9 100644
--- a/html-test/ref/Identifiers.html
+++ b/html-test/ref/Identifiers.html
@@ -147,7 +147,7 @@
></code
>, <code
><a href="#" title="Data.Foldable"
- >Foldable</a
+ >elem</a
></code
></li
><li
@@ -169,7 +169,7 @@
>++</code
>, <code
><a href="#" title="Data.Foldable"
- >Foldable</a
+ >elem</a
></code
>, <code
>elem</code
@@ -238,14 +238,14 @@
>Unqualified: <code
>1 <code
><a href="#" title="Data.Foldable"
- >`Foldable`</a
+ >`elem`</a
></code
> [-3..3]</code
></li
><li
>Qualified: <code
>1 <code
- ><a href="#" title="GHC.List"
+ ><a href="#" title="Data.Foldable"
>`elem`</a
></code
> [-3..3]</code
@@ -253,7 +253,7 @@
><li
>Namespaced: <code
><a href="#" title="Data.Foldable"
- >`Foldable`</a
+ >`elem`</a
></code
>, <code
>`elem`</code
--
GitLab