Track changes to follow Trac #14529

This tracks the refactoring of HsDecl.ConDecl.

8 files changed, 105 insertions, 153 deletions

diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index f1d8ddb2..ee81a83c 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -231,7 +231,7 @@ lookupCon dflags subdocs (L _ name) = case lookup name subdocs of
 ppCtor :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String]
 ppCtor dflags dat subdocs con@ConDeclH98 {}
   -- AZ:TODO get rid of the concatMap
-   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConDetails con)
+   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConArgs con)
     where
         f (PrefixCon args) = [typeSig name $ args ++ [resType]]
         f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
@@ -252,15 +252,14 @@ ppCtor dflags dat subdocs con@ConDeclH98 {}
         resType = apps $ map (reL . HsTyVar NotPromoted . reL) $
                         (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvExplicit $ tyClDeclTyVars dat]
 
-ppCtor dflags _dat subdocs con@ConDeclGADT {}
+ppCtor dflags _dat subdocs con@(ConDeclGADT { })
    = concatMap (lookupCon dflags subdocs) (getConNames con) ++ f
     where
-        f = [typeSig name (hsib_body $ con_type con)]
+        f = [typeSig name (getGADTConType con)]
 
         typeSig nm ty = operator nm ++ " :: " ++ outHsType dflags (unL ty)
         name = out dflags $ map unL $ getConNames con
 
-
 ppFixity :: DynFlags -> (Name, Fixity) -> [String]
 ppFixity dflags (name, fixity) = [out dflags ((FixitySig [noLoc name] fixity) :: FixitySig GhcRn)]
 
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index d79e0e6c..793e40d8 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -631,7 +631,7 @@ ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
                    -> LConDecl DocNameI -> LaTeX
 ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
   leader <->
-  case con_details con of
+  case con_args con of
 
     PrefixCon args ->
       decltt (hsep ((header_ unicode <+> ppOcc) :
@@ -660,8 +660,8 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
     ppOcc   = case occ of
       [one] -> ppBinder one
       _     -> cat (punctuate comma (map ppBinder occ))
-    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))
-    context = unLoc (fromMaybe (noLoc []) (con_cxt con))
+    tyVars  = map (getName . hsLTyVarName) (con_ex_tvs con)
+    context = unLoc (fromMaybe (noLoc []) (con_mb_cxt con))
 
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
     -- or also because we want Haddock to do the doc-parsing, not GHC.
@@ -672,7 +672,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =
 
 ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclGADT {})) =
   leader <->
-  doGADTCon (hsib_body $ con_type con)
+  doGADTCon (getGADTConType con)
 
  where
     doGADTCon resTy = decltt (ppOcc <+> dcolon unicode <+>
@@ -690,72 +690,6 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclGADT {})) =
               [] -> panic "empty con_names"
               (cn:_) -> lookup (unLoc cn) subdocs >>=
                         fmap _doc . combineDocumentation . fst
-{- old
-
-ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> LaTeX
-                   -> LConDecl DocName -> LaTeX
-ppSideBySideConstr subdocs unicode leader (L loc con) =
-  leader <->
-  case con_res con of
-  ResTyH98 -> case con_details con of
-
-    PrefixCon args ->
-      decltt (hsep ((header_ unicode <+> ppOcc) :
-                 map (ppLParendType unicode) args))
-      <-> rDoc mbDoc <+> nl
-
-    RecCon (L _ fields) ->
-      (decltt (header_ unicode <+> ppOcc)
-        <-> rDoc mbDoc <+> nl)
-      $$
-      doRecordFields fields
-
-    InfixCon arg1 arg2 ->
-      decltt (hsep [ header_ unicode <+> ppLParendType unicode arg1,
-                 ppOcc,
-                 ppLParendType unicode arg2 ])
-      <-> rDoc mbDoc <+> nl
-
-  ResTyGADT _ resTy -> case con_details con of
-    -- prefix & infix could also use hsConDeclArgTys if it seemed to
-    -- simplify the code.
-    PrefixCon args -> doGADTCon args resTy
-    cd@(RecCon (L _ fields)) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
-                                     doRecordFields fields
-    InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
-
- where
-    doRecordFields fields =
-        vcat (map (ppSideBySideField subdocs unicode) (map unLoc fields))
-
-    doGADTCon args resTy = decltt (ppOcc <+> dcolon unicode <+>
-                               ppLType unicode (mk_forall $ mk_phi $
-                                                foldr mkFunTy resTy args)
-                            ) <-> rDoc mbDoc
-
-
-    header_ = ppConstrHdr (con_explicit con) tyVars context
-    occ     = map (nameOccName . getName . unLoc) $ con_names con
-    ppOcc   = case occ of
-      [one] -> ppBinder one
-      _     -> cat (punctuate comma (map ppBinder occ))
-    ltvs    = con_qvars con
-    tyVars  = tyvarNames (con_qvars con)
-    context = unLoc (con_cxt con)
-
-    mk_forall ty | con_explicit con = L loc (HsForAllTy (hsQTvExplicit ltvs) ty)
-                 | otherwise        = ty
-    mk_phi ty | null context = ty
-              | otherwise    = L loc (HsQualTy (con_cxt con) ty)
-
-    -- don't use "con_doc con", in case it's reconstructed from a .hi file,
-    -- or also because we want Haddock to do the doc-parsing, not GHC.
-    mbDoc = case con_names con of
-              [] -> panic "empty con_names"
-              (cn:_) -> lookup (unLoc cn) subdocs >>=
-                        fmap _doc . combineDocumentation . fst
-    mkFunTy a b = noLoc (HsFunTy a b)
--}
 
 ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Bool -> ConDeclField DocNameI ->  LaTeX
 ppSideBySideField subdocs unicode (ConDeclField names ltype _) =
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 3b85f96c..bf71fec4 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -769,7 +769,7 @@ ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
 -- incorporated into the declaration
 ppShortConstrParts :: Bool -> Bool -> ConDecl DocNameI -> Unicode -> Qualification -> (Html, Html, Html)
 ppShortConstrParts summary dataInst con unicode qual = case con of
