From 82ab2c09c19641e0ea89965c9af291043798486d Mon Sep 17 00:00:00 2001
From: Niklas Haas <git@nand.wakku.to>
Date: Sat, 15 Mar 2014 15:17:18 +0100
Subject: 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.
---
 html-test/ref/TypeFamilies.html          | 304 +++++++++++++++++++++++--------
 html-test/src/TypeFamilies.hs            |  16 +-
 resources/html/Ocean.std-theme/ocean.css |   7 +-
 src/Haddock/Backends/Xhtml/Decl.hs       |  16 +-
 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
@@ -80,6 +80,22 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 	    >Y</a
 	    ></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=""
@@ -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"
@@ -289,36 +335,6 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    ></td
 		  ></tr
 		><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
@@ -423,36 +439,6 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		  >&nbsp;</td
 		  ></tr
 		><tr
-		><td class="src"
-		  ><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
@@ -476,13 +462,31 @@ 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"
 		  >&nbsp;</td
 		  ></tr
 		><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
@@ -515,6 +519,102 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 	    ></div
 	  ></div
 	><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
@@ -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
-- 
cgit v1.2.3