diff options
author | Niklas Haas <git@nand.wakku.to> | 2014-03-15 15:17:18 +0100 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2014-03-15 18:20:26 +0000 |
commit | 82ab2c09c19641e0ea89965c9af291043798486d (patch) | |
tree | a00a780248c46867d5a6f1483501874521377241 | |
parent | 48f45676f7c6c79b249b51dde9a6791393860676 (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.html | 304 | ||||
-rw-r--r-- | html-test/src/TypeFamilies.hs | 16 | ||||
-rw-r--r-- | resources/html/Ocean.std-theme/ocean.css | 7 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 16 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 8 |
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" + > </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" + > </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" - > </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" - > </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" + > </td + ></tr + ><tr + ><td class="src" + ><a name="v:ZB" class="def" + >ZB</a + ></td + ><td class="doc empty" + > </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 + > -> <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 + > } -> <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 + > -> <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 + > } -> <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 |