-  ConDeclH98{} -> case con_details con of
+  ConDeclH98{} -> case con_args con of
     PrefixCon args ->
       (header_ unicode qual +++ hsep (ppOcc
             : map (ppLParendType unicode qual HideEmptyContexts) args), noHtml, noHtml)
@@ -782,17 +782,18 @@ ppShortConstrParts summary dataInst con unicode qual = case con of
             ppOccInfix, ppLParendType unicode qual HideEmptyContexts arg2],
        noHtml, noHtml)
 
-  ConDeclGADT {} -> (ppOcc <+> dcolon unicode <+> ppLType unicode qual HideEmptyContexts resTy,noHtml,noHtml)
+  ConDeclGADT {} -> (ppOcc <+> dcolon unicode
+                           <+> ppLType unicode qual HideEmptyContexts (getGADTConType con)
+                    , noHtml, noHtml)
 
   where
-    resTy = hsib_body (con_type con)
-
-    doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) (map unLoc fields))
+    doRecordFields fields = shortSubDecls dataInst $
+                            map (ppShortField summary unicode qual) (map unLoc fields)
 
     header_  = ppConstrHdr forall_ tyVars context
-    occ        = map (nameOccName . getName . unLoc) $ getConNames con
+    occ      = map (nameOccName . getName . unLoc) $ getConNames con
 
-    ppOcc      = case occ of
+    ppOcc    = case occ of
       [one] -> ppBinder summary one
       _     -> hsep (punctuate comma (map (ppBinder summary) occ))
 
@@ -800,9 +801,9 @@ ppShortConstrParts summary dataInst con unicode qual = case con of
       [one] -> ppBinderInfix summary one
       _     -> hsep (punctuate comma (map (ppBinderInfix summary) occ))
 
-    ltvs     = fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)
-    tyVars   = tyvarNames ltvs
-    lcontext = fromMaybe (noLoc []) (con_cxt con)
+    -- Used for H98 syntax only
+    tyVars   = map (getName . hsLTyVarName) (con_ex_tvs con)
+    lcontext = fromMaybe (noLoc []) (con_mb_cxt con)
     context  = unLoc lcontext
     forall_  = False
 
@@ -827,7 +828,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
  = (decl, mbDoc, fieldPart)
  where
     decl = case con of
-      ConDeclH98{} -> case con_details con of
+      ConDeclH98{} -> case con_args con of
         PrefixCon args ->
           hsep ((header_ +++ ppOcc)
             : map (ppLParendType unicode qual HideEmptyContexts) args)
@@ -841,11 +842,9 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
             ppLParendType unicode qual HideEmptyContexts arg2]
           <+> fixity
 
-      ConDeclGADT{} -> doGADTCon resTy
-
-    resTy = hsib_body (con_type con)
+      ConDeclGADT{} -> doGADTCon (getGADTConType con)
 
-    fieldPart = case getConDetails con of
+    fieldPart = case getConArgs con of
         RecCon (L _ fields) -> [doRecordFields fields]
         _ -> []
 
