Latex type families (#734)

* Support for type families in LaTeX

The code is ported over from the XHTML backend.

* Refactor XHTML and LaTeX family handling

This is mostly a consolidation effort: stripping extra exports,
inlining some short definitions, and trying to make the backends
match.

The LaTeX backend now has preliminary support for data families,
although the only the data instance head is printed (not the actual constructors).

Both backends also now use "newtype" for newtype data family
instances.

* Add some tests

8 files changed, 719 insertions, 144 deletions

diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 4a3e9d03..4e0e6eba 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -12,10 +12,9 @@
 -- Portability :  portable
 -----------------------------------------------------------------------------
 module Haddock.Backends.LaTeX (
-  ppLaTeX
+  ppLaTeX,
 ) where
 
-
 import Documentation.Haddock.Markup
 import Haddock.Types
 import Haddock.Utils
@@ -285,7 +284,7 @@ ppDecl :: LHsDecl DocNameI                         -- ^ decl to print
        -> LaTeX
 
 ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
-  TyClD _ d@FamDecl {}         -> ppTyFam False doc d unicode
+  TyClD _ d@FamDecl {}         -> ppFamDecl doc instances d unicode
   TyClD _ d@DataDecl {}        -> ppDataDecl pats instances subdocs (Just doc) d unicode
   TyClD _ d@SynDecl {}         -> ppTySyn (doc, fnArgsDoc) d unicode
 -- Family instances happen via FamInst now
@@ -303,12 +302,6 @@ ppDecl decl pats (doc, fnArgsDoc) instances subdocs _fxts = case unLoc decl of
     unicode = False
 
 
-ppTyFam :: Bool -> Documentation DocName ->
-              TyClDecl DocNameI -> Bool -> LaTeX
-ppTyFam _ _ _ _ =
-  error "type family declarations are currently not supported by --latex"
-
-
 ppFor :: DocForDecl DocName -> ForeignDecl DocNameI -> Bool -> LaTeX
 ppFor doc (ForeignImport _ (L _ name) typ _) unicode =
   ppFunSig doc [name] (hsSigType typ) unicode
@@ -317,6 +310,83 @@ ppFor _ _ _ = error "ppFor error in Haddock.Backends.LaTeX"
 
 
 -------------------------------------------------------------------------------
+-- * Type families
+-------------------------------------------------------------------------------
+
+-- | Pretty-print a data\/type family declaration
+ppFamDecl :: Documentation DocName    -- ^ this decl's docs
+          -> [DocInstance DocNameI]   -- ^ relevant instances
+          -> TyClDecl DocNameI        -- ^ family to print
+          -> Bool                     -- ^ unicode
+          -> LaTeX
+ppFamDecl doc instances decl unicode =
+  declWithDoc (ppFamHeader (tcdFam decl) unicode <+> whereBit)
+              (if null body then Nothing else Just (vcat body))
+  $$ instancesBit
+  where
+    body = catMaybes [familyEqns, documentationToLaTeX doc]
+
+    whereBit = case fdInfo (tcdFam decl) of
+      ClosedTypeFamily _ -> keyword "where"
+      _                  -> empty
+
+    familyEqns
+      | FamilyDecl { fdInfo = ClosedTypeFamily (Just eqns) } <- tcdFam decl
+      = Just (text "\\haddockbeginargs" $$
+              vcat [ decltt (ppFamDeclEqn eqn) <+> nl | L _ eqn <- eqns ] $$
+              text "\\end{tabulary}\\par")
+      | otherwise = Nothing
+
+    -- Individual equations of a closed type family
+    ppFamDeclEqn :: TyFamInstEqn DocNameI -> LaTeX
+    ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n
+                                            , feqn_rhs = rhs
+                                            , feqn_pats = ts } })
+      = hsep [ ppAppNameTypes n (map unLoc ts) unicode
+             , equals
+             , ppType unicode (unLoc rhs)
+             ]
+    ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl"
+    ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl"
+
+    instancesBit = ppDocInstances unicode instances
+
+-- | Print the LHS of a type\/data family declaration.
+ppFamHeader :: FamilyDecl DocNameI  -- ^ family header to print
+              -> Bool                 -- ^ unicode
+              -> LaTeX
+ppFamHeader (XFamilyDecl _) _ = panic "haddock;ppFamHeader"
+ppFamHeader (FamilyDecl { fdLName = L _ name
+                        , fdTyVars = tvs
+                        , fdInfo = info
+                        , fdResultSig = L _ result
+                        , fdInjectivityAnn = injectivity })
+              unicode =
+  leader <+> keyword "family" <+> famName <+> famSig <+> injAnn
+  where
+    leader = case info of
+      OpenTypeFamily     -> keyword "type"
+      ClosedTypeFamily _ -> keyword "type"
+      DataFamily         -> keyword "data"
+
+    famName = ppAppDocNameTyVarBndrs unicode name (hsq_explicit tvs)
+
+    famSig = case result of
+      NoSig _               -> empty
+      KindSig _ kind        -> dcolon unicode <+> ppLKind unicode kind
+      TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode bndr
+      XFamilyResultSig _    -> panic "haddock:ppFamHeader"
+
+    injAnn = case injectivity of
+      Nothing -> empty
+      Just (L _ (InjectivityAnn lhs rhs)) -> hsep ( decltt (text "|")
+                                                  : ppLDocName lhs
+                                                  : arrow unicode
+                                                  : map ppLDocName rhs)
+
+
+
+-------------------------------------------------------------------------------
 -- * Type Synonyms
 -------------------------------------------------------------------------------
 
