aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNiklas Haas <git@nand.wakku.to>2014-03-15 15:17:18 +0100
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-03-15 18:20:26 +0000
commit82ab2c09c19641e0ea89965c9af291043798486d (patch)
treea00a780248c46867d5a6f1483501874521377241
parent48f45676f7c6c79b249b51dde9a6791393860676 (diff)
Fix issue #281
This is a regression from the data family instances change. Data instances are now distinguished from regular lists by usage of the new class "inst", and the style has been updated to only apply to those. I've also updated the appropriate test case to test this a bit better, including GADT instances with GADT-style records.
-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