@@ -860,9 +859,9 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
 
     fixity  = ppFixities fixities qual
     header_ = ppConstrHdr forall_ tyVars context unicode qual
-    occ       = map (nameOccName . getName . unLoc) $ getConNames con
+    occ     = map (nameOccName . getName . unLoc) $ getConNames con
 
-    ppOcc     = case occ of
+    ppOcc   = case occ of
       [one] -> ppBinder False one
       _     -> hsep (punctuate comma (map (ppBinder False) occ))
 
@@ -870,8 +869,9 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)
       [one] -> ppBinderInfix False one
       _     -> hsep (punctuate comma (map (ppBinderInfix False) occ))
 
-    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))
-    context = unLoc (fromMaybe (noLoc []) (con_cxt con))
+    -- Used for H98 syntax only
+    tyVars  = map (getName . hsLTyVarName) (con_ex_tvs con)
+    context = unLoc (fromMaybe (noLoc []) (con_mb_cxt con))
     forall_ = False
     -- don't use "con_doc con", in case it's reconstructed from a .hi file,
     -- or also because we want Haddock to do the doc-parsing, not GHC.
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index fc808568..37fad036 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -284,10 +284,6 @@ synifyDataCon use_gadt_syntax dc =
   -- con_qvars means a different thing depending on gadt-syntax
   (univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc
 
-  qvars = if use_gadt_syntax
-          then synifyTyVars (univ_tvs ++ ex_tvs)
-          else synifyTyVars ex_tvs
-
   -- skip any EqTheta, use 'orig'inal syntax
   ctx = synifyCtx theta
 
@@ -310,21 +306,25 @@ synifyDataCon use_gadt_syntax dc =
           (False,True) -> case linear_tys of
                            [a,b] -> return $ InfixCon a b
                            _ -> Left "synifyDataCon: infix with non-2 args?"
-  gadt_ty = HsIB [] (synifyType WithinType res_ty) False
  -- finally we get synifyDataCon's result!
  in hs_arg_tys >>=
       \hat ->
         if use_gadt_syntax
            then return $ noLoc $
-              ConDeclGADT { con_names = [name]
-                          , con_type = gadt_ty
-                          , con_doc =  Nothing }
+              ConDeclGADT { con_names  = [name]
+                          , con_forall = True
+                          , con_qvars  = synifyTyVars (univ_tvs ++ ex_tvs)
+                          , con_mb_cxt = Just ctx
+                          , con_args   =  hat
+                          , con_res_ty = synifyType WithinType res_ty
+                          , con_doc    =  Nothing }
            else return $ noLoc $
-              ConDeclH98 { con_name = name
-                         , con_qvars = Just qvars
-                         , con_cxt   = Just ctx
-                         , con_details =  hat
-                         , con_doc =  Nothing }
+              ConDeclH98 { con_name   = name
+                         , con_forall = True
+                         , con_ex_tvs = map synifyTyVar ex_tvs
+                         , con_mb_cxt = Just ctx
+                         , con_args   = hat
+                         , con_doc    = Nothing }
 
 synifyName :: NamedThing n => n -> Located Name
 synifyName n = L (srcLocSpan (getSrcLoc n)) (getName n)
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index a1009c1f..4963d2f8 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -17,6 +17,7 @@ module Haddock.GhcUtils where
 
 
 import Control.Arrow
+import Haddock.Types( DocNameI )
 
 import Exception
 import Outputable
@@ -148,6 +149,32 @@ nubByName f ns = go emptyNameSet ns
       where
         y = f x
 
+getGADTConType :: ConDecl p -> LHsType p
+-- The full type of a GADT data constructor We really only get this in
+-- order to pretty-print it, and currently only in Haddock's code.  So
+-- we are cavalier about locations and extensions, hence the
+-- 'undefined's
+getGADTConType (ConDeclGADT { con_forall = has_forall
+                            , con_qvars = qtvs
+                            , con_mb_cxt = mcxt, con_args = args
+                            , con_res_ty = res_ty })
+ | has_forall = noLoc (HsForAllTy { hst_bndrs = hsQTvExplicit qtvs
+                                  , hst_body  = theta_ty })
+ | otherwise  = theta_ty
+ where
+   theta_ty | Just theta <- mcxt
+            = noLoc (HsQualTy { hst_ctxt = theta, hst_body = tau_ty })
+            | otherwise
+            = tau_ty
+
+   tau_ty = case args of
+              RecCon flds -> noLoc (HsFunTy (noLoc (HsRecTy (unLoc flds))) res_ty)
+              PrefixCon pos_args -> foldr (\ a b -> noLoc (HsFunTy a b)) res_ty pos_args
+              InfixCon {} -> panic "InfixCon for GADT"
+
+getGADTConType (ConDeclH98 {}) = panic "getGADTConType"
+  -- Should only be called on ConDeclGADT
+
 -------------------------------------------------------------------------------
 -- * Located
 -------------------------------------------------------------------------------
@@ -179,7 +206,7 @@ class Parent a where
 
 instance Parent (ConDecl GhcRn) where
   children con =
-    case getConDetails con of
+    case con_args con of
       RecCon fields -> map (selectorFieldOcc . unL) $
                          concatMap (cd_fld_names . unL) (unL fields)
       _             -> []
@@ -259,3 +286,5 @@ setStubDir    f d = d{ stubDir    = Just f, includePaths = f : includePaths d }
   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
   -- \#included from the .hc file when compiling with -fvia-C.
 setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f
+
+
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 27456998..52a983a8 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -61,7 +61,7 @@ import TcRnTypes
 import FastString (concatFS)
 import BasicTypes ( StringLiteral(..), SourceText(..) )
 import qualified Outputable as O
-import HsDecls ( getConDetails )
+import HsDecls ( getConArgs )
 
 
 -- | Use a 'TypecheckedModule' to produce an 'Interface'.
@@ -455,7 +455,7 @@ subordinates instMap decl = case decl of
         constrs = [ (unL cname, maybeToList $ fmap unL $ con_doc c, M.empty)
                   | c <- cons, cname <- getConNames c ]
         fields  = [ (selectorFieldOcc n, maybeToList $ fmap unL doc, M.empty)
-                  | RecCon flds <- map getConDetails cons
+                  | RecCon flds <- map getConArgs cons
                   , L _ (ConDeclField ns _ doc) <- (unLoc flds)
                   , L _ n <- ns ]
         derivs  = [ (instName, [unL doc], M.empty)
@@ -1028,7 +1028,7 @@ extractDecl name decl
         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))
