aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--html-test/ref/TypeFamilies2.html92
-rw-r--r--html-test/src/TypeFamilies2.hs32
-rw-r--r--src/Haddock/Backends/LaTeX.hs3
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs2
-rw-r--r--src/Haddock/Convert.hs7
-rw-r--r--src/Haddock/Interface/AttachInstances.hs5
-rw-r--r--src/Haddock/Interface/Rename.hs2
-rw-r--r--src/Haddock/Types.hs6
8 files changed, 105 insertions, 44 deletions
diff --git a/html-test/ref/TypeFamilies2.html b/html-test/ref/TypeFamilies2.html
index 102ebd98..ea982f28 100644
--- a/html-test/ref/TypeFamilies2.html
+++ b/html-test/ref/TypeFamilies2.html
@@ -41,6 +41,30 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
><p class="caption"
>TypeFamilies2</p
></div
+ ><div id="synopsis"
+ ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
+ >Synopsis</p
+ ><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
+ ><li class="src short"
+ ><span class="keyword"
+ >data</span
+ > <a href="#t:W"
+ >W</a
+ ></li
+ ><li class="src short"
+ ><span class="keyword"
+ >type family</span
+ > <a href="#t:Foo"
+ >Foo</a
+ > a</li
+ ><li class="src short"
+ ><span class="keyword"
+ >data family</span
+ > <a href="#t:Bar"
+ >Bar</a
+ > a</li
+ ></ul
+ ></div
><div id="interface"
><h1
>Documentation</h1
@@ -48,13 +72,17 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
><p class="src"
><span class="keyword"
>data</span
- > <a name="t:X" class="def"
- >X</a
+ > <a name="t:W" class="def"
+ >W</a
></p
+ ><div class="doc"
+ ><p
+ >Exported type</p
+ ></div
><div class="subs instances"
- ><p id="control.i:X" class="caption collapser" onclick="toggleSection('i:X')"
+ ><p id="control.i:W" class="caption collapser" onclick="toggleSection('i:W')"
>Instances</p
- ><div id="section.i:X" class="show"
+ ><div id="section.i:W" class="show"
><table
><tr
><td class="src"
@@ -62,13 +90,15 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
>data</span
> <a href="TypeFamilies2.html#t:Bar"
>Bar</a
- > <a href="TypeFamilies2.html#t:X"
- >X</a
+ > <a href="TypeFamilies2.html#t:W"
+ >W</a
> = <a name="v:BarX" class="def"
>BarX</a
- > Y</td
- ><td class="doc empty"
- >&nbsp;</td
+ > Z</td
+ ><td class="doc"
+ ><p
+ >Shown because BarX is still exported despite Z being hidden</p
+ ></td
></tr
><tr
><td class="src"
@@ -76,11 +106,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
>type</span
> <a href="TypeFamilies2.html#t:Foo"
>Foo</a
- > <a href="TypeFamilies2.html#t:X"
- >X</a
- > = Y</td
- ><td class="doc empty"
- >&nbsp;</td
+ > <a href="TypeFamilies2.html#t:W"
+ >W</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Should be visible, but with a hidden right hand side</p
+ ></td
></tr
></table
></div
@@ -93,6 +125,10 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
> <a name="t:Foo" class="def"
>Foo</a
> a</p
+ ><div class="doc"
+ ><p
+ >Exported type family</p
+ ></div
><div class="subs instances"
><p id="control.i:Foo" class="caption collapser" onclick="toggleSection('i:Foo')"
>Instances</p
@@ -104,11 +140,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
>type</span
> <a href="TypeFamilies2.html#t:Foo"
>Foo</a
- > <a href="TypeFamilies2.html#t:X"
- >X</a
- > = Y</td
- ><td class="doc empty"
- >&nbsp;</td
+ > <a href="TypeFamilies2.html#t:W"
+ >W</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Should be visible, but with a hidden right hand side</p
+ ></td
></tr
><tr
><td class="src"
@@ -137,6 +175,10 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
> <a name="t:Bar" class="def"
>Bar</a
> a</p
+ ><div class="doc"
+ ><p
+ >Exported data family</p
+ ></div
><div class="subs instances"
><p id="control.i:Bar" class="caption collapser" onclick="toggleSection('i:Bar')"
>Instances</p
@@ -148,13 +190,15 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies2.html");}
>data</span
> <a href="TypeFamilies2.html#t:Bar"
>Bar</a
- > <a href="TypeFamilies2.html#t:X"
- >X</a
+ > <a href="TypeFamilies2.html#t:W"
+ >W</a
> = <a name="v:BarX" class="def"
>BarX</a
- > Y</td
- ><td class="doc empty"
- >&nbsp;</td
+ > Z</td
+ ><td class="doc"
+ ><p
+ >Shown because BarX is still exported despite Z being hidden</p
+ ></td
></tr
><tr
><td class="src"
diff --git a/html-test/src/TypeFamilies2.hs b/html-test/src/TypeFamilies2.hs
index 34790a51..b66acbfa 100644
--- a/html-test/src/TypeFamilies2.hs
+++ b/html-test/src/TypeFamilies2.hs
@@ -6,18 +6,34 @@
--
-- The other families and instances that are not exported should not
-- show up at all
-module TypeFamilies2 (X, Foo, Bar) where
+module TypeFamilies2 (W, Foo, Bar) where
-data X
-data Y
+-- | Exported type
+data W
+-- | Hidden type
+data Z
+
+-- | Exported type family
type family Foo a
-type instance Foo X = Y
-type instance Foo Y = X -- Should be hidden
+-- | Should be visible, but with a hidden right hand side
+type instance Foo W = Z
+
+-- | Should be hidden
+type instance Foo Z = W
+
+-- | Exported data family
data family Bar a
-data instance Bar X = BarX Y
+-- | Shown because BarX is still exported despite Z being hidden
+data instance Bar W = BarX Z
+
+-- | Should be completely invisible, including instances
type family Invisible a
-type instance Invisible X = Y
-type instance Invisible Y = X
+type instance Invisible W = Z
+type instance Invisible Z = W
+
+data family Invisible2 a
+data instance Invisible2 W = Invis Z
+data instance Invisible2 Z = Invis' W
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 6535b24e..44b3fc35 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -563,7 +563,8 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
ppInstHead :: Bool -> InstHead DocName -> LaTeX
ppInstHead unicode (n, ks, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ks ts unicode
ppInstHead unicode (n, ks, ts, TypeInst rhs) = keyword "type"
- <+> ppAppNameTypes n ks ts unicode <+> equals <+> ppType unicode rhs
+ <+> ppAppNameTypes n ks ts unicode
+ <+> maybe empty (\t -> equals <+> ppType unicode t) rhs
ppInstHead _unicode (_n, _ks, _ts, DataInst _dd) =
error "data instances not supported by --latex yet"
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index c0efa5d0..c1b9032e 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -488,7 +488,7 @@ ppInstances instances baseName unicode qual
<+> ppAppNameTypes n ks ts unicode qual
instHead (n, ks, ts, TypeInst rhs) = keyword "type"
<+> ppAppNameTypes n ks ts unicode qual
- <+> equals <+> ppType unicode qual rhs
+ <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs
instHead (n, ks, ts, DataInst dd) = keyword "data"
<+> ppAppNameTypes n ks ts unicode qual
<+> ppShortDataDecl False True dd unicode qual
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 3670473d..1245b2b9 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -380,13 +380,14 @@ synifyInstHead (_, preds, cls, types) =
where (ks,ts) = break (not . isKind) types
-- Convert a family instance, this could be a type family or data family
-synifyFamInst :: FamInst -> InstHead Name
-synifyFamInst fi =
+synifyFamInst :: FamInst -> Bool -> InstHead Name
+synifyFamInst fi opaque =
( fi_fam fi
, map (unLoc . synifyType WithinType) ks
, map (unLoc . synifyType WithinType) ts
, case fi_flavor fi of
- SynFamilyInst -> TypeInst . unLoc . synifyType WithinType $ fi_rhs fi
+ SynFamilyInst | opaque -> TypeInst Nothing
+ SynFamilyInst -> TypeInst . Just . unLoc . synifyType WithinType $ fi_rhs fi
DataFamilyInst c -> DataInst $ synifyTyCon (Just $ famInstAxiom fi) c
)
where (ks,ts) = break (not . isKind) $ fi_tys fi
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 60ae4661..a0bac8fc 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -70,13 +70,12 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
expItemInstances =
case mb_info of
Just (_, _, cls_instances, fam_instances) ->
- let fam_insts = [ (synifyFamInst i, n)
+ let fam_insts = [ (synifyFamInst i opaque, 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
+ , let opaque = isTypeHidden expInfo (fi_rhs i)
]
cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
| let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a5cde195..4160f4f7 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -264,7 +264,7 @@ renameInstHead (className, k, types, rest) = do
types' <- mapM renameType types
rest' <- case rest of
ClassInst cs -> ClassInst <$> mapM renameType cs
- TypeInst ts -> TypeInst <$> renameType ts
+ TypeInst ts -> TypeInst <$> traverse renameType ts
DataInst dd -> DataInst <$> renameTyClD dd
return (className', k', types', rest')
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 9538f3bf..5930c930 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -291,9 +291,9 @@ instance NamedThing DocName where
-- | The three types of instances
data InstType name
- = ClassInst [HsType name] -- ^ Context
- | TypeInst (HsType name) -- ^ Body (right-hand side)
- | DataInst (TyClDecl name) -- ^ Data constructors
+ = ClassInst [HsType name] -- ^ Context
+ | TypeInst (Maybe (HsType name)) -- ^ Body (right-hand side)
+ | DataInst (TyClDecl name) -- ^ Data constructors
instance OutputableBndr a => Outputable (InstType a) where
ppr (ClassInst a) = text "ClassInst" <+> ppr a
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-21 08:19:32 +0000