@@ -538,12 +608,14 @@ ppClassDecl instances doc subdocs
       | otherwise = error "LaTeX.ppClassDecl"
 
     methodTable =
-      text "\\haddockpremethods{}\\textbf{Methods}" $$
-      vcat  [ ppFunSig doc [name] (hsSigWcType typ) unicode
+      text "\\haddockpremethods{}" <> emph (text "Methods") $$
+      vcat  [ ppFunSig doc names (hsSigWcType typ) unicode
             | L _ (TypeSig _ lnames typ) <- lsigs
-            , name <- map unLoc lnames
-            , let doc = lookupAnySubdoc name subdocs
-            ]
+            , let doc = lookupAnySubdoc (head names) subdocs
+                  names = map unLoc lnames ]
+              -- FIXME: is taking just the first name ok? Is it possible that
+              -- there are different subdocs for different names in a single
+              -- type signature?
 
     instancesBit = ppDocInstances unicode instances
 
@@ -573,14 +645,13 @@ ppDocInstance unicode (instHead, doc, _, _) =
 
 
 ppInstDecl :: Bool -> InstHead DocNameI -> LaTeX
-ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
-
-
-ppInstHead :: Bool -> InstHead DocNameI -> LaTeX
-ppInstHead unicode (InstHead {..}) = case ihdInstType of
-    ClassInst ctx _ _ _ -> ppContextNoLocs ctx unicode <+> typ
-    TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs
-    DataInst _ -> error "data instances not supported by --latex yet"
+ppInstDecl unicode (InstHead {..}) = case ihdInstType of
+  ClassInst ctx _ _ _ -> keyword "instance" <+> ppContextNoLocs ctx unicode <+> typ
+  TypeInst rhs -> keyword "type" <+> keyword "instance" <+> typ <+> tibody rhs
+  DataInst dd ->
+    let nd = dd_ND (tcdDataDefn dd)
+        pref = case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }
+    in pref <+> keyword "instance" <+> typ
   where
     typ = ppAppNameTypes ihdClsName ihdTypes unicode
     tibody = maybe empty (\t -> equals <+> ppType unicode t)
@@ -613,7 +684,7 @@ ppDataDecl pats instances subdocs doc dataDecl unicode =
     cons      = dd_cons (tcdDataDefn dataDecl)
     resTy     = (unLoc . head) cons
 
-    body = catMaybes [constrBit,patternBit, doc >>= documentationToLaTeX]
+    body = catMaybes [doc >>= documentationToLaTeX, constrBit,patternBit]
 
     (whereBit, leaders)
       | null cons
@@ -823,6 +894,12 @@ ppDataHeader _ _ = error "ppDataHeader: illegal argument"
 -- * Type applications
 --------------------------------------------------------------------------------
 
+ppAppDocNameTyVarBndrs :: Bool -> DocName -> [LHsTyVarBndr DocNameI] -> LaTeX
+ppAppDocNameTyVarBndrs unicode n vs =
+    ppTypeApp n vs ppDN (ppHsTyVarBndr unicode . unLoc)
+  where
+    ppDN = ppBinder . nameOccName . getName
+
 
 -- | Print an application of a DocName to its list of HsTypes
 ppAppNameTypes :: DocName -> [HsType DocNameI] -> Bool -> LaTeX
@@ -917,6 +994,12 @@ ppType       unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
 ppParendType unicode ty = ppr_mono_ty (reparenTypePrec PREC_TOP ty) unicode
 ppFunLhType  unicode ty = ppr_mono_ty (reparenTypePrec PREC_FUN ty) unicode
 
+ppHsTyVarBndr :: Bool -> HsTyVarBndr DocNameI -> LaTeX
+ppHsTyVarBndr _ (UserTyVar _ (L _ name)) = ppDocName name
+ppHsTyVarBndr unicode (KindedTyVar _ (L _ name) kind) =
+  parens (ppDocName name) <+> dcolon unicode <+> ppLKind unicode kind
+ppHsTyVarBndr _ (XTyVarBndr _) = panic "haddock:ppHsTyVarBndr"
+
 ppLKind :: Bool -> LHsKind DocNameI -> LaTeX
 ppLKind unicode y = ppKind unicode (unLoc y)
 
@@ -973,7 +1056,7 @@ ppr_mono_ty (HsParTy _ ty) unicode
 ppr_mono_ty (HsDocTy _ ty _) unicode
   = ppr_mono_lty ty unicode
 
-ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = char '_'
+ppr_mono_ty (HsWildCardTy (AnonWildCard _)) _ = text "\\_"
 
 ppr_mono_ty (HsTyLit _ t) u = ppr_tylit t u
 ppr_mono_ty (HsStarTy _ isUni) unicode = starSymbol (isUni || unicode)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index cc271fef..12e65716 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -15,9 +15,7 @@
 -----------------------------------------------------------------------------
 module Haddock.Backends.Xhtml.Decl (
   ppDecl,
-
-  ppTyName, ppTyFamHeader, ppTypeApp, ppOrphanInstances,
-  tyvarNames
+  ppOrphanInstances,
 ) where
 
 import Haddock.Backends.Xhtml.DocMarkup
