Update for #14131

7 files changed, 83 insertions, 61 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 56f8176c..8e4e801e 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -184,11 +184,11 @@ ppClass dflags decl subdocs =
 
         tyFamEqnToSyn :: TyFamDefltEqn GhcRn -> TyClDecl GhcRn
         tyFamEqnToSyn tfe = SynDecl
-            { tcdLName = tfe_tycon tfe
-            , tcdTyVars = tfe_pats tfe
-            , tcdFixity = tfe_fixity tfe
-            , tcdRhs = tfe_rhs tfe
-            , tcdFVs = emptyNameSet
+            { tcdLName  = feqn_tycon tfe
+            , tcdTyVars = feqn_pats tfe
+            , tcdFixity = feqn_fixity tfe
+            , tcdRhs    = feqn_rhs tfe
+            , tcdFVs    = emptyNameSet
             }
 
 
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
index 759a31d4..57ff72ff 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs
@@ -159,10 +159,11 @@ decls (group, _, _, _) = concatMap ($ group)
               ++ everythingInRenamedSource fld cdcl
         Nothing -> empty
     ins term = case cast term of
-        (Just ((GHC.DataFamInstD inst) :: GHC.InstDecl GHC.GhcRn))
-          -> pure . tyref $ GHC.dfid_tycon inst
-        (Just (GHC.TyFamInstD (GHC.TyFamInstDecl (GHC.L _ eqn) _))) ->
-            pure . tyref $ GHC.tfe_tycon eqn
+        (Just ((GHC.DataFamInstD (GHC.DataFamInstDecl eqn))
+                :: GHC.InstDecl GHC.GhcRn))
+          -> pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
+        (Just (GHC.TyFamInstD (GHC.TyFamInstDecl eqn))) ->
+            pure . tyref $ GHC.feqn_tycon $ GHC.hsib_body eqn
         _ -> empty
     fld term = case cast term of
         Just (field :: GHC.ConDeclField GHC.GhcRn)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 59ad41e4..3b53b1eb 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -318,8 +318,9 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
       = ppInstances links (OriginFamily docname) instances splice unicode qual
 
     -- Individual equation of a closed type family
-    ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs
-                        , tfe_pats = HsIB { hsib_body = ts }}
+    ppTyFamEqn :: TyFamInstEqn DocNameI -> SubDecl
+    ppTyFamEqn (HsIB { hsib_body = FamEqn { feqn_tycon = n, feqn_rhs = rhs
+                                          , feqn_pats = ts } })
       = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual
           <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)
         , Nothing, [] )
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 36efb3e4..67aa88e1 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -113,20 +113,20 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs })
   = let name       = synifyName tc
         typats     = map (synifyType WithinType) args
         hs_rhs     = synifyType WithinType rhs
-    in TyFamEqn { tfe_tycon = name
-                , tfe_pats  = HsIB { hsib_body = typats
-                                   , hsib_vars = map tyVarName tkvs
-                                   , hsib_closed = True }
-                , tfe_fixity = Prefix
-                , tfe_rhs   = hs_rhs }
+    in HsIB { hsib_vars   = map tyVarName tkvs
+            , hsib_closed = True
+            , hsib_body   = FamEqn { feqn_tycon  = name
+                                   , feqn_pats   = typats
+                                   , feqn_fixity = Prefix
+                                   , feqn_rhs    = hs_rhs } }
 
 synifyAxiom :: CoAxiom br -> Either ErrMsg (HsDecl GhcRn)
 synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
   | isOpenTypeFamilyTyCon tc
   , Just branch <- coAxiomSingleBranch_maybe ax
-  = return $ InstD (TyFamInstD
-                    (TyFamInstDecl { tfid_eqn = noLoc $ synifyAxBranch tc branch
-                                   , tfid_fvs = placeHolderNamesTc }))
+  = return $ InstD
+           $ TyFamInstD
+           $ TyFamInstDecl { tfid_eqn = synifyAxBranch tc branch }
 
   | Just ax' <- isClosedSynFamilyTyConWithAxiom_maybe tc
   , getUnique ax' == getUnique ax   -- without the getUniques, type error
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 561c126f..a1009c1f 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -59,12 +59,13 @@ getMainDeclBinder _ = []
 -- instanceMap.
 getInstLoc :: InstDecl name -> SrcSpan
 getInstLoc (ClsInstD (ClsInstDecl { cid_poly_ty = ty })) = getLoc (hsSigType ty)
