Filter family instances of hidden types

Currently, this check does not extend to hidden right hand sides,
although it probably should hide them in that case.

3 files changed, 20 insertions, 5 deletions

diff --git a/CHANGES b/CHANGES
index e34701c8..e067785f 100644
--- a/CHANGES
+++ b/CHANGES
@@ -27,7 +27,7 @@ Changes in version 2.14.0
 
  * Properly render License field (#271)
 
- * Print type/data family instances
+ * Print type/data family instances (for exported types only)
 
  * Fix display of poly-kinded type operators (#189)
 
diff --git a/html-test/src/TypeFamilies2.hs b/html-test/src/TypeFamilies2.hs
index 093f77c2..34790a51 100644
--- a/html-test/src/TypeFamilies2.hs
+++ b/html-test/src/TypeFamilies2.hs
@@ -3,6 +3,9 @@
 -- in type instances. The expected behaviour is
 -- that we get the instance, Y is not linked and
 -- Haddock shows a linking warning.
+--
+-- The other families and instances that are not exported should not
+-- show up at all
 module TypeFamilies2 (X, Foo, Bar) where
 
 data X
@@ -10,6 +13,11 @@ data Y
 
 type family Foo a
 type instance Foo X = Y
+type instance Foo Y = X -- Should be hidden
 
 data family Bar a
 data instance Bar X = BarX Y
+
+type family Invisible a
+type instance Invisible X = Y
+type instance Invisible Y = X
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 88512c1a..60ae4661 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -73,6 +73,10 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
                     let fam_insts = [ (synifyFamInst i, n)
                                     | i <- sortBy (comparing instFam) fam_instances
                                     , let n = instLookup instDocMap (getName i) iface ifaceMap instIfaceMap
+                                    , not $ isNameHidden expInfo (fi_fam i)
+                                    , not $ any (isTypeHidden expInfo) (fi_tys i)
+                                    -- Should we check for hidden RHS as well?
+                                    -- Ideally, in that case the RHS should simply not show up
                                     ]
                         cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
                                     | let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
@@ -199,11 +203,11 @@ isInstanceHidden expInfo cls tys =
     instClassHidden = isNameHidden expInfo $ getName cls
 
     instTypeHidden :: Bool
-    instTypeHidden = any typeHidden tys
-
-    nameHidden :: Name -> Bool
-    nameHidden = isNameHidden expInfo
+    instTypeHidden = any (isTypeHidden expInfo) tys
 
+isTypeHidden :: ExportInfo -> Type -> Bool
+isTypeHidden expInfo = typeHidden
+  where
     typeHidden :: Type -> Bool
     typeHidden t =
       case t of
@@ -213,3 +217,6 @@ isInstanceHidden expInfo cls tys =
         FunTy t1 t2 -> typeHidden t1 || typeHidden t2
         ForAllTy _ ty -> typeHidden ty
         LitTy _ -> False
+
+    nameHidden :: Name -> Bool
+    nameHidden = isNameHidden expInfo