@@ -56,7 +54,7 @@ ppDecl :: Bool                                     -- ^ print summary info only
        -> Qualification
        -> Html
 ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode pkg qual = case decl of
-  TyClD _ (FamDecl _ d)          -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode pkg qual
+  TyClD _ (FamDecl _ d)          -> ppFamDecl summ False links instances fixities loc mbDoc d splice unicode pkg qual
   TyClD _ d@(DataDecl {})        -> ppDataDecl summ links instances fixities subdocs loc mbDoc d pats splice unicode pkg qual
   TyClD _ d@(SynDecl {})         -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode pkg qual
   TyClD _ d@(ClassDecl {})       -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode pkg qual
@@ -67,7 +65,7 @@ ppDecl summ links (L loc decl) pats (mbDoc, fnArgsDoc) instances fixities subdoc
   ForD _ d                       -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode pkg qual
   InstD _ _                      -> noHtml
   DerivD _ _                     -> noHtml
-  _                            -> error "declaration not supported by ppDecl"
+  _                              -> error "declaration not supported by ppDecl"
 
 
 ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
@@ -222,9 +220,6 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
 ppTyVars :: Unicode -> Qualification -> [LHsTyVarBndr DocNameI] -> [Html]
 ppTyVars unicode qual tvs = map (ppHsTyVarBndr unicode qual . unLoc) tvs
 
-tyvarNames :: LHsQTyVars DocNameI -> [Name]
-tyvarNames = map (getName . hsLTyVarName) . hsQTvExplicit
-
 
 ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
       -> ForeignDecl DocNameI -> [(DocName, Fixity)]
@@ -283,111 +278,111 @@ ppSimpleSig links splice unicode qual emptyCtxts loc names typ =
 --------------------------------------------------------------------------------
 
 