+                           , RecCon rec <- map (getConArgs . unLoc) (dd_cons (feqn_rhs d))
                            , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
                            , L _ n <- ns
                            , selectorFieldOcc n == name
@@ -1050,14 +1050,14 @@ extractPatternSyn nm t tvs cons =
   extract :: ConDecl GhcRn -> Sig GhcRn
   extract con =
     let args =
-          case getConDetails con of
+          case getConArgs con of
             PrefixCon args' -> args'
             RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields
             InfixCon arg1 arg2 -> [arg1, arg2]
         typ = longArrow args (data_ty con)
         typ' =
           case con of
-            ConDeclH98 { con_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)
+            ConDeclH98 { con_mb_cxt = Just cxt } -> noLoc (HsQualTy cxt typ)
             _ -> typ
         typ'' = noLoc (HsQualTy (noLoc []) typ')
     in PatSynSig [noLoc nm] (mkEmptyImplicitBndrs typ'')
@@ -1066,7 +1066,7 @@ extractPatternSyn nm t tvs cons =
   longArrow inputs output = foldr (\x y -> noLoc (HsFunTy x y)) output inputs
 
   data_ty con
-    | ConDeclGADT{} <- con = hsib_body $ con_type con
+    | ConDeclGADT{} <- con = con_res_ty con
     | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
 
 extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
@@ -1074,7 +1074,7 @@ extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn]
 extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
 
 extractRecSel nm t tvs (L _ con : rest) =
-  case getConDetails con of
+  case getConArgs con of
     RecCon (L _ fields) | ((l,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
       L l (TypeSig [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy data_ty (getBangType ty)))))
     _ -> extractRecSel nm t tvs rest
@@ -1084,7 +1084,7 @@ extractRecSel nm t tvs (L _ con : rest) =
                                  , L l n <- ns, selectorFieldOcc n == nm ]
   data_ty
     -- ResTyGADT _ ty <- con_res con = ty
-    | ConDeclGADT{} <- con = hsib_body $ con_type con
+    | ConDeclGADT{} <- con = con_res_ty con
     | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar NotPromoted (noLoc t))) tvs
 
 -- | Keep export items with docs.
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 7023a908..fadd0553 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -428,35 +428,41 @@ renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
                        , dd_derivs = noLoc [] })
 
 renameCon :: ConDecl GhcRn -> RnM (ConDecl DocNameI)
