aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--html-test/ref/TypeFamilies.html304
-rw-r--r--html-test/src/TypeFamilies.hs16
-rw-r--r--resources/html/Ocean.std-theme/ocean.css7
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs16
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs8
5 files changed, 251 insertions, 100 deletions
diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html
index d1d54571..355d9248 100644
--- a/html-test/ref/TypeFamilies.html
+++ b/html-test/ref/TypeFamilies.html
@@ -81,6 +81,22 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
></li
><li class="src short"
><span class="keyword"
+ >data</span
+ > <a href=""
+ >Z</a
+ ><ul class="subs"
+ ><li
+ >= <a href=""
+ >ZA</a
+ ></li
+ ><li
+ >| <a href=""
+ >ZB</a
+ ></li
+ ></ul
+ ></li
+ ><li class="src short"
+ ><span class="keyword"
>class</span
> <a href=""
>Test</a
@@ -253,17 +269,47 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><span class="keyword"
>data</span
> <a href=""
- >Bat</a
+ >AssocD</a
+ > * <a href=""
+ >X</a
+ > = <a name="v:AssocX" class="def"
+ >AssocX</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href=""
+ >AssocT</a
+ > * <a href=""
+ >X</a
+ > = <a href=""
+ >Foo</a
+ > * <a href=""
+ >X</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
> <a href=""
+ >Bat</a
+ > * <a href=""
>X</a
- > <ul class="subs"
- ><li
+ > <ul class="inst"
+ ><li class="inst"
>= <a name="v:BatX" class="def"
>BatX</a
> <a href=""
>X</a
></li
- ><li
+ ><li class="inst"
>| <a name="v:BatXX" class="def"
>BatXX</a
> { <ul class="subs"
@@ -291,36 +337,6 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><tr
><td class="src"
><span class="keyword"
- >data</span
- > <a href=""
- >AssocD</a
- > * <a href=""
- >X</a
- > = <a name="v:AssocX" class="def"
- >AssocX</a
- ></td
- ><td class="doc empty"
- >&nbsp;</td
- ></tr
- ><tr
- ><td class="src"
- ><span class="keyword"
- >type</span
- > <a href=""
- >AssocT</a
- > * <a href=""
- >X</a
- > = <a href=""
- >Foo</a
- > * <a href=""
- >X</a
- ></td
- ><td class="doc empty"
- >&nbsp;</td
- ></tr
- ><tr
- ><td class="src"
- ><span class="keyword"
>type</span
> <a href=""
>Foo</a
@@ -427,36 +443,6 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><span class="keyword"
>data</span
> <a href=""
- >Bat</a
- > <a href=""
- >Y</a
- > <ul class="subs"
- ><li
- >= <a name="v:BatY" class="def"
- >BatY</a
- > <a href=""
- >Y</a
- ></li
- ><li
- >| <a href=""
- >X</a
- > <a name="v::-43-" class="def"
- >:+</a
- > <a href=""
- >X</a
- ></li
- ></ul
- ></td
- ><td class="doc"
- ><p
- >Doc for: data instance Bat Y</p
- ></td
- ></tr
- ><tr
- ><td class="src"
- ><span class="keyword"
- >data</span
- > <a href=""
>AssocD</a
> * <a href=""
>Y</a
@@ -476,7 +462,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
>Y</a
> = <a href=""
>Bat</a
- > <a href=""
+ > * <a href=""
>Y</a
></td
><td class="doc empty"
@@ -485,6 +471,24 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><tr
><td class="src"
><span class="keyword"
+ >data</span
+ > <a href=""
+ >Bat</a
+ > * <a href=""
+ >Y</a
+ > = <a name="v:BatY" class="def"
+ >BatY</a
+ > <a href=""
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: data instance Bat Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
>type</span
> <a href=""
>Foo</a
@@ -517,6 +521,102 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><div class="top"
><p class="src"
><span class="keyword"
+ >data</span
+ > <a name="t:Z" class="def"
+ >Z</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Doc for: data Z</p
+ ></div
+ ><div class="subs constructors"
+ ><p class="caption"
+ >Constructors</p
+ ><table
+ ><tr
+ ><td class="src"
+ ><a name="v:ZA" class="def"
+ >ZA</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a name="v:ZB" class="def"
+ >ZB</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ></table
+ ></div
+ ><div class="subs instances"
+ ><p id="control.i:Z" class="caption collapser" onclick="toggleSection('i:Z')"
+ >Instances</p
+ ><div id="section.i:Z" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href=""
+ >Bat</a
+ > <a href=""
+ >Z</a
+ > <span class="keyword"
+ >where</span
+ ><ul class="inst"
+ ><li class="inst"
+ ><a name="v:BatZ1" class="def"
+ >BatZ1</a
+ > :: <a href=""
+ >Z</a
+ > -&gt; <a href=""
+ >Bat</a
+ > <a href=""
+ >Z</a
+ > <a href=""
+ >ZA</a
+ ></li
+ ><li class="inst"
+ ><a name="v:BatZ2" class="def"
+ >BatZ2</a
+ > :: { <ul class="subs"
+ ><li
+ ><a name="v:batx" class="def"
+ >batx</a
+ > :: <a href=""
+ >X</a
+ ></li
+ ><li
+ ><a name="v:baty" class="def"
+ >baty</a
+ > :: <a href=""
+ >Y</a
+ ></li
+ ></ul
+ > } -&gt; <a href=""
+ >Bat</a
+ > <a href=""
+ >Z</a
+ > <a href=""
+ >ZB</a
+ ></li
+ ></ul
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: data instance Bat Z</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
>class</span
> <a name="t:Test" class="def"
>Test</a
@@ -633,27 +733,51 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
> <a href=""
>Bat</a
> <a href=""
- >Y</a
- > <ul class="subs"
- ><li
- >= <a name="v:BatY" class="def"
- >BatY</a
+ >Z</a
+ > <span class="keyword"
+ >where</span
+ ><ul class="inst"
+ ><li class="inst"
+ ><a name="v:BatZ1" class="def"
+ >BatZ1</a
+ > :: <a href=""
+ >Z</a
+ > -&gt; <a href=""
+ >Bat</a
+ > <a href=""
+ >Z</a
> <a href=""
- >Y</a
+ >ZA</a
></li
- ><li
- >| <a href=""
- >X</a
- > <a name="v::-43-" class="def"
- >:+</a
+ ><li class="inst"
+ ><a name="v:BatZ2" class="def"
+ >BatZ2</a
+ > :: { <ul class="subs"
+ ><li
+ ><a name="v:batx" class="def"
+ >batx</a
+ > :: <a href=""
+ >X</a
+ ></li
+ ><li
+ ><a name="v:baty" class="def"
+ >baty</a
+ > :: <a href=""
+ >Y</a
+ ></li
+ ></ul
+ > } -&gt; <a href=""
+ >Bat</a
> <a href=""
- >X</a
+ >Z</a
+ > <a href=""
+ >ZB</a
></li
></ul
></td
><td class="doc"
><p
- >Doc for: data instance Bat Y</p
+ >Doc for: data instance Bat Z</p
></td
></tr
><tr
@@ -662,16 +786,34 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
>data</span
> <a href=""
>Bat</a
+ > * <a href=""
+ >Y</a
+ > = <a name="v:BatY" class="def"
+ >BatY</a
> <a href=""
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: data instance Bat Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href=""
+ >Bat</a
+ > * <a href=""
>X</a
- > <ul class="subs"
- ><li
+ > <ul class="inst"
+ ><li class="inst"
>= <a name="v:BatX" class="def"
>BatX</a
> <a href=""
>X</a
></li
- ><li
+ ><li class="inst"
>| <a name="v:BatXX" class="def"
>BatXX</a
> { <ul class="subs"
diff --git a/html-test/src/TypeFamilies.hs b/html-test/src/TypeFamilies.hs
index 5cd4480e..a79d503e 100644
--- a/html-test/src/TypeFamilies.hs
+++ b/html-test/src/TypeFamilies.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, UndecidableInstances, PolyKinds, TypeOperators, DataKinds, MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances, PolyKinds, TypeOperators, DataKinds, MultiParamTypeClasses, GADTs #-}
-- | Doc for: module TypeFamilies
module TypeFamilies where
@@ -14,6 +14,9 @@ data X
-- | Doc for: data Y
data Y
+-- | Doc for: data Z
+data Z = ZA | ZB
+
-- | Doc for: class Test a
class Test a
@@ -31,7 +34,7 @@ type instance Foo X = Y
type instance Foo Y = X
-- | Doc for: data family Bat a
-data family Bat a :: *
+data family Bat (a :: k) :: *
-- | Doc for: data instance Bat X
data instance Bat X
@@ -39,9 +42,12 @@ data instance Bat X
| BatXX { aaa :: X , bbb :: Y } -- ^ Doc for: BatXX { ... }
-- | Doc for: data instance Bat Y
-data instance Bat Y
- = BatY Y -- ^ Doc for: BatY Y
- | X :+ X -- X :+ X
+data instance Bat Y = BatY Y -- ^ Doc for: BatY Y
+
+-- | Doc for: data instance Bat Z
+data instance Bat (z :: Z) where
+ BatZ1 :: Z -> Bat ZA
+ BatZ2 :: { batx :: X, baty :: Y } -> Bat ZB
-- | Doc for: class Assoc a
class Assoc a where
diff --git a/resources/html/Ocean.std-theme/ocean.css b/resources/html/Ocean.std-theme/ocean.css
index ff4d1b53..de436324 100644
--- a/resources/html/Ocean.std-theme/ocean.css
+++ b/resources/html/Ocean.std-theme/ocean.css
@@ -433,19 +433,18 @@ div#style-menu-holder {
margin: 0;
}
-.subs ul {
+/* Render short-style data instances */
+.inst ul {
height: 100%;
padding: 0.5em;
margin: 0;
}
-.subs ul,
-.subs ul li.src {
+.inst, .inst li {
list-style: none;
margin-left: 1em;
}
-
.top p.src {
border-top: 1px solid #ccc;
}
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 67185bff..2dc1e0e7 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -410,7 +410,7 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
if not (any isVanillaLSig sigs) && null ats
then (if summary then id else topDeclElem links loc splice [nm]) hdr
else (if summary then id else topDeclElem links loc splice [nm]) (hdr <+> keyword "where")
- +++ shortSubDecls
+ +++ shortSubDecls False
(
[ ppAssocType summary links doc at [] splice unicode qual | at <- ats
, let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ] ++
@@ -532,14 +532,14 @@ ppShortDataDecl summary dataInst dataDecl unicode qual
| [] <- cons = dataHeader
| [lcon] <- cons, ResTyH98 <- resTy,
- (cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode qual
+ (cHead,cBody,cFoot) <- ppShortConstrParts summary dataInst (unLoc lcon) unicode qual
= (dataHeader <+> equals <+> cHead) +++ cBody +++ cFoot
| ResTyH98 <- resTy = dataHeader
- +++ shortSubDecls (zipWith doConstr ('=':repeat '|') cons)
+ +++ shortSubDecls dataInst (zipWith doConstr ('=':repeat '|') cons)
| otherwise = (dataHeader <+> keyword "where")
- +++ shortSubDecls (map doGADTConstr cons)
+ +++ shortSubDecls dataInst (map doGADTConstr cons)
where
dataHeader
@@ -591,13 +591,13 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
ppShortConstr :: Bool -> ConDecl DocName -> Unicode -> Qualification -> Html
ppShortConstr summary con unicode qual = cHead <+> cBody <+> cFoot
where
- (cHead,cBody,cFoot) = ppShortConstrParts summary con unicode qual
+ (cHead,cBody,cFoot) = ppShortConstrParts summary False con unicode qual
-- returns three pieces: header, body, footer so that header & footer can be
-- incorporated into the declaration
-ppShortConstrParts :: Bool -> ConDecl DocName -> Unicode -> Qualification -> (Html, Html, Html)
-ppShortConstrParts summary con unicode qual = case con_res con of
+ppShortConstrParts :: Bool -> Bool -> ConDecl DocName -> Unicode -> Qualification -> (Html, Html, Html)
+ppShortConstrParts summary dataInst con unicode qual = case con_res con of
ResTyH98 -> case con_details con of
PrefixCon args ->
(header_ unicode qual +++ hsep (ppBinder summary occ
@@ -626,7 +626,7 @@ ppShortConstrParts summary con unicode qual = case con_res con of
InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml)
where
- doRecordFields fields = shortSubDecls (map (ppShortField summary unicode qual) fields)
+ doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) fields)
doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
ppForAll forall_ ltvs lcontext unicode qual,
ppLType unicode qual (foldr mkFunTy resTy args) ]
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index d3d94424..e84a57b3 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -104,8 +104,12 @@ shortDeclList :: [Html] -> Html
shortDeclList items = ulist << map (li ! [theclass "src short"] <<) items
-shortSubDecls :: [Html] -> Html
-shortSubDecls items = ulist ! [theclass "subs"] << map (li <<) items
+shortSubDecls :: Bool -> [Html] -> Html
+shortSubDecls inst items = ulist ! [theclass c] << map (i <<) items
+ where i | inst = li ! [theclass "inst"]
+ | otherwise = li
+ c | inst = "inst"
+ | otherwise = "subs"
divTopDecl :: Html -> Html
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-27 09:16:59 +0000