-ppFamilyInfo :: Bool -> FamilyInfo DocNameI -> Html
-ppFamilyInfo assoc OpenTypeFamily
-    | assoc = keyword "type"
-    | otherwise = keyword "type family"
-ppFamilyInfo assoc DataFamily
-    | assoc = keyword "data"
-    | otherwise = keyword "data family"
-ppFamilyInfo _ (ClosedTypeFamily _) = keyword "type family"
-
-
-ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocNameI
-              -> Unicode -> Qualification -> Html
-ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
-                                               , fdResultSig = L _ result
-                                               , fdInjectivityAnn = injectivity })
-              unicode qual =
-  (case info of
-     OpenTypeFamily
-       | associated -> keyword "type"
-       | otherwise  -> keyword "type family"
-     DataFamily
-       | associated -> keyword "data"
-       | otherwise  -> keyword "data family"
-     ClosedTypeFamily _
-                    -> keyword "type family"
-  ) <+>
-
-  ppFamDeclBinderWithVars summary unicode qual d <+>
-  ppResultSig result unicode qual <+>
-
-  (case injectivity of
-     Nothing                   -> noHtml
-     Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn
-  ) <+>
-
-  (case info of
-     ClosedTypeFamily _ -> keyword "where ..."
-     _                  -> mempty
-  )
-ppTyFamHeader _ _ (XFamilyDecl _) _ _ = panic "haddock;ppTyFamHeader"
-
-ppResultSig :: FamilyResultSig DocNameI -> Unicode -> Qualification -> Html
-ppResultSig result unicode qual = case result of
-    NoSig _               -> noHtml
-    KindSig _ kind        -> dcolon unicode  <+> ppLKind unicode qual kind
-    TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr
-    XFamilyResultSig _    -> panic "haddock:ppResultSig"
-
-ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocNameI
-                     -> Html
-ppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =
-    ppFamilyInfo True pfdInfo <+>
-    ppAppNameTypes (unLoc pfdLName) (map unLoc pfdTyVars) unicode qual <+>
-    ppResultSig (unLoc pfdKindSig) unicode qual
-
-ppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocNameI -> Html
-ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =
-    char '|' <+> ppLDocName qual Raw lhs <+> arrow unicode <+>
-    hsep (map (ppLDocName qual Raw) rhs)
-
-
-ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocNameI] ->
-           [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
-           FamilyDecl DocNameI -> Splice -> Unicode -> Maybe Package ->
-           Qualification -> Html
-ppTyFam summary associated links instances fixities loc doc decl splice unicode
-        pkg qual
-
-  | summary   = ppTyFamHeader True associated decl unicode qual
+-- | Print a data\/type family declaration
+ppFamDecl :: Bool                     -- ^ is a summary
+          -> Bool                     -- ^ is an associated type
+          -> LinksInfo
+          -> [DocInstance DocNameI]   -- ^ relevant instances
+          -> [(DocName, Fixity)]      -- ^ relevant fixities
+          -> SrcSpan
+          -> Documentation DocName    -- ^ this decl's documentation
+          -> FamilyDecl DocNameI      -- ^ this decl
+          -> Splice -> Unicode -> Maybe Package -> Qualification -> Html
+ppFamDecl summary associated links instances fixities loc doc decl splice unicode pkg qual
+  | summary   = ppFamHeader True associated decl unicode qual
   | otherwise = header_ +++ docSection Nothing pkg qual doc +++ instancesBit
 
   where
     docname = unLoc $ fdLName decl
 
     header_ = topDeclElem links loc splice [docname] $
-       ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
+       ppFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
 
     instancesBit
       | FamilyDecl { fdInfo = ClosedTypeFamily mb_eqns } <- decl
       , not summary
-      = subEquations pkg qual $ map (ppTyFamEqn . unLoc) $ fromMaybe [] mb_eqns
+      = subEquations pkg qual $ map (ppFamDeclEqn . unLoc) $ fromMaybe [] mb_eqns
 
       | otherwise
       = ppInstances links (OriginFamily docname) instances splice unicode pkg qual
 
     -- Individual equation of a closed type family
-    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
+    ppFamDeclEqn :: TyFamInstEqn DocNameI -> SubDecl
+    ppFamDeclEqn (HsIB { hsib_body = FamEqn { feqn_tycon = L _ n
+                                            , feqn_rhs = rhs
+                                            , feqn_pats = ts } })
+      = ( ppAppNameTypes n (map unLoc ts) unicode qual
           <+> equals <+> ppType unicode qual HideEmptyContexts (unLoc rhs)
-        , Nothing, [] )
-    ppTyFamEqn (XHsImplicitBndrs _) = panic "haddock:ppTyFam"
-    ppTyFamEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppTyFam"
-
+        , Nothing
+        , []
+        )
+    ppFamDeclEqn (XHsImplicitBndrs _) = panic "haddock:ppFamDecl"
+    ppFamDeclEqn (HsIB { hsib_body = XFamEqn _}) = panic "haddock:ppFamDecl"
 
 
-ppPseudoFamilyDecl :: LinksInfo -> Splice -> Unicode -> Qualification
-                   -> PseudoFamilyDecl DocNameI
-                   -> Html
-ppPseudoFamilyDecl links splice unicode qual
-                   decl@(PseudoFamilyDecl { pfdLName = L loc name, .. }) =
-    wrapper $ ppPseudoFamilyHeader unicode qual decl
+-- | Print a pseudo family declaration
+ppPseudoFamDecl :: LinksInfo -> Splice
+                -> PseudoFamilyDecl DocNameI   -- ^ this decl
+                -> Unicode -> Qualification -> Html
+ppPseudoFamDecl links splice
+                (PseudoFamilyDecl { pfdInfo = info
+                                  , pfdKindSig = L _ kindSig
+                                  , pfdTyVars = tvs
+                                  , pfdLName = L loc name })
+                unicode qual =
+    topDeclElem links loc splice [name] leader
+  where
+    leader = hsep [ ppFamilyLeader True info
+                  , ppAppNameTypes name (map unLoc tvs) unicode qual
+                  , ppResultSig kindSig unicode qual
+                  ]
+
+-- | Print the LHS of a type\/data family declaration
+ppFamHeader :: Bool                 -- ^ is a summary
+            -> Bool                 -- ^ is an associated type
+            -> FamilyDecl DocNameI  -- ^ family declaration
+            -> Unicode -> Qualification -> Html
+ppFamHeader _ _ (XFamilyDecl _) _ _ = panic "haddock;ppFamHeader"
+ppFamHeader summary associated (FamilyDecl { fdInfo = info
+                                           , fdResultSig = L _ result
+                                           , fdInjectivityAnn = injectivity
+                                           , fdLName = L _ name
+                                           , fdTyVars = tvs })
+              unicode qual =
+  hsep [ ppFamilyLeader associated info
+       , ppAppDocNameTyVarBndrs summary unicode qual name (hsq_explicit tvs)
+       , ppResultSig result unicode qual
+       , injAnn
+       , whereBit
+       ]
   where
