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/Haddock/Backends/Xhtml')
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