diff options
-rw-r--r-- | html-test/ref/TypeFamilies2.html | 92 | ||||
-rw-r--r-- | html-test/src/TypeFamilies2.hs | 32 | ||||
-rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 3 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 2 | ||||
-rw-r--r-- | src/Haddock/Convert.hs | 7 | ||||
-rw-r--r-- | src/Haddock/Interface/AttachInstances.hs | 5 | ||||
-rw-r--r-- | src/Haddock/Interface/Rename.hs | 2 | ||||
-rw-r--r-- | src/Haddock/Types.hs | 6 |
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" - > </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" - > </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" - > </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" - > </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 |