-    wrapper = topDeclElem links loc splice [name]
+    whereBit = case info of
+      ClosedTypeFamily _ -> keyword "where ..."
+      _                  -> noHtml
+
+    injAnn = case injectivity of
+      Nothing -> noHtml
+      Just (L _ (InjectivityAnn lhs rhs)) -> hsep ( keyword "|"
+                                                  : ppLDocName qual Raw lhs
+                                                  : arrow unicode
+                                                  : map (ppLDocName qual Raw) rhs)
+
+-- | Print the keywords that begin the family declaration
+ppFamilyLeader :: Bool -> FamilyInfo DocNameI -> Html
+ppFamilyLeader assoc info = keyword (typ ++ if assoc then "" else " family")
+  where
+    typ = case info of
+       OpenTypeFamily     -> "type"
+       ClosedTypeFamily _ -> "type"
+       DataFamily         -> "data"
+
+-- | Print the signature attached to a family
+ppResultSig :: FamilyResultSig DocNameI -> Unicode -> Qualification -> Html
+ppResultSig result unicode qual = case result of
+    NoSig _               -> noHtml
+    KindSig _ kind        -> dcolon unicode  <+> ppLKind unicode qual kind
+    TyVarSig _ (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr
+    XFamilyResultSig _    -> panic "haddock:ppResultSig"
 
 
 --------------------------------------------------------------------------------
@@ -399,25 +394,10 @@ ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocNameI
             -> [(DocName, Fixity)] -> Splice -> Unicode -> Maybe Package
             -> Qualification -> Html
 ppAssocType summ links doc (L loc decl) fixities splice unicode pkg qual =
-   ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode pkg qual
+   ppFamDecl summ True links [] fixities loc (fst doc) decl splice unicode pkg qual
 
 
 --------------------------------------------------------------------------------
--- * TyClDecl helpers
---------------------------------------------------------------------------------
-
--- | Print a type family and its variables
-ppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocNameI -> Html
-ppFamDeclBinderWithVars summ unicode qual (FamilyDecl { fdLName = lname, fdTyVars = tvs }) =
-  ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (hsq_explicit tvs)
-ppFamDeclBinderWithVars _ _ _ (XFamilyDecl _) = panic "haddock:ppFamDeclBinderWithVars"
-
--- | Print a newtype / data binder and its variables
-ppDataBinderWithVars :: Bool -> Unicode -> Qualification -> TyClDecl DocNameI -> Html
-ppDataBinderWithVars summ unicode qual decl =
-  ppAppDocNameTyVarBndrs summ unicode qual (tcdName decl) (hsQTvExplicit $ tcdTyVars decl)
-
---------------------------------------------------------------------------------
 -- * Type applications
 --------------------------------------------------------------------------------
 
@@ -672,7 +652,9 @@ ppInstHead links splice unicode qual mdoc origin orphan no ihd@(InstHead {..}) m
             , mdoc
             , [subFamInstDetails iid pdecl mname])
           where
-            pdata = keyword "data" <+> typ
+            nd = dd_ND (tcdDataDefn dd)
+            pref = case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }
+            pdata = pref <+> typ
             pdecl = pdata <+> ppShortDataDecl False True dd [] unicode qual
   where
     mname = maybe noHtml (\m -> toHtml "Defined in" <+> ppModule m) mdl
@@ -684,9 +666,7 @@ ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification
                    -> [PseudoFamilyDecl DocNameI]
                    -> [Html]
 ppInstanceAssocTys links splice unicode qual =
-    map ppFamilyDecl'
-  where
-    ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual
+    map (\pseudo -> ppPseudoFamDecl links splice pseudo unicode qual)
 
 
 ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
@@ -1060,10 +1040,12 @@ ppSideBySidePat fixities unicode qual lnames typ (doc, argDocs) =
 -- | Print the LHS of a data\/newtype declaration.
 -- Currently doesn't handle 'data instance' decls or kind signatures
 ppDataHeader :: Bool -> TyClDecl DocNameI -> Unicode -> Qualification -> Html
