Follow refactoring of TyClDecl/HsTyDefn

9 files changed, 152 insertions, 205 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 593f03bc..c0569006 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -111,9 +111,10 @@ operator x = x
 ppExport :: ExportItem Name -> [String]
 ppExport (ExportDecl decl dc subdocs _) = doc (fst dc) ++ f (unL decl)
     where
-        f (TyClD d@TyData{}) = ppData d subdocs
+        f (TyClD d@TyDecl{})
+            | isDataDecl d      = ppData d subdocs
+            | otherwise         = ppSynonym d
         f (TyClD d@ClassDecl{}) = ppClass d
-        f (TyClD d@TySynonym{}) = ppSynonym d
         f (ForD (ForeignImport name typ _ _)) = ppSig $ TypeSig [name] typ
         f (ForD (ForeignExport name typ _ _)) = ppSig $ TypeSig [name] typ
         f (SigD sig) = ppSig sig
@@ -131,10 +132,6 @@ ppSig (TypeSig names sig) = [operator prettyNames ++ " :: " ++ outHsType typ]
 ppSig _ = []
 
 
-ppSynonym :: TyClDecl Name -> [String]
-ppSynonym x = [out x]
-
-
 -- note: does not yet output documentation for class methods
 ppClass :: TyClDecl Name -> [String]
 ppClass x = out x{tcdSigs=[]} :
@@ -154,10 +151,15 @@ ppInstance :: ClsInst -> [String]
 ppInstance x = [dropComment $ out x]
 
 
+ppSynonym :: TyClDecl Name -> [String]
+ppSynonym x = [out x]
+
 ppData :: TyClDecl Name -> [(Name, DocForDecl Name)] -> [String]
-ppData x subdocs = showData x{tcdCons=[],tcdDerivs=Nothing} :
-                   concatMap (ppCtor x subdocs . unL) (tcdCons x)
+ppData decl@(TyDecl { tcdTyDefn = defn }) subdocs
+    = showData decl{ tcdTyDefn = defn { td_cons=[],td_derivs=Nothing }} :
+      concatMap (ppCtor decl subdocs . unL) (td_cons defn)
     where
+        
         -- GHC gives out "data Bar =", we want to delete the equals
         -- also writes data : a b, when we want data (:) a b
         showData d = unwords $ map f $ if last xs == "=" then init xs else xs
@@ -165,6 +167,7 @@ ppData x subdocs = showData x{tcdCons=[],tcdDerivs=Nothing} :
                 xs = words $ out d
                 nam = out $ tcdLName d
                 f w = if w == nam then operator nam else w
+ppData _ _ = panic "ppData"
 
 -- | for constructors, and named-fields...
 lookupCon :: [(Name, DocForDecl Name)] -> Located Name -> Maybe (Doc Name)
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index deb224a8..c3a8faa0 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -278,12 +278,14 @@ ppDecl :: LHsDecl DocName
 
 ppDecl (L loc decl) (mbDoc, fnArgsDoc) instances subdocs = case decl of
   TyClD d@(TyFamily {})          -> ppTyFam False loc mbDoc d unicode
-  TyClD d@(TyData {})
-    | Nothing <- tcdTyPats d     -> ppDataDecl instances subdocs loc mbDoc d unicode
-    | Just _  <- tcdTyPats d     -> ppDataInst loc mbDoc d
-  TyClD d@(TySynonym {})
-    | Nothing <- tcdTyPats d     -> ppTySyn loc (mbDoc, fnArgsDoc) d unicode
-    | Just _  <- tcdTyPats d     -> ppTyInst False loc mbDoc d unicode
+  TyClD d@(TyDecl{ tcdTyDefn = defn })   
+      | isHsDataDefn defn        -> ppDataDecl instances subdocs loc mbDoc d unicode
+      | otherwise                -> ppTySyn loc (mbDoc, fnArgsDoc) d unicode
+--    | Just _  <- tcdTyPats d     -> ppDataInst loc mbDoc d
+-- Family instances happen via FamInst now
+--  TyClD d@(TySynonym {})         
+--    | Just _  <- tcdTyPats d    -> ppTyInst False loc mbDoc d unicode
+-- Family instances happen via FamInst now
   TyClD d@(ClassDecl {})         -> ppClassDecl instances loc mbDoc subdocs d unicode
   SigD (TypeSig lnames (L _ t))  -> ppFunSig loc (mbDoc, fnArgsDoc) (map unLoc lnames) t unicode
   ForD d                         -> ppFor loc (mbDoc, fnArgsDoc) d unicode