-renameCon decl@(ConDeclH98 { con_name = lname, con_qvars = ltyvars
-                           , con_cxt = lcontext, con_details = details
+renameCon decl@(ConDeclH98 { con_name = lname, con_ex_tvs = ltyvars
+                           , con_mb_cxt = lcontext, con_args = details
                            , con_doc = mbldoc }) = do
       lname'    <- renameL lname
-      ltyvars'  <- traverse renameLHsQTyVars ltyvars
+      ltyvars'  <- mapM renameLTyVarBndr ltyvars
       lcontext' <- traverse renameLContext lcontext
       details'  <- renameDetails details
       mbldoc'   <- mapM renameLDocHsSyn mbldoc
-      return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'
-                   , con_details = details', con_doc = mbldoc' })
+      return (decl { con_name = lname', con_ex_tvs = ltyvars'
+                   , con_mb_cxt = lcontext'
+                   , con_args = details', con_doc = mbldoc' })
 
-  where
-    renameDetails (RecCon (L l fields)) = do
-      fields' <- mapM renameConDeclFieldField fields
-      return (RecCon (L l fields'))
-    renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
-    renameDetails (InfixCon a b) = do
-      a' <- renameLType a
-      b' <- renameLType b
-      return (InfixCon a' b')
-
-renameCon decl@(ConDeclGADT { con_names = lnames
-                            , con_type = lty
+renameCon decl@(ConDeclGADT { con_names = lnames, con_qvars = ltyvars
+                            , con_mb_cxt = lcontext, con_args = details
+                            , con_res_ty = res_ty
                             , con_doc = mbldoc }) = do
       lnames'   <- mapM renameL lnames
-      lty'      <- renameLSigType lty
+      ltyvars'  <- renameLHsQTyVars ltyvars
+      lcontext' <- traverse renameLContext lcontext
+      details'  <- renameDetails details
+      res_ty'   <- renameLType res_ty
       mbldoc'   <- mapM renameLDocHsSyn mbldoc
-      return (decl { con_names = lnames'
-                   , con_type = lty', con_doc = mbldoc' })
+      return (decl { con_names = lnames', con_qvars = ltyvars'
+                   , con_mb_cxt = lcontext', con_args = details'
+                   , con_res_ty = res_ty', con_doc = mbldoc' })
+
+renameDetails :: HsConDeclDetails GhcRn -> RnM (HsConDeclDetails DocNameI)
+renameDetails (RecCon (L l fields)) = do
+  fields' <- mapM renameConDeclFieldField fields
+  return (RecCon (L l fields'))
+renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
+renameDetails (InfixCon a b) = do
+  a' <- renameLType a
+  b' <- renameLType b
+  return (InfixCon a' b')
 
 renameConDeclFieldField :: LConDeclField GhcRn -> RnM (LConDeclField DocNameI)
 renameConDeclFieldField (L l (ConDeclField names t doc)) = do
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 84f58ab8..1993fb5d 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -180,33 +180,17 @@ restrictCons :: [Name] -> [LConDecl GhcRn] -> [LConDecl GhcRn]
 restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
   where
     keep d | any (\n -> n `elem` names) (map unLoc $ getConNames d) =
-      case getConDetails h98d of
+      case con_args d of
         PrefixCon _ -> Just d
         RecCon fields
           | all field_avail (unL fields) -> Just d
-          | otherwise -> Just (h98d { con_details = PrefixCon (field_types (map unL (unL fields))) })
+          | otherwise -> Just (d { con_args = PrefixCon (field_types (map unL (unL fields))) })
           -- if we have *all* the field names available, then
           -- keep the record declaration.  Otherwise degrade to
           -- a constructor declaration.  This isn't quite right, but
           -- it's the best we can do.
         InfixCon _ _ -> Just d
       where
-        h98d = h98ConDecl d
-        h98ConDecl c@ConDeclH98{} = c
-        h98ConDecl c@ConDeclGADT{} = c'
-          where
-            (details,_res_ty,cxt,tvs) = gadtDeclDetails (con_type c)
-            c' :: ConDecl GhcRn
-            c' = ConDeclH98
-                   { con_name = head (con_names c)
-                   , con_qvars = Just $ HsQTvs { hsq_implicit = mempty
-                                               , hsq_explicit = tvs
-                                               , hsq_dependent = emptyNameSet }
-                   , con_cxt = Just cxt
-                   , con_details = details
-                   , con_doc = con_doc c
-                   }
-
         field_avail :: LConDeclField GhcRn -> Bool
         field_avail (L _ (ConDeclField fs _ _))
             = all (\f -> selectorFieldOcc (unLoc f) `elem` names) fs