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.
---
 src/Haddock/Backends/Xhtml/Decl.hs   | 16 ++++++++--------
 src/Haddock/Backends/Xhtml/Layout.hs |  8 ++++++--
 2 files changed, 14 insertions(+), 10 deletions(-)

(limited to 'src')

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