diff options
| -rw-r--r-- | html-test/ref/Operators.html | 33 | ||||
| -rw-r--r-- | html-test/src/Operators.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 13 |
3 files changed, 51 insertions, 5 deletions
diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html index 89ebbbbf..fdc46aa6 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 a2e30c18..f7b4d0ab 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 5cc86d48..42f06280 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) |