@@ -299,17 +301,6 @@ ppTyFam _ _ _ _ _ =
   error "type family declarations are currently not supported by --latex"
 
 
-ppDataInst :: a
-ppDataInst =
-  error "data instance declarations are currently not supported by --latex"
-
-
-ppTyInst :: Bool -> SrcSpan -> Maybe (Doc DocName) ->
-            TyClDecl DocName -> Bool -> LaTeX
-ppTyInst _ _ _ _ _ =
-  error "type instance declarations are currently not supported by --latex"
-
-
 ppFor :: SrcSpan -> DocForDecl DocName -> ForeignDecl DocName -> Bool -> LaTeX
 ppFor _ _ _ _ =
   error "foreign declarations are currently not supported by --latex"
@@ -323,7 +314,8 @@ ppFor _ _ _ _ =
 -- we skip type patterns for now
 ppTySyn :: SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool -> LaTeX
 
-ppTySyn loc doc (TySynonym (L _ name) ltyvars _ ltype _) unicode
+ppTySyn loc doc (TyDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+                        , tcdTyDefn = TySynonym { td_synRhs = ltype } }) unicode
   = ppTypeOrFunSig loc [name] (unLoc ltype) doc (full, hdr, char '=') unicode
   where
     hdr  = hsep (keyword "type" : ppDocBinder name : ppTyVars ltyvars)
@@ -559,7 +551,7 @@ ppDataDecl instances subdocs _loc mbDoc dataDecl unicode
    $$ instancesBit
 
   where
-    cons      = tcdCons dataDecl
+    cons      = td_cons (tcdTyDefn dataDecl)
     resTy     = (con_res . unLoc . head) cons
 
     body = catMaybes [constrBit, fmap docToLaTeX mbDoc]
@@ -705,27 +697,15 @@ ppSideBySideField subdocs unicode (ConDeclField (L _ name) ltype _) =
 -- | Print the LHS of a data\/newtype declaration.
 -- Currently doesn't handle 'data instance' decls or kind signatures
 ppDataHeader :: TyClDecl DocName -> Bool -> LaTeX
