TTG: AST Updates for !8308

8 files changed, 38 insertions, 21 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 221580cc..d508cc6d 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -18,8 +18,7 @@ module Haddock.Backends.Hoogle (
     ppHoogle
   ) where
 
-import GHC.Types.Basic ( OverlapFlag(..), OverlapMode(..),
-                         PromotionFlag(..), TopLevelFlag(..) )
+import GHC.Types.Basic ( OverlapFlag(..), OverlapMode(..), TopLevelFlag(..) )
 import GHC.Types.SourceText
 import GHC.Core.InstEnv (ClsInst(..))
 import Documentation.Haddock.Markup
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 420bd3f0..38efeba8 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -24,7 +24,6 @@ import Haddock.GhcUtils
 import GHC.Utils.Ppr hiding (Doc, quote)
 import qualified GHC.Utils.Ppr as Pretty
 
-import GHC.Types.Basic        ( PromotionFlag(..), isPromoted )
 import GHC hiding (fromMaybeContext )
 import GHC.Types.Name.Occurrence
 import GHC.Types.Name        ( nameOccName )
@@ -1155,7 +1154,7 @@ ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u
 ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
 
 
-ppr_tylit :: HsTyLit -> Bool -> LaTeX
+ppr_tylit :: HsTyLit DocNameI -> Bool -> LaTeX
 ppr_tylit (HsNumTy _ n) _ = integer n
 ppr_tylit (HsStrTy _ s) _ = text (show s)
 ppr_tylit (HsCharTy _ c) _ = text (show c)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index d385b42a..8cf6e7af 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -35,7 +35,6 @@ import           Data.Maybe
 import           Text.XHtml hiding     ( name, title, p, quote )
 
 import GHC.Core.Type ( Specificity(..) )
-import GHC.Types.Basic (PromotionFlag(..), isPromoted)
 import GHC hiding (LexicalFixity(..), fromMaybeContext)
 import GHC.Exts
 import GHC.Types.Name
@@ -609,7 +608,7 @@ ppClassDecl summary links instances fixities loc d subdocs
       ]
 
     -- Minimal complete definition
-    minimalBit = case [ s | MinimalSig _ _ (L _ s) <- sigs ] of
+    minimalBit = case [ s | MinimalSig _ (L _ s) <- sigs ] of
       -- Miminal complete definition = every shown method
       And xs : _ | sort [getName n | L _ (Var (L _ n)) <- xs] ==
                    sort [getName n | ClassOpSig _ _ ns _ <- sigs, L _ n <- ns]
@@ -1300,7 +1299,7 @@ ppr_mono_ty (HsDocTy _ ty _) unicode qual emptyCtxts
 ppr_mono_ty (HsWildCardTy _) _ _ _ = char '_'
 ppr_mono_ty (HsTyLit _ n) _ _ _ = ppr_tylit n
 
-ppr_tylit :: HsTyLit -> Html
+ppr_tylit :: HsTyLit DocNameI -> Html
 ppr_tylit (HsNumTy _ n) = toHtml (show n)
 ppr_tylit (HsStrTy _ s) = toHtml (show s)
 ppr_tylit (HsCharTy _ c) = toHtml (show c)
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index ceefedf3..f8b41851 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -20,7 +20,7 @@ module Haddock.Convert (
 ) where
 
 import GHC.Data.Bag ( emptyBag )
-import GHC.Types.Basic ( TupleSort(..), PromotionFlag(..), DefMethSpec(..), TopLevelFlag(..) )
+import GHC.Types.Basic ( TupleSort(..), DefMethSpec(..), TopLevelFlag(..) )
 import GHC.Types.SourceText (SourceText(..))
 import GHC.Types.Fixity (LexicalFixity(..))
 import GHC.Core.Class
@@ -131,7 +131,7 @@ tyThingToLHsDecl prr t = case t of
          , tcdFDs = map (\ (l,r) -> noLocA
                         (FunDep noAnn (map (noLocA . getName) l) (map (noLocA . getName) r)) ) $
                          snd $ classTvsFds cl