-getInstLoc (DataFamInstD (DataFamInstDecl { dfid_tycon = L l _ })) = l
+getInstLoc (DataFamInstD (DataFamInstDecl
+  { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = L l _ }}})) = l
 getInstLoc (TyFamInstD (TyFamInstDecl
   -- Since CoAxioms' Names refer to the whole line for type family instances
   -- in particular, we need to dig a bit deeper to pull out the entire
   -- equation. This does not happen for data family instances, for some reason.
-  { tfid_eqn = L _ (TyFamEqn { tfe_rhs = L l _ })})) = l
+  { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_rhs = L l _ }}})) = l
 
 -- Useful when there is a signature with multiple names, e.g.
 --   foo, bar :: Types..
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 292680a7..62bdbcbe 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -406,11 +406,13 @@ subordinates :: InstMap
              -> [(Name, [HsDocString], Map Int HsDocString)]
 subordinates instMap decl = case decl of
   InstD (ClsInstD d) -> do
-    DataFamInstDecl { dfid_tycon = L l _
-                    , dfid_defn = defn   } <- unLoc <$> cid_datafam_insts d
+    DataFamInstDecl { dfid_eqn = HsIB { hsib_body =
+      FamEqn { feqn_tycon = L l _
+             , feqn_rhs   = defn }}} <- unLoc <$> cid_datafam_insts d
     [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs defn
 
-  InstD (DataFamInstD d)  -> dataSubs (dfid_defn d)
+  InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body = d })))
+    -> dataSubs (feqn_rhs d)
   TyClD d | isClassDecl d -> classSubs d
           | isDataDecl  d -> dataSubs (tcdDataDefn d)
   _ -> []
@@ -1004,17 +1006,19 @@ extractDecl name decl
         in if isDataConName name
            then SigD <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d))
            else SigD <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d))
-      InstD (DataFamInstD DataFamInstDecl { dfid_tycon = L _ n
-                                          , dfid_pats = HsIB { hsib_body = tys }
-                                          , dfid_defn = defn }) ->
+      InstD (DataFamInstD (DataFamInstDecl (HsIB { hsib_body =
+                             FamEqn { feqn_tycon = L _ n
+                                    , feqn_pats  = tys
+                                    , feqn_rhs   = defn }}))) ->
         SigD <$> extractRecSel name n tys (dd_cons defn)
       InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
-        let matches = [ d | L _ d <- insts
-                          -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d)
-                          , RecCon rec <- map (getConDetails . unLoc) (dd_cons (dfid_defn d))
-                          , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
-                          , L _ n <- ns
-                          , selectorFieldOcc n == name
+        let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
+                               <- insts
+                             -- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
+                           , RecCon rec <- map (getConDetails . unLoc) (dd_cons (feqn_rhs d))
+                           , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
+                           , L _ n <- ns
+                           , selectorFieldOcc n == name
                       ]
         in case matches of
           [d0] -> extractDecl name (noLoc . InstD $ DataFamInstD d0)
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 2e9a311a..70962d9c 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -415,7 +415,7 @@ renameFamilyInfo :: FamilyInfo GhcRn -> RnM (FamilyInfo DocNameI)
 renameFamilyInfo DataFamily     = return DataFamily
 renameFamilyInfo OpenTypeFamily = return OpenTypeFamily
 renameFamilyInfo (ClosedTypeFamily eqns)
-  = do { eqns' <- mapM (mapM renameLTyFamInstEqn) eqns
+  = do { eqns' <- mapM (mapM (mapM renameTyFamInstEqn)) eqns
        ; return $ ClosedTypeFamily eqns' }
 
 renameDataDefn :: HsDataDefn GhcRn -> RnM (HsDataDefn DocNameI)
@@ -542,39 +542,54 @@ renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
 
 renameTyFamInstD :: TyFamInstDecl GhcRn -> RnM (TyFamInstDecl DocNameI)
 renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn })
-  = do { eqn' <- renameLTyFamInstEqn eqn
-       ; return (TyFamInstDecl { tfid_eqn = eqn'
-                               , tfid_fvs = placeHolderNames }) }
-
-renameLTyFamInstEqn :: LTyFamInstEqn GhcRn -> RnM (LTyFamInstEqn DocNameI)
-renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats, tfe_fixity = fixity, tfe_rhs = rhs }))
-  = do { tc' <- renameL tc
-       ; pats' <- renameImplicit (mapM renameLType) pats
-       ; rhs' <- renameLType rhs
-       ; return (L loc (TyFamEqn { tfe_tycon = tc'
-                                 , tfe_pats = pats'
-                                 , tfe_fixity = fixity
-                                 , tfe_rhs = rhs' })) }
+  = do { eqn' <- renameTyFamInstEqn eqn
+       ; return (TyFamInstDecl { tfid_eqn = eqn' }) }
+
+renameTyFamInstEqn :: TyFamInstEqn GhcRn -> RnM (TyFamInstEqn DocNameI)
+renameTyFamInstEqn eqn
+  = renameImplicit rename_ty_fam_eqn eqn
+  where
+    rename_ty_fam_eqn
+      :: FamEqn GhcRn (HsTyPats GhcRn) (LHsType GhcRn)
+      -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (LHsType DocNameI))
+    rename_ty_fam_eqn (FamEqn { feqn_tycon = tc, feqn_pats = pats
+                              , feqn_fixity = fixity, feqn_rhs = rhs })
+      = do { tc' <- renameL tc
+           ; pats' <- mapM renameLType pats
+           ; rhs' <- renameLType rhs
+           ; return (FamEqn { feqn_tycon  = tc'
+                            , feqn_pats   = pats'
+                            , feqn_fixity = fixity
+                            , feqn_rhs    = rhs' }) }
 
 renameLTyFamDefltEqn :: LTyFamDefltEqn GhcRn -> RnM (LTyFamDefltEqn DocNameI)
-renameLTyFamDefltEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = tvs, tfe_fixity = fixity, tfe_rhs = rhs }))
+renameLTyFamDefltEqn (L loc (FamEqn { feqn_tycon = tc, feqn_pats = tvs
+                                    , feqn_fixity = fixity, feqn_rhs = rhs }))
   = do { tc'  <- renameL tc
        ; tvs' <- renameLHsQTyVars tvs
        ; rhs' <- renameLType rhs
-       ; return (L loc (TyFamEqn { tfe_tycon = tc'
-                                 , tfe_pats = tvs'
-                                 , tfe_fixity = fixity
-                                 , tfe_rhs = rhs' })) }
+       ; return (L loc (FamEqn { feqn_tycon  = tc'
+                               , feqn_pats   = tvs'
+                               , feqn_fixity = fixity
+                               , feqn_rhs    = rhs' })) }
 
 renameDataFamInstD :: DataFamInstDecl GhcRn -> RnM (DataFamInstDecl DocNameI)
-renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats, dfid_fixity = fixity, dfid_defn = defn })
-  = do { tc' <- renameL tc
-       ; pats' <- renameImplicit (mapM renameLType) pats
-       ; defn' <- renameDataDefn defn
-       ; return (DataFamInstDecl { dfid_tycon = tc'
-                                 , dfid_pats = pats'
-                                 , dfid_fixity = fixity
-                                 , dfid_defn = defn', dfid_fvs = placeHolderNames }) }
+renameDataFamInstD (DataFamInstDecl { dfid_eqn = eqn })
+  = do { eqn' <- renameImplicit rename_data_fam_eqn eqn
+       ; return (DataFamInstDecl { dfid_eqn = eqn' }) }
+  where
+    rename_data_fam_eqn
+      :: FamEqn GhcRn (HsTyPats GhcRn) (HsDataDefn GhcRn)
+      -> RnM (FamEqn DocNameI (HsTyPats DocNameI) (HsDataDefn DocNameI))
+    rename_data_fam_eqn (FamEqn { feqn_tycon = tc, feqn_pats = pats
+                                , feqn_fixity = fixity, feqn_rhs = defn })
+      = do { tc' <- renameL tc
+           ; pats' <- mapM renameLType pats
+           ; defn' <- renameDataDefn defn
+           ; return (FamEqn { feqn_tycon  = tc'
+                            , feqn_pats   = pats'
+                            , feqn_fixity = fixity
+                            , feqn_rhs    = defn' }) }
 
 renameImplicit :: (in_thing -> RnM out_thing)
                -> HsImplicitBndrs GhcRn in_thing