-ppDataHeader decl unicode
-  | not (isDataDecl decl) = error "ppDataHeader: illegal argument"
-  | otherwise =
-    -- newtype or data
-    (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+>
+ppDataHeader (TyDecl { tcdLName = L _ name, tcdTyVars = tyvars
+                     , tcdTyDefn = TyData { td_ND = nd, td_ctxt = ctxt } }) unicode
+  = -- newtype or data
+    (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+>
     -- context
-    ppLContext (tcdCtxt decl) unicode <+>
+    ppLContext ctxt unicode <+>
     -- T a b c ..., or a :+: b
-    ppTyClBinderWithVars False decl
-
-
---------------------------------------------------------------------------------
--- * TyClDecl helpers
---------------------------------------------------------------------------------
-
-
--- | Print a type family / newtype / data / class binder and its variables 
-ppTyClBinderWithVars :: Bool -> TyClDecl DocName -> LaTeX
-ppTyClBinderWithVars summ decl =
-  ppAppDocNameNames summ (unLoc $ tcdLName decl) (tyvarNames $ tcdTyVars decl)
-
+    ppAppDocNameNames False name (tyvarNames tyvars)
+ppDataHeader _ _ = error "ppDataHeader: illegal argument"
 
 --------------------------------------------------------------------------------
 -- * Type applications
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 52bde5b6..50aad789 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -562,12 +562,8 @@ processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts
   ((divTopDecl <<).(declElem <<)) `fmap` case decl0 of
     TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of
         (TyFamily{}) -> [ppTyFamHeader True False d unicode qual]
-        (TyData{tcdTyPats = ps})
-          | Nothing <- ps -> [keyword "data" <+> b]
-          | Just _ <- ps  -> [keyword "data" <+> keyword "instance" <+> b]
-        (TySynonym{tcdTyPats = ps})
-          | Nothing <- ps -> [keyword "type" <+> b]
-          | Just _ <- ps  -> [keyword "type" <+> keyword "instance" <+> b]
+        (TyDecl{ tcdTyDefn = TyData {} }) -> [keyword "data" <+> b]
+        (TyDecl{ tcdTyDefn = TySynonym {} }) -> [keyword "type" <+> b]
         (ClassDecl {})    -> [keyword "class" <+> b]
         _ -> []
     SigD (TypeSig lnames (L _ _)) ->
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 28955c22..ee0223c2 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -29,7 +29,6 @@ import Haddock.Types
 import           Control.Monad         ( join )
 import           Data.List             ( intersperse )
 import qualified Data.Map as Map
-import           Data.Maybe
 import           Text.XHtml hiding     ( name, title, p, quote )
 
 import GHC
@@ -43,12 +42,9 @@ ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
           Bool -> Qualification -> Html
 ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual = case decl of
   TyClD d@(TyFamily {})          -> ppTyFam summ False links loc mbDoc d unicode qual
-  TyClD d@(TyData {})
-    | Nothing <- tcdTyPats d     -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual
-    | Just _  <- tcdTyPats d     -> ppDataInst summ links loc mbDoc d
-  TyClD d@(TySynonym {})
-    | Nothing <- tcdTyPats d     -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual
-    | Just _  <- tcdTyPats d     -> ppTyInst summ False links loc mbDoc d unicode qual
+  TyClD d@(TyDecl{ tcdTyDefn = defn })   
+      | isHsDataDefn defn        -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual
+      | otherwise                -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual
   TyClD d@(ClassDecl {})         -> ppClassDecl summ links instances loc mbDoc subdocs d unicode qual
   SigD (TypeSig lnames (L _ t))  -> ppFunSig summ links loc (mbDoc, fnArgsDoc) (map unLoc lnames) t unicode qual
   ForD d                         -> ppFor summ links loc (mbDoc, fnArgsDoc) d unicode qual
@@ -121,7 +117,9 @@ ppFor _ _ _ _ _ _ _ = error "ppFor"
 -- we skip type patterns for now
 ppTySyn :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool
         -> Qualification -> Html
-ppTySyn summary links loc doc (TySynonym (L _ name) ltyvars _ ltype _) unicode qual
+ppTySyn summary links loc doc (TyDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+                                      , tcdTyDefn = TySynonym { td_synRhs = ltype } }) 
+        unicode qual
   = ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
                    (full, hdr, spaceHtml +++ equals) unicode qual
   where
@@ -187,50 +185,6 @@ ppTyFam summary associated links loc mbDoc decl unicode qual
 
 
 --------------------------------------------------------------------------------
--- * Indexed data types
---------------------------------------------------------------------------------
-
-
-ppDataInst :: a
-ppDataInst = undefined
-
-
---------------------------------------------------------------------------------
--- * Indexed newtypes
---------------------------------------------------------------------------------
-
--- TODO
--- ppNewTyInst = undefined
-
-
---------------------------------------------------------------------------------
--- * Indexed types
---------------------------------------------------------------------------------
-
-
-ppTyInst :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
-            TyClDecl DocName -> Bool -> Qualification -> Html
-ppTyInst summary associated links loc mbDoc decl unicode qual
-
-  | summary   = ppTyInstHeader True associated decl unicode qual
-  | otherwise = header_ +++ maybeDocSection qual mbDoc
-
-  where
-    docname = tcdName decl
-
-    header_ = topDeclElem links loc [docname]
-                (ppTyInstHeader summary associated decl unicode qual)
-
-
-ppTyInstHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
-ppTyInstHeader _ _ decl unicode qual =
-  keyword "type instance" <+>
-  ppAppNameTypes (tcdName decl) typeArgs unicode qual
-  where
-    typeArgs = map unLoc . fromJust . tcdTyPats $ decl
-
-
---------------------------------------------------------------------------------
 -- * Associated Types
 --------------------------------------------------------------------------------
 
@@ -240,7 +194,6 @@ ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LTyClDecl DocName -> B
 ppAssocType summ links doc (L loc decl) unicode qual =
   case decl of
     TyFamily  {} -> ppTyFam summ True links loc (fst doc) decl unicode qual
-    TySynonym {} -> ppTySyn summ links loc doc decl unicode qual
     _            -> error "declaration type not supported by ppAssocType"
 
 
@@ -353,6 +306,8 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _ _) lo
             [ ppAssocType summary links doc at unicode qual | at <- ats
               , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ]  ++
 