-         , tcdSigs = noLocA (MinimalSig noAnn NoSourceText . noLocA . fmap noLocA $ classMinimalDef cl) :
+         , tcdSigs = noLocA (MinimalSig (noAnn, NoSourceText) . noLocA . fmap noLocA $ classMinimalDef cl) :
                       [ noLocA tcdSig
                       | clsOp <- classOpItems cl
                       , tcdSig <- synifyTcIdSig vs clsOp ]
@@ -823,7 +823,7 @@ synifyPatSynType ps =
        (\vs -> implicitForAll ts vs [] prov_theta (synifyType WithinType))
        (mkVisFunTys arg_tys res_ty)
 
-synifyTyLit :: TyLit -> HsTyLit
+synifyTyLit :: TyLit -> HsTyLit GhcRn
 synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n
 synifyTyLit (StrTyLit s) = HsStrTy NoSourceText s
 synifyTyLit (CharTyLit c) = HsCharTy NoSourceText c
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 7c1dc73b..893bf010 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -37,7 +37,6 @@ import GHC.Types.Name
 import GHC.Unit.Module
 import GHC
 import GHC.Driver.Session
-import GHC.Types.Basic
 import GHC.Types.SrcLoc  ( advanceSrcLoc )
 import GHC.Types.Var     ( Specificity, VarBndr(..), TyVarBinder
                          , tyVarKind, updateTyVarKind, isInvisibleArgFlag )
@@ -76,7 +75,7 @@ filterSigNames p (FixSig _ (FixitySig _ ns ty)) =
   case filter (p . unLoc) ns of
     []       -> Nothing
     filtered -> Just (FixSig noAnn (FixitySig noExtField filtered ty))
-filterSigNames _ orig@(MinimalSig _ _ _)      = Just orig
+filterSigNames _ orig@(MinimalSig _ _)      = Just orig
 filterSigNames p (TypeSig _ ns ty) =
   case filter (p . unLoc) ns of
     []       -> Nothing
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 09eb2ad5..ee93324e 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -64,7 +64,6 @@ import GHC.Tc.Types hiding (IfM)
 import GHC.Tc.Utils.Monad (finalSafeMode)
 import GHC.Types.Avail hiding (avail)
 import qualified GHC.Types.Avail as Avail
-import GHC.Types.Basic (PromotionFlag (..))
 import GHC.Types.Name (getOccString, getSrcSpan, isDataConName, isValName, nameIsLocalOrFrom, nameOccName, emptyOccEnv)
 import GHC.Types.Name.Env (lookupNameEnv)
 import GHC.Types.Name.Reader (GlobalRdrEnv, greMangledName, lookupGlobalRdrEnv)
@@ -755,7 +754,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
 
                   L loc (TyClD _ ClassDecl {..}) -> do
                     mdef <- minimalDef t
-                    let sig = maybeToList $ fmap (noLocA . MinimalSig noAnn NoSourceText . noLocA . fmap noLocA) mdef
+                    let sig = maybeToList $ fmap (noLocA . MinimalSig (noAnn, NoSourceText) . noLocA . fmap noLocA) mdef
                     availExportDecl avail
                       (L loc $ TyClD noExtField ClassDecl { tcdSigs = sig ++ tcdSigs, .. }) docs_
 
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index d2f11733..b3d31940 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -308,7 +308,7 @@ renameType t = case t of
     doc' <- renameLDocHsSyn doc
     return (HsDocTy noAnn ty' doc')
 
-  HsTyLit _ x -> return (HsTyLit noAnn x)
+  HsTyLit _ x -> return (HsTyLit noAnn (renameTyLit x))
 
   HsRecTy _ a               -> HsRecTy noAnn <$> mapM renameConDeclFieldField a
   XHsType a                 -> pure (XHsType a)
@@ -318,6 +318,12 @@ renameType t = case t of
   HsSpliceTy (HsUntypedSpliceNested _) _ -> error "renameType: not an top level type splice"
   HsWildCardTy _          -> pure (HsWildCardTy noAnn)
 