-ppDataHeader summary decl@(DataDecl { tcdDataDefn =
-                                         HsDataDefn { dd_ND = nd
-                                                    , dd_ctxt = ctxt
-                                                    , dd_kindSig = ks } })
+ppDataHeader summary (DataDecl { tcdDataDefn =
+                                    HsDataDefn { dd_ND = nd
+                                               , dd_ctxt = ctxt
+                                               , dd_kindSig = ks }
+                               , tcdLName = L _ name
+                               , tcdTyVars = tvs })
              unicode qual
   = -- newtype or data
     (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" })
@@ -1071,7 +1053,7 @@ ppDataHeader summary decl@(DataDecl { tcdDataDefn =
     -- context
     ppLContext ctxt unicode qual HideEmptyContexts <+>
     -- T a b c ..., or a :+: b
-    ppDataBinderWithVars summary unicode qual decl
+    ppAppDocNameTyVarBndrs summary unicode qual name (hsQTvExplicit tvs)
     <+> case ks of
       Nothing -> mempty
       Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x
@@ -1120,7 +1102,7 @@ ppHsTyVarBndr _       qual (UserTyVar _ (L _ name)) =
 ppHsTyVarBndr unicode qual (KindedTyVar _ name kind) =
     parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
             ppLKind unicode qual kind)
-ppHsTyVarBndr _ _ (XTyVarBndr _) = error "haddock:ppHsTyVarBndr"
+ppHsTyVarBndr _ _ (XTyVarBndr _) = panic "haddock:ppHsTyVarBndr"
 
 ppLKind :: Unicode -> Qualification -> LHsKind DocNameI -> Html
 ppLKind unicode qual y = ppKind unicode qual (unLoc y)
diff --git a/html-test/ref/TypeFamilies3.html b/html-test/ref/TypeFamilies3.html
new file mode 100644
index 00000000..2dadf435
--- /dev/null
+++ b/html-test/ref/TypeFamilies3.html
@@ -0,0 +1,356 @@
+<html xmlns="http://www.w3.org/1999/xhtml"
+><head
+  ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"
+     /><title
+    >TypeFamilies3</title
+    ><link href="#" rel="stylesheet" type="text/css" title="Ocean"
+     /><link rel="stylesheet" type="text/css" href="#"
+     /><script src="haddock-bundle.min.js" async="async" type="text/javascript"
+    ></script
+    ><script src="https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS-MML_HTMLorMML" type="text/javascript"
+    ></script
+    ></head
+  ><body
+  ><div id="package-header"
+    ><ul class="links" id="page-menu"
+      ><li
+	><a href="#"
+	  >Contents</a
+	  ></li
+	><li
+	><a href="#"
+	  >Index</a
+	  ></li
+	></ul
+      ><p class="caption empty"
+      ></p
+      ></div
+    ><div id="content"
+    ><div id="module-header"
+      ><table class="info"
+	><tr
+	  ><th
+	    >Safe Haskell</th
+	    ><td
+	    >Safe</td
+	    ></tr
+	  ></table
+	><p class="caption"
+	>TypeFamilies3</p
+	></div
+      ><div id="synopsis"
+      ><details id="syn"
+	><summary
+	  >Synopsis</summary
+	  ><ul class="details-toggle" data-details-id="syn"
+	  ><li class="src short"
+	    ><span class="keyword"
+	      >type family</span
+	      > <a href="#"
+	      >Foo</a
+	      > a <span class="keyword"
+	      >where ...</span
+	      ></li
+	    ><li class="src short"
+	    ><span class="keyword"
+	      >type family</span
+	      > <a href="#"
+	      >Bar</a
+	      > a</li
+	    ><li class="src short"
+	    ><span class="keyword"
+	      >data family</span
+	      > <a href="#"
+	      >Baz</a
+	      > a</li
+	    ></ul
+	  ></details
+	></div
+      ><div id="interface"
+      ><h1
+	>Documentation</h1
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >type family</span
+	    > <a id="t:Foo" class="def"
+	    >Foo</a
+	    > a <span class="keyword"
+	    >where ...</span
+	    > <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >A closed type family</p
+	    ></div
+	  ><div class="subs equations"
+	  ><p class="caption"
+	    >Equations</p
+	    ><table
+	    ><tr
+	      ><td class="src"
+		><a href="#" title="TypeFamilies3"
+		  >Foo</a
+		  > () = <a href="#" title="Data.Int"
+		  >Int</a
+		  ></td
+		><td class="doc empty"
+		></td
+		></tr
+	      ><tr
+	      ><td class="src"
+		><a href="#" title="TypeFamilies3"
+		  >Foo</a
+		  > _ = ()</td
+		><td class="doc empty"
+		></td
+		></tr
+	      ></table
+	    ></div
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >type family</span
+	    > <a id="t:Bar" class="def"
+	    >Bar</a
+	    > a <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >An open family</p
+	    ></div
+	  ><div class="subs instances"
+	  ><details id="i:Bar" open="open"
+	    ><summary
+	      >Instances</summary
+	      ><table
+	      ><tr
+		><td class="src clearfix"
+		  ><span class="inst-left"
+		    ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Bar:Bar:1"
+		      ></span
+		      > <span class="keyword"
+		      >type</span
+		      > <a href="#" title="TypeFamilies3"
+		      >Bar</a
+		      > <a href="#" title="Data.Int"
+		      >Int</a
+		      ></span
+		    > <a href="#" class="selflink"
+		    >#</a
+		    ></td
+		  ><td class="doc empty"
+		  ></td
+		  ></tr
+		><tr
+		><td colspan="2"
+		  ><details id="i:if:Bar:Bar:1"
+		    ><summary class="hide-when-js-enabled"
+		      >Instance details</summary
+		      ><p
+		      >Defined in <a href="#"
+			>TypeFamilies3</a
+			></p
+		      > <div class="src"
+		      ><span class="keyword"
+			>type</span
+			> <a href="#" title="TypeFamilies3"
+			>Bar</a
+			> <a href="#" title="Data.Int"
+			>Int</a
+			> = ()</div
+		      ></details
+		    ></td
+		  ></tr
+		><tr
+		><td class="src clearfix"
+		  ><span class="inst-left"
+		    ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Bar:Bar:2"
+		      ></span
+		      > <span class="keyword"
+		      >type</span
+		      > <a href="#" title="TypeFamilies3"
+		      >Bar</a
+		      > ()</span
+		    > <a href="#" class="selflink"
+		    >#</a
+		    ></td
+		  ><td class="doc empty"
+		  ></td
+		  ></tr
+		><tr
+		><td colspan="2"
+		  ><details id="i:if:Bar:Bar:2"
+		    ><summary class="hide-when-js-enabled"
+		      >Instance details</summary
+		      ><p
+		      >Defined in <a href="#"
+			>TypeFamilies3</a
+			></p
+		      > <div class="src"
+		      ><span class="keyword"
+			>type</span
+			> <a href="#" title="TypeFamilies3"
+			>Bar</a
+			> () = <a href="#" title="Data.Int"
+			>Int</a
+			></div
+		      ></details
+		    ></td
+		  ></tr
+		></table
+	      ></details
+	    ></div
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >data family</span
+	    > <a id="t:Baz" class="def"
+	    >Baz</a
+	    > a <a href="#" class="selflink"
+	    >#</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >A data family</p
+	    ></div
+	  ><div class="subs instances"
+	  ><details id="i:Baz" open="open"
+	    ><summary
+	      >Instances</summary
+	      ><table
+	      ><tr
+		><td class="src clearfix"
+		  ><span class="inst-left"
+		    ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Baz:Baz:1"
+		      ></span
+		      > <span class="keyword"
+		      >newtype</span
+		      > <a href="#" title="TypeFamilies3"
+		      >Baz</a
+		      > <a href="#" title="Prelude"
+		      >Double</a
+		      ></span
+		    > <a href="#" class="selflink"
+		    >#</a
+		    ></td
+		  ><td class="doc empty"
+		  ></td
+		  ></tr
+		><tr
+		><td colspan="2"
+		  ><details id="i:if:Baz:Baz:1"
+		    ><summary class="hide-when-js-enabled"
+		      >Instance details</summary
+		      ><p
+		      >Defined in <a href="#"
+			>TypeFamilies3</a
+			></p
+		      > <div class="src"
+		      ><span class="keyword"
+			>newtype</span
+			> <a href="#" title="TypeFamilies3"
+			>Baz</a
+			> <a href="#" title="Prelude"
+			>Double</a
+			> = <a id="v:Baz3" class="def"
+			>Baz3</a
+			> <a href="#" title="Prelude"
+			>Float</a
+			></div
+		      ></details
+		    ></td
+		  ></tr
+		><tr
+		><td class="src clearfix"
+		  ><span class="inst-left"
+		    ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Baz:Baz:2"
+		      ></span
+		      > <span class="keyword"
+		      >data</span
+		      > <a href="#" title="TypeFamilies3"
+		      >Baz</a
+		      > <a href="#" title="Data.Int"
+		      >Int</a
+		      ></span
+		    > <a href="#" class="selflink"
+		    >#</a
+		    ></td
+		  ><td class="doc empty"
+		  ></td
+		  ></tr
+		><tr
+		><td colspan="2"
+		  ><details id="i:if:Baz:Baz:2"
+		    ><summary class="hide-when-js-enabled"
+		      >Instance details</summary
+		      ><p
+		      >Defined in <a href="#"
+			>TypeFamilies3</a
+			></p
+		      > <div class="src"
+		      ><span class="keyword"
+			>data</span
+			> <a href="#" title="TypeFamilies3"
+			>Baz</a
+			> <a href="#" title="Data.Int"
+			>Int</a
+			> = <a id="v:Baz2" class="def"
+			>Baz2</a
+			> <a href="#" title="Data.Bool"
+			>Bool</a
+			></div
+		      ></details
+		    ></td
+		  ></tr
+		><tr
+		><td class="src clearfix"
+		  ><span class="inst-left"
+		    ><span class="instance details-toggle-control details-toggle" data-details-id="i:if:Baz:Baz:3"
+		      ></span
+		      > <span class="keyword"
+		      >data</span
+		      > <a href="#" title="TypeFamilies3"
+		      >Baz</a
+		      > ()</span
+		    > <a href="#" class="selflink"
+		    >#</a
+		    ></td
+		  ><td class="doc empty"
+		  ></td
+		  ></tr
+		><tr
+		><td colspan="2"
+		  ><details id="i:if:Baz:Baz:3"
+		    ><summary class="hide-when-js-enabled"
+		      >Instance details</summary
+		      ><p
+		      >Defined in <a href="#"
+			>TypeFamilies3</a
+			></p
+		      > <div class="src"
+		      ><span class="keyword"
+			>data</span
+			> <a href="#" title="TypeFamilies3"
+			>Baz</a
+			> () = <a id="v:Baz1" class="def"
+			>Baz1</a
+			></div
+		      ></details
+		    ></td
+		  ></tr
+		></table
+	      ></details
+	    ></div
+	  ></div
+	></div
+      ></div
+    ><div id="footer"
+    ></div
+    ></body
+  ></html
+>
\ No newline at end of file
diff --git a/html-test/src/TypeFamilies3.hs b/html-test/src/TypeFamilies3.hs
new file mode 100644
index 00000000..bde05fb8
--- /dev/null
+++ b/html-test/src/TypeFamilies3.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module TypeFamilies3 where
+
+-- | A closed type family
+type family Foo a where
+  Foo () = Int
+  Foo _ = ()
+
+-- | An open family
+type family Bar a
+
+type instance Bar Int = ()
+type instance Bar () = Int
+
+-- | A data family
+data family Baz a
+
+data instance Baz () = Baz1
+data instance Baz Int = Baz2 Bool
+newtype instance Baz Double = Baz3 Float
diff --git a/latex-test/ref/TypeFamilies3/TypeFamilies3.tex b/latex-test/ref/TypeFamilies3/TypeFamilies3.tex
new file mode 100644
index 00000000..2a8ad297
--- /dev/null
+++ b/latex-test/ref/TypeFamilies3/TypeFamilies3.tex
@@ -0,0 +1,44 @@
+\haddockmoduleheading{TypeFamilies3}
+\label{module:TypeFamilies3}
+\haddockbeginheader
+{\haddockverb\begin{verbatim}
+module TypeFamilies3 (
+    Foo,  Bar,  Baz(Baz3, Baz2, Baz1)
+  ) where\end{verbatim}}
+\haddockendheader
+
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type\ family\ Foo\ a\ where
+\end{tabular}]\haddockbegindoc
+\haddockbeginargs
+\haddockdecltt{Foo () = Int} \\
+\haddockdecltt{Foo \_ = ()} \\
+\end{tabulary}\par
+A closed type family\par
+
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type\ family\ Bar\ a
+\end{tabular}]\haddockbegindoc
+An open family\par
+
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+type\ instance\ Bar\ Int\ =\ ()\\type\ instance\ Bar\ ()\ =\ Int
+\end{tabular}]
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+data\ family\ Baz\ a
+\end{tabular}]\haddockbegindoc
+A data family\par
+
+\end{haddockdesc}
+\begin{haddockdesc}
+\item[\begin{tabular}{@{}l}
+newtype\ instance\ Baz\ Double\\data\ instance\ Baz\ Int\\data\ instance\ Baz\ ()
+\end{tabular}]
+\end{haddockdesc}
\ No newline at end of file
diff --git a/latex-test/ref/TypeFamilies3/haddock.sty b/latex-test/ref/TypeFamilies3/haddock.sty
new file mode 100644
index 00000000..6e031a98
--- /dev/null
+++ b/latex-test/ref/TypeFamilies3/haddock.sty
@@ -0,0 +1,57 @@
+% Default Haddock style definitions.  To use your own style, invoke
+% Haddock with the option --latex-style=mystyle.
+
+\usepackage{tabulary} % see below
+
+% make hyperlinks in the PDF, and add an expandabale index
+\usepackage[pdftex,bookmarks=true]{hyperref}
+
+\newenvironment{haddocktitle}
+  {\begin{center}\bgroup\large\bfseries}
+  {\egroup\end{center}}
+\newenvironment{haddockprologue}{\vspace{1in}}{}
+
+\newcommand{\haddockmoduleheading}[1]{\chapter{\texttt{#1}}}
+
+\newcommand{\haddockbeginheader}{\hrulefill}
+\newcommand{\haddockendheader}{\noindent\hrulefill}
+
+% a little gap before the ``Methods'' header
+\newcommand{\haddockpremethods}{\vspace{2ex}}
+
+% inserted before \\begin{verbatim}
+\newcommand{\haddockverb}{\small}
+
+% an identifier: add an index entry
+\newcommand{\haddockid}[1]{\haddocktt{#1}\index{#1@\texttt{#1}}}
+
+% The tabulary environment lets us have a column that takes up ``the
+% rest of the space''.  Unfortunately it doesn't allow
+% the \end{tabulary} to be in the expansion of a macro, it must appear
+% literally in the document text, so Haddock inserts
+% the \end{tabulary} itself.
+\newcommand{\haddockbeginconstrs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+\newcommand{\haddockbeginargs}{\begin{tabulary}{\linewidth}{@{}llJ@{}}}
+
+\newcommand{\haddocktt}[1]{{\small \texttt{#1}}}
+\newcommand{\haddockdecltt}[1]{{\small\bfseries \texttt{#1}}}
+
+\makeatletter
+\newenvironment{haddockdesc}
+               {\list{}{\labelwidth\z@ \itemindent-\leftmargin
+                        \let\makelabel\haddocklabel}}
+               {\endlist}
+\newcommand*\haddocklabel[1]{\hspace\labelsep\haddockdecltt{#1}}
+\makeatother
+
+% after a declaration, start a new line for the documentation.
+% Otherwise, the documentation starts right after the declaration,
+% because we're using the list environment and the declaration is the
+% ``label''.  I tried making this newline part of the label, but
+% couldn't get that to work reliably (the space seemed to stretch
+% sometimes).
+\newcommand{\haddockbegindoc}{\hfill\\[1ex]}
+
+% spacing between paragraphs and no \parindent looks better
+\parskip=10pt plus2pt minus2pt
+\setlength{\parindent}{0cm}
diff --git a/latex-test/ref/TypeFamilies3/main.tex b/latex-test/ref/TypeFamilies3/main.tex
new file mode 100644
index 00000000..2c98043c
--- /dev/null
+++ b/latex-test/ref/TypeFamilies3/main.tex
@@ -0,0 +1,11 @@
+\documentclass{book}
+\usepackage{haddock}
+\begin{document}
+\begin{titlepage}
+\begin{haddocktitle}
+
+\end{haddocktitle}
+\end{titlepage}
+\tableofcontents
+\input{TypeFamilies3}
+\end{document}
\ No newline at end of file
diff --git a/latex-test/src/TypeFamilies3/TypeFamilies3.hs b/latex-test/src/TypeFamilies3/TypeFamilies3.hs
new file mode 100644
index 00000000..bde05fb8
--- /dev/null
+++ b/latex-test/src/TypeFamilies3/TypeFamilies3.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module TypeFamilies3 where
+
+-- | A closed type family
+type family Foo a where
+  Foo () = Int
+  Foo _ = ()
+
+-- | An open family
+type family Bar a
+
+type instance Bar Int = ()
+type instance Bar () = Int
+
+-- | A data family
+data family Baz a
+
+data instance Baz () = Baz1
+data instance Baz Int = Baz2 Bool
+newtype instance Baz Double = Baz3 Float