+                -- ToDo: add associated type defaults
+
             [ ppFunSig summary links loc doc names typ unicode qual
               | L _ (TypeSig lnames (L _ typ)) <- sigs
               , let doc = lookupAnySubdoc (head names) subdocs
@@ -385,6 +340,7 @@ ppClassDecl summary links instances loc mbDoc subdocs
 
     hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
 
+    -- ToDo: add assocatied typ defaults
     atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode qual
                       | at <- ats
                       , let doc = lookupAnySubdoc (tcdName $ unL at) subdocs ]
@@ -448,7 +404,7 @@ ppShortDataDecl summary _links _loc dataDecl unicode qual
     doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual
     doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual
 
-    cons      = tcdCons dataDecl
+    cons      = td_cons (tcdTyDefn dataDecl)
     resTy     = (con_res . unLoc . head) cons
 
 
@@ -463,7 +419,7 @@ ppDataDecl summary links instances subdocs loc mbDoc dataDecl unicode qual
 
   where
     docname   = unLoc . tcdLName $ dataDecl
-    cons      = tcdCons dataDecl
+    cons      = td_cons (tcdTyDefn dataDecl)
     resTy     = (con_res . unLoc . head) cons
 
     header_ = topDeclElem links loc [docname] (ppDataHeader summary dataDecl unicode qual
@@ -618,15 +574,15 @@ ppShortField summary unicode qual (ConDeclField (L _ name) ltype _)
 -- | Print the LHS of a data\/newtype declaration.
 -- Currently doesn't handle 'data instance' decls or kind signatures
 ppDataHeader :: Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
-ppDataHeader summary decl unicode qual
-  | not (isDataDecl decl) = error "ppDataHeader: illegal argument"
-  | otherwise =
-    -- newtype or data
-    (if tcdND decl == NewType then keyword "newtype" else keyword "data") <+>
+ppDataHeader summary decl@(TyDecl { tcdTyDefn = TyData { td_ND = nd, td_ctxt = ctxt } }) 
+             unicode qual
+  = -- newtype or data
+    (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+>
     -- context
-    ppLContext (tcdCtxt decl) unicode qual <+>
+    ppLContext ctxt unicode qual <+>
     -- T a b c ..., or a :+: b
     ppTyClBinderWithVars summary decl
+ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument"
 
 
 --------------------------------------------------------------------------------
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 3dad9a2c..0470a5f5 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -69,61 +69,57 @@ tyThingToLHsDecl t = noLoc $ case t of
 
   -- type-constructors (e.g. Maybe) are complicated, put the definition
   -- later in the file (also it's used for class associated-types too.)
-  ACoAxiom ax -> TyClD (synifyAxiom ax)
+  ACoAxiom ax -> InstD (FamInstD (synifyAxiom ax))
 
   -- a data-constructor alone just gets rendered as a function:
   ADataCon dc -> SigD (TypeSig [synifyName dc]
     (synifyType ImplicitizeForAll (dataConUserType dc)))
 
-synifyATDefault :: TyCon -> LTyClDecl Name
+synifyATDefault :: TyCon -> LFamInstDecl Name
 synifyATDefault tc = noLoc (synifyAxiom ax)
   where Just ax = tyConFamilyCoercion_maybe tc
 
-synifyAxiom :: CoAxiom -> TyClDecl Name
+synifyAxiom :: CoAxiom -> FamInstDecl Name
 synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs })
   | Just (tc, args) <- tcSplitTyConApp_maybe lhs
   = let name      = synifyName tc
-        tyvars    = synifyTyVars tvs
         typats    = map (synifyType WithinType) args
         hs_rhs_ty = synifyType WithinType rhs
-    in TySynonym name tyvars (Just typats) hs_rhs_ty placeHolderNames
+    in FamInstDecl { fid_tycon = name 
+                   , fid_pats = HsBSig typats (map tyVarName tvs)
+                   , fid_defn = TySynonym hs_rhs_ty }
   | otherwise
   = error "synifyAxiom" 
 
 synifyTyCon :: TyCon -> TyClDecl Name
 synifyTyCon tc
-  | isFunTyCon tc || isPrimTyCon tc =
-    TyData
-      -- arbitrary lie, they are neither algebraic data nor newtype:
-      DataType
-      -- no built-in type has any stupidTheta:
-      (noLoc [])
-      (synifyName tc)
-      Nothing
-      -- tyConTyVars doesn't work on fun/prim, but we can make them up:
-      (zipWith
-         (\fakeTyVar realKind -> noLoc $
-             KindedTyVar (getName fakeTyVar) 
-                         (synifyKindSig realKind))
-         alphaTyVars --a, b, c... which are unfortunately all kind *
-         (fst . splitKindFunTys $ tyConKind tc)
-      )
-      -- assume primitive types aren't members of data/newtype families:
-      Nothing
-      -- we have their kind accurately:
-      (Just (synifyKindSig (tyConKind tc)))
-      -- no algebraic constructors:
-      []
-      -- "deriving" needn't be specified:
-      Nothing
-  | isSynFamilyTyCon tc =
-      case synTyConRhs tc of
+  | isFunTyCon tc || isPrimTyCon tc 
+  = TyDecl { tcdLName = synifyName tc
+           , tcdTyVars =       -- tyConTyVars doesn't work on fun/prim, but we can make them up:
+                         zipWith
+                            (\fakeTyVar realKind -> noLoc $
+                                KindedTyVar (getName fakeTyVar) 
+                                            (synifyKindSig realKind))
+                            alphaTyVars --a, b, c... which are unfortunately all kind *
+                            (fst . splitKindFunTys $ tyConKind tc)
+           , tcdTyDefn = TyData { td_ND = DataType  -- arbitrary lie, they are neither 
+                                                    -- algebraic data nor newtype:
+                                , td_ctxt = noLoc []
+                                , td_cType = Nothing
+                                , td_kindSig = Just (synifyKindSig (tyConKind tc))
+                                               -- we have their kind accurately:
+                                , td_cons = []  -- No constructors
+                                , td_derivs = Nothing }
+           , tcdFVs = placeHolderNames }
+  | isSynFamilyTyCon tc 
+  = case synTyConRhs tc of
         SynFamilyTyCon ->
           TyFamily TypeFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
                (Just (synifyKindSig (synTyConResKind tc)))
         _ -> error "synifyTyCon: impossible open type synonym?"
-  | isDataFamilyTyCon tc = --(why no "isOpenAlgTyCon"?)
-      case algTyConRhs tc of
+  | isDataFamilyTyCon tc 
+  = --(why no "isOpenAlgTyCon"?)
+    case algTyConRhs tc of
         DataFamilyTyCon ->
           TyFamily DataFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
                Nothing --always kind '*'
@@ -139,9 +135,6 @@ synifyTyCon tc
   alg_ctx = synifyCtx (tyConStupidTheta tc)
   name = synifyName tc
   tyvars = synifyTyVars (tyConTyVars tc)
-  typats = case tyConFamInst_maybe tc of
-     Nothing -> Nothing
-     Just (_, indexes) -> Just (map (synifyType WithinType) indexes)
   alg_kindSig = Just (tyConKind tc)
   -- The data constructors.
   --
@@ -164,10 +157,14 @@ synifyTyCon tc
   -- "deriving" doesn't affect the signature, no need to specify any.
   alg_deriv = Nothing
   syn_type = synifyType WithinType (synTyConType tc)
- in if isSynTyCon tc
-  then TySynonym name tyvars typats syn_type placeHolderNames
-  else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKindSig alg_kindSig) alg_cons alg_deriv
-
+  defn | isSynTyCon tc = TySynonym syn_type
+       | otherwise = TyData { td_ND = alg_nd, td_ctxt = alg_ctx
+                            , td_cType = Nothing
+                            , td_kindSig = fmap synifyKindSig alg_kindSig
+                            , td_cons    = alg_cons 
+                            , td_derivs  = alg_deriv }
+ in TyDecl { tcdLName = name, tcdTyVars = tyvars, tcdTyDefn = defn
+           , tcdFVs = placeHolderNames }
 
 -- User beware: it is your responsibility to pass True (use_gadt_syntax)
 -- for any constructor that would be misrepresented by omitting its
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index fc04351b..c38bf9e5 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -78,7 +78,7 @@ isVarSym = isLexVarSym . occNameFS
 
 
 getMainDeclBinder :: HsDecl name -> [name]
