diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html
index 89ebbbbfd4dca7c7abf01b7fa3146d8cdd6dbf5b..fdc46aa64d5593a884180d6b754fe3e613380d1a 100644
--- a/html-test/ref/Operators.html
+++ b/html-test/ref/Operators.html
@@ -144,7 +144,19 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
><li
><a href="#v:-62--62--60-"
>(>><)</a
+ >, <a href="#v:-60--60--62-"
+ >(<<>)</a
> :: a -> b -> ()</li
+ ><li
+ ><a href="#v:-42--42--62-"
+ >(**>)</a
+ >, <a href="#v:-60--42--42-"
+ >(<**)</a
+ >, <a href="#v:-62--42--42-"
+ >(>**)</a
+ >, <a href="#v:-42--42--60-"
+ >(**<)</a
+ > :: a -> a -> ()</li
></ul
></li
><li class="src short"
@@ -345,10 +357,29 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
><p class="caption"
>Methods</p
><p class="src"
- >infixr 4 >><<br
+ >infixl 5 <<><br
+ />infixr 4 >><<br
/><a name="v:-62--62--60-" class="def"
>(>><)</a
+ >, <a name="v:-60--60--62-" class="def"
+ >(<<>)</a
> :: a -> b -> ()</p
+ ><p class="src"
+ >infixr 8 **>, >**<br
+ />infixl 8 <**, **<<br
+ /><a name="v:-42--42--62-" class="def"
+ >(**>)</a
+ >, <a name="v:-60--42--42-" class="def"
+ >(<**)</a
+ >, <a name="v:-62--42--42-" class="def"
+ >(>**)</a
+ >, <a name="v:-42--42--60-" class="def"
+ >(**<)</a
+ > :: a -> a -> ()</p
+ ><div class="doc"
+ ><p
+ >Multiple fixities</p
+ ></div
></div
></div
><div class="top"
diff --git a/html-test/src/Operators.hs b/html-test/src/Operators.hs
index a2e30c1890a678b26eb31fc4b63da94fbc791df9..f7b4d0ab14059e4d546ecacbd67343d3593ec71e 100644
--- a/html-test/src/Operators.hs
+++ b/html-test/src/Operators.hs
@@ -45,11 +45,19 @@ infix 9 **
class a ><> b where
type a <>< b :: *
data a ><< b
- (>><) :: a -> b -> ()
+ (>><), (<<>) :: a -> b -> ()
+
+ -- | Multiple fixities
+ (**>), (**<), (>**), (<**) :: a -> a -> ()
+
infixr 1 ><>
infixl 2 <><
infixl 3 ><<
infixr 4 >><
+infixl 5 <<>
+
+infixr 8 **>, >**
+infixl 8 **<, <**
-- | Type synonym with fixity
type (a >-< b) = a <-> b
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 5cc86d48fc335d72b40a82bed24baabffeccc0ba..42f06280fb78b7c8e85b4d89f56331124e410a0b 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TransformListComp #-}
-----------------------------------------------------------------------------
-- |
-- Module : Haddock.Backends.Html.Decl
@@ -34,6 +35,7 @@ import Data.Monoid ( mempty )
import Text.XHtml hiding ( name, title, p, quote )
import GHC
+import GHC.Exts
import Name
@@ -158,15 +160,20 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
= [(leader <+> ppType unicode qual t, argDoc n, [])]
ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
-ppFixities fs qual = vcat $ map ppFix fs
+ppFixities fs qual = vcat $ map ppFix uniq_fs
where
- ppFix (n, Fixity p d) = toHtml (ppDir d) <+> toHtml (show p)
- <+> ppDocName qual Infix False n
+ ppFix (ns, p, d) = toHtml d <+> toHtml (show p) <+> ppNames ns
ppDir InfixR = "infixr"
ppDir InfixL = "infixl"
ppDir InfixN = "infix"
+ ppNames = concatHtml . intersperse (stringToHtml ", ") . map (ppDocName qual Infix False)
+
+ uniq_fs = [ (n, the p, the d') | (n, Fixity p d) <- fs
+ , let d' = ppDir d
+ , then group by Down (p,d') using groupWith ]
+
ppTyVars :: LHsTyVarBndrs DocName -> [Html]
ppTyVars tvs = map ppTyName (tyvarNames tvs)