+renameTyLit :: HsTyLit GhcRn -> HsTyLit DocNameI
+renameTyLit t = case t of
+  HsNumTy  _ v -> HsNumTy noExtField v
+  HsStrTy  _ v -> HsStrTy noExtField v
+  HsCharTy _ v -> HsCharTy noExtField v
+
 
 renameSigType :: HsSigType GhcRn -> RnM (HsSigType DocNameI)
 renameSigType (HsSig { sig_bndrs = bndrs, sig_body = body }) = do
@@ -576,9 +582,9 @@ renameSig sig = case sig of
   FixSig _ (FixitySig _ lnames fixity) -> do
     lnames' <- mapM renameL lnames
     return $ FixSig noExtField (FixitySig noExtField lnames' fixity)
-  MinimalSig _ src (L l s) -> do
+  MinimalSig _ (L l s) -> do
     s' <- traverse (traverse lookupRnNoWarn) s
-    return $ MinimalSig noExtField src (L l s')
+    return $ MinimalSig noExtField (L l s')
   -- we have filtered out all other kinds of signatures in Interface.Create
   _ -> error "expected TypeSig"
 
@@ -587,11 +593,17 @@ renameForD :: ForeignDecl GhcRn -> RnM (ForeignDecl DocNameI)
 renameForD (ForeignImport _ lname ltype x) = do
   lname' <- renameL lname
   ltype' <- renameLSigType ltype
-  return (ForeignImport noExtField lname' ltype' x)
+  return (ForeignImport noExtField lname' ltype' (renameForI x))
 renameForD (ForeignExport _ lname ltype x) = do
   lname' <- renameL lname
   ltype' <- renameLSigType ltype
-  return (ForeignExport noExtField lname' ltype' x)
+  return (ForeignExport noExtField lname' ltype' (renameForE x))
+
+renameForI :: ForeignImport GhcRn -> ForeignImport DocNameI
+renameForI (CImport _ cconv safety mHeader spec) = CImport noExtField cconv safety mHeader spec
+
+renameForE :: ForeignExport GhcRn -> ForeignExport DocNameI
+renameForE (CExport _ spec) = CExport noExtField spec
 
 
 renameInstD :: InstDecl GhcRn -> RnM (InstDecl DocNameI)
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index dc15dfe0..35f2e200 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -44,9 +44,7 @@ import Control.Monad.Writer.Strict (Writer, WriterT, MonadWriter(..), lift, runW
 import Data.Typeable (Typeable)
 import Data.Map (Map)
 import Data.Data (Data)
-import Data.Void (Void)
 import Documentation.Haddock.Types
-import GHC.Types.Basic (PromotionFlag(..))
 import GHC.Types.Fixity (Fixity(..))
 import GHC.Types.Var (Specificity)
 
@@ -761,6 +759,11 @@ type instance XTyLit           DocNameI = EpAnn [AddEpAnn]
 type instance XWildCardTy      DocNameI = EpAnn [AddEpAnn]
 type instance XXType           DocNameI = HsCoreTy
 
+type instance XNumTy           DocNameI = NoExtField
+type instance XStrTy           DocNameI = NoExtField
+type instance XCharTy          DocNameI = NoExtField
+type instance XXTyLit          DocNameI = DataConCantHappen
+
 type instance XHsForAllVis        DocNameI = NoExtField
 type instance XHsForAllInvis      DocNameI = NoExtField
 type instance XXHsForAllTelescope DocNameI = DataConCantHappen
@@ -781,6 +784,13 @@ type instance XMinimalSig  DocNameI = NoExtField
 
 type instance XForeignExport  DocNameI = NoExtField
 type instance XForeignImport  DocNameI = NoExtField
+
+type instance XCImport  DocNameI = NoExtField
+type instance XCExport  DocNameI = NoExtField
+
+type instance XXForeignImport DocNameI = DataConCantHappen
+type instance XXForeignExport DocNameI = DataConCantHappen
+
 type instance XConDeclGADT    DocNameI = NoExtField
 type instance XConDeclH98     DocNameI = NoExtField
 type instance XXConDecl       DocNameI = DataConCantHappen