From 96053cafb4530a2459c2644b95c70baf57fd7eb1 Mon Sep 17 00:00:00 2001
From: David Waern <davve@dtek.chalmers.se>
Date: Sat, 8 Dec 2007 15:46:26 +0000
Subject: Handle class operators correctly when rendering predicates

---
 src/Haddock/Backends/Html.hs | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

(limited to 'src/Haddock')

diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 0aa6d85e..a7204d1a 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -750,6 +750,9 @@ ppTyName name
 ppTyNames = map ppTyName
 
 
+ppLTypes = hsep . map ppLType
+
+
 --------------------------------------------------------------------------------
 -- Contexts 
 --------------------------------------------------------------------------------
@@ -774,12 +777,23 @@ pp_hs_context cxt = parenList (map ppPred cxt)
 
 ppLPred = ppPred . unLoc
 
-ppPred (HsClassP n ts) = ppDocName n <+> hsep (map ppLType ts)
+
+ppPred (HsClassP n ts)
+  | classOp, length ts > 2 = firstApp <+> ppLTypes rest
+  | classOp = firstApp
+  | otherwise = ppDocName n <+> ppLTypes ts
+  where
+   classOp = isNameConSym . getName $ n
+   t1:t2:rest = ts
+   firstApp = ppLType t1 <+> ppDocName n <+> ppLType t2
+
+
 -- TODO: find out what happened to the Dupable/Linear distinction
 ppPred (HsEqualP t1 t2) = ppLType t1 <+> toHtml "~" <+> ppLType t2
 ppPred (HsIParam (IPName n) t) 
   = toHtml "?" +++ ppDocName n <+> dcolon <+> ppLType t
 
+
 -- -----------------------------------------------------------------------------
 -- Class declarations
 
-- 
cgit v1.2.3