-getMainDeclBinder (TyClD d) | not (isFamInstDecl d) = [tcdName d]
+getMainDeclBinder (TyClD d) = [tcdName d]
 getMainDeclBinder (ValD d) =
   case collectHsBindBinders d of
     []       -> []
@@ -138,7 +138,6 @@ isDocD _ = False
 
 isInstD :: HsDecl a -> Bool
 isInstD (InstD _) = True
-isInstD (TyClD d) = isFamInstDecl d
 isInstD _ = False
 
 
@@ -216,7 +215,7 @@ instance Parent (ConDecl Name) where
 
 instance Parent (TyClDecl Name) where
   children d
-    | isDataDecl  d = map (unL . con_name . unL) . tcdCons $ d
+    | isDataDecl  d = map (unL . con_name . unL) . td_cons . tcdTyDefn $ d
     | isClassDecl d =
         map (tcdName . unL) (tcdATs d) ++
         [ unL n | L _ (TypeSig ns _) <- tcdSigs d, n <- ns ]
@@ -232,7 +231,7 @@ family = getName &&& children
 -- child to its grand-children, recursively.
 families :: TyClDecl Name -> [(Name, [Name])]
 families d
-  | isDataDecl  d = family d : map (family . unL) (tcdCons d)
+  | isDataDecl  d = family d : map (family . unL) (td_cons (tcdTyDefn d))
   | isClassDecl d = family d : concatMap (families . unL) (tcdATs d)
   | otherwise     = []
 
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 00f1319c..5029dce8 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -188,7 +188,7 @@ mkMaps dflags gre instances exports decls = do
       let subNames = map fst subDocs
 
       let names = case d of
-            InstD (ClsInstDecl (L l _) _ _ _) -> maybeToList (M.lookup l instanceMap)  -- See note [2].
+            InstD (ClsInstD (L l _) _ _ _) -> maybeToList (M.lookup l instanceMap)  -- See note [2].
             _ -> filter (`elem` exports) (getMainDeclBinder d)
 
       let docMap' = M.fromList (mapMaybe (\(n,doc) -> fmap (n,) doc) ([ (n, mayDoc) | n <- names ] ++ subDocs))
@@ -217,7 +217,7 @@ subordinates (TyClD decl)
                 ]
     dataSubs = constrs ++ fields
       where
-        cons = map unL $ tcdCons decl
+        cons = map unL $ (td_cons (tcdTyDefn decl))
         constrs = [ (unL $ con_name c, maybeToList $ fmap unL $ con_doc c, M.empty)
                   | c <- cons ]
         fields  = [ (unL n, maybeToList $ fmap unL doc, M.empty)
@@ -233,7 +233,7 @@ typeDocs d =
   case d of
     SigD (TypeSig _ ty) -> docs (unLoc ty)
     ForD (ForeignImport _ ty _ _) -> docs (unLoc ty)
-    TyClD (TySynonym {tcdSynRhs = ty}) -> docs (unLoc ty)
+    TyClD (TyDecl { tcdTyDefn = TySynonym {td_synRhs = ty}}) -> docs (unLoc ty)
     _ -> M.empty
   where
     go n (HsForAllTy _ _ _ ty) = go n (unLoc ty)
@@ -295,7 +295,7 @@ warnAboutFilteredDecls :: Module -> [LHsDecl Name] -> ErrMsgM ()
 warnAboutFilteredDecls mdl decls = do
   let modStr = moduleString mdl
   let typeInstances =
-        nub [ tcdName d | L _ (InstD (FamInstDecl d)) <- decls ]
+        nub [ unLoc (fid_tycon d) | L _ (InstD (FamInstD d)) <- decls ]
 
   unless (null typeInstances) $
     tell [
@@ -304,7 +304,7 @@ warnAboutFilteredDecls mdl decls = do
       ++ "will be filtered out:\n  " ++ concat (intersperse ", "
       $ map (occNameString . nameOccName) typeInstances) ]
 
-  let instances = nub [ pretty i | L _ (InstD (ClsInstDecl i _ _ ats)) <- decls
+  let instances = nub [ pretty i | L _ (InstD (ClsInstD i _ _ ats)) <- decls
                                  , not (null ats) ]
 
   unless (null instances) $
@@ -644,7 +644,7 @@ extractDecl name mdl decl
           _ -> error "internal: extractDecl"
       TyClD d | isDataDecl d ->
         let (n, tyvar_names) = name_and_tyvars d
-            L pos sig = extractRecSel name mdl n tyvar_names (tcdCons d)
+            L pos sig = extractRecSel name mdl n tyvar_names (td_cons (tcdTyDefn d))
         in L pos (SigD sig)
       _ -> error "internal: extractDecl"
   where
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 6034688e..7417d234 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -325,22 +325,11 @@ renameTyClD d = case d of
 --    return (TyFamily flav lname' ltyvars' kind' tckind)
     return (TyFamily flav lname' ltyvars' tckind')
 
-  TyData x lcontext lname cType ltyvars typats k cons _ -> do
-    lcontext' <- renameLContext lcontext
+  TyDecl { tcdLName = lname, tcdTyVars = tyvars, tcdTyDefn = defn, tcdFVs = fvs } -> do
     lname'    <- renameL lname
-    ltyvars'  <- mapM renameLTyVarBndr ltyvars
-    typats'   <- mapM (mapM renameLType) typats
-    k'        <- renameMaybeLKind k
-    cons'     <- mapM renameLCon cons
-    -- I don't think we need the derivings, so we return Nothing
-    return (TyData x lcontext' lname' cType ltyvars' typats' k' cons' Nothing)
-
-  TySynonym lname ltyvars typats ltype fvs -> do
-    lname'   <- renameL lname
-    ltyvars' <- mapM renameLTyVarBndr ltyvars
-    ltype'   <- renameLType ltype
-    typats'  <- mapM (mapM renameLType) typats
-    return (TySynonym lname' ltyvars' typats' ltype' fvs)
+    tyvars'  <- mapM renameLTyVarBndr tyvars
+    defn'     <- renameTyDefn defn
+    return (TyDecl { tcdLName = lname', tcdTyVars = tyvars', tcdTyDefn = defn', tcdFVs = fvs })
 
   ClassDecl lcontext lname ltyvars lfundeps lsigs _ ats at_defs _ -> do
     lcontext' <- renameLContext lcontext
@@ -349,15 +338,36 @@ renameTyClD d = case d of
     lfundeps' <- mapM renameLFunDep lfundeps
     lsigs'    <- mapM renameLSig lsigs
     ats'      <- mapM renameLTyClD ats
-    at_defs'  <- mapM renameLTyClD at_defs
+    at_defs'  <- mapM (mapM renameFamInstD) at_defs
     -- we don't need the default methods or the already collected doc entities
     return (ClassDecl lcontext' lname' ltyvars' lfundeps' lsigs' emptyBag ats' at_defs' [])
 
   where
-    renameLCon (L loc con) = return . L loc =<< renameCon con
-    renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars
-                            , con_cxt = lcontext, con_details = details
-                            , con_res = restype, con_doc = mbldoc }) = do
+    renameLFunDep (L loc (xs, ys)) = do
+      xs' <- mapM rename xs
+      ys' <- mapM rename ys
+      return (L loc (xs', ys'))
+
+    renameLSig (L loc sig) = return . L loc =<< renameSig sig
+
+renameTyDefn :: HsTyDefn Name -> RnM (HsTyDefn DocName)
+renameTyDefn (TyData { td_ND = nd, td_ctxt = lcontext, td_cType = cType
+                     , td_kindSig = k, td_cons = cons }) = do
+    lcontext' <- renameLContext lcontext
+    k'        <- renameMaybeLKind k
+    cons'     <- mapM (mapM renameCon) cons
+    -- I don't think we need the derivings, so we return Nothing
+    return (TyData { td_ND = nd, td_ctxt = lcontext', td_cType = cType
+                   , td_kindSig = k', td_cons = cons', td_derivs = Nothing })
+
+renameTyDefn (TySynonym { td_synRhs = ltype }) = do
+    ltype'   <- renameLType ltype
+    return (TySynonym { td_synRhs = ltype' })
+
+renameCon :: ConDecl Name -> RnM (ConDecl DocName)
+renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars
+                        , con_cxt = lcontext, con_details = details
+                        , con_res = restype, con_doc = mbldoc }) = do
       lname'    <- renameL lname
       ltyvars'  <- mapM renameLTyVarBndr ltyvars
       lcontext' <- renameLContext lcontext
@@ -366,7 +376,7 @@ renameTyClD d = case d of
       mbldoc'   <- mapM renameLDocHsSyn mbldoc
       return (decl { con_name = lname', con_qvars = ltyvars', con_cxt = lcontext'
                    , con_details = details', con_res = restype', con_doc = mbldoc' })
-
+  where
     renameDetails (RecCon fields) = return . RecCon =<< mapM renameField fields
     renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
     renameDetails (InfixCon a b) = do
@@ -383,14 +393,6 @@ renameTyClD d = case d of
     renameResType (ResTyH98) = return ResTyH98
     renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
 
-    renameLFunDep (L loc (xs, ys)) = do
-      xs' <- mapM rename xs
-      ys' <- mapM rename ys
-      return (L loc (xs', ys'))
-
-    renameLSig (L loc sig) = return . L loc =<< renameSig sig
-
-
 renameSig :: Sig Name -> RnM (Sig DocName)
 renameSig sig = case sig of
   TypeSig lnames ltype -> do
@@ -413,14 +415,22 @@ renameForD (ForeignExport lname ltype co x) = do
 
 
 renameInstD :: InstDecl Name -> RnM (InstDecl DocName)
-renameInstD (ClsInstDecl ltype _ _ lATs) = do
+renameInstD (ClsInstD ltype _ _ lATs) = do
   ltype' <- renameLType ltype
-  lATs' <- mapM renameLTyClD lATs
-  return (ClsInstDecl ltype' emptyBag [] lATs')
+  lATs' <- mapM (mapM renameFamInstD) lATs
+  return (ClsInstD ltype' emptyBag [] lATs')
+
+renameInstD (FamInstD d) = do
+  d' <- renameFamInstD d
+  return (FamInstD d')
+
+renameFamInstD :: FamInstDecl Name -> RnM (FamInstDecl DocName)
+renameFamInstD (FamInstDecl { fid_tycon = tc, fid_pats = HsBSig pats fvs, fid_defn = defn })
+  = do { tc' <- renameL tc
+       ; pats' <- mapM renameLType pats
+       ; defn' <- renameTyDefn defn 
+       ; return (FamInstDecl { fid_tycon = tc', fid_pats = HsBSig pats' fvs, fid_defn = defn' }) }
 
-renameInstD (FamInstDecl d) = do
-  d' <- renameTyClD d
-  return (FamInstDecl d')
 
 renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
 renameExportItem item = case item of
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index de97ef85..3814b97e 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -125,18 +125,24 @@ toInstalledDescription = hmi_description . instInfo
 
 restrictTo :: [Name] -> LHsDecl Name -> LHsDecl Name
 restrictTo names (L loc decl) = L loc $ case decl of
-  TyClD d | isDataDecl d && tcdND d == DataType ->
-    TyClD (d { tcdCons = restrictCons names (tcdCons d) })
-  TyClD d | isDataDecl d && tcdND d == NewType ->
-    case restrictCons names (tcdCons d) of
-      []    -> TyClD (d { tcdND = DataType, tcdCons = [] })
-      [con] -> TyClD (d { tcdCons = [con] })
-      _ -> error "Should not happen"
+  TyClD d | isDataDecl d  -> 
+    TyClD (d { tcdTyDefn = restrictTyDefn names (tcdTyDefn d) })
   TyClD d | isClassDecl d ->
     TyClD (d { tcdSigs = restrictDecls names (tcdSigs d),
                tcdATs = restrictATs names (tcdATs d) })
   _ -> decl
 
+restrictTyDefn :: [Name] -> HsTyDefn Name -> HsTyDefn Name
+restrictTyDefn _ defn@(TySynonym {})
+  = defn
+restrictTyDefn names defn@(TyData { td_ND = new_or_data, td_cons = cons })
+  | DataType <- new_or_data
+  = defn { td_cons = restrictCons names cons }
+  | otherwise    -- Newtype
+  = case restrictCons names cons of
+      []    -> defn { td_ND = DataType, td_cons = [] }
+      [con] -> defn { td_cons = [con] }
+      _ -> error "Should not happen"
 
 restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name]
 restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]