diff --git a/html-test/ref/Bug8.html b/html-test/ref/Bug8.html
index 7e5b5feeb23365539a1af6288d664c5235cfe855..ffbfe0e2248f0393e1124c096352b871fba351ed 100644
--- a/html-test/ref/Bug8.html
+++ b/html-test/ref/Bug8.html
@@ -84,22 +84,28 @@ window.onload = function () {pageLoad();setSynopsis("mini_Bug8.html");};
></div
><div class="top"
><p class="src"
- >infix 9 --><br
- /><a name="v:-45--45--62-" class="def"
+ ><a name="v:-45--45--62-" class="def"
>(-->)</a
- > :: t -> t1 -> <a href=""
+ > :: t -> t1 -> <a href="Bug8.html#t:Typ"
>Typ</a
+ > <span class="fixity"
+ >infix 9</span
+ ><span class="rightedge"
+ ></span
></p
></div
><div class="top"
><p class="src"
- >infix 9 ---><br
- /><a name="v:-45--45--45--62-" class="def"
+ ><a name="v:-45--45--45--62-" class="def"
>(--->)</a
- > :: [a] -> <a href=""
+ > :: [a] -> <a href="Bug8.html#t:Typ"
>Typ</a
- > -> <a href=""
+ > -> <a href="Bug8.html#t:Typ"
>Typ</a
+ > <span class="fixity"
+ >infix 9</span
+ ><span class="rightedge"
+ ></span
></p
></div
><div class="top"
diff --git a/html-test/ref/Operators.html b/html-test/ref/Operators.html
index fdc46aa64d5593a884180d6b754fe3e613380d1a..9c36089492839be335727ee21c03fde29e3fcf19 100644
--- a/html-test/ref/Operators.html
+++ b/html-test/ref/Operators.html
@@ -184,10 +184,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infixr 7 */<br
- /><a name="v:-42--47-" class="def"
+ ><a name="v:-42--47-" class="def"
>(*/)</a
- > :: a -> a -> a</p
+ > :: a -> a -> a <span class="fixity"
+ >infixr 7</span
+ ><span class="rightedge"
+ ></span
+ ></p
><div class="doc"
><p
>Operator with infixr 7</p
@@ -195,10 +198,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infixl 3 `foo`<br
- /><a name="v:foo" class="def"
+ ><a name="v:foo" class="def"
>foo</a
- > :: a -> a -> a</p
+ > :: a -> a -> a <span class="fixity"
+ >infixl 3</span
+ ><span class="rightedge"
+ ></span
+ ></p
><div class="doc"
><p
>Named function with infixl 3</p
@@ -221,13 +227,16 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
><table
><tr
><td class="src"
- >infixl 3 `Bar`<br
- /><a href="Operators.html#t:Foo"
+ ><a href="Operators.html#t:Foo"
>Foo</a
> <a name="v:Bar" class="def"
>`Bar`</a
> <a href="Operators.html#t:Foo"
>Foo</a
+ > <span class="fixity"
+ >infixl 3</span
+ ><span class="rightedge"
+ ></span
></td
><td class="doc"
><p
@@ -236,13 +245,16 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></tr
><tr
><td class="src"
- >infixr 5 :-<br
- /><a href="Operators.html#t:Foo"
+ ><a href="Operators.html#t:Foo"
>Foo</a
> <a name="v::-45-" class="def"
>:-</a
> <a href="Operators.html#t:Foo"
>Foo</a
+ > <span class="fixity"
+ >infixr 5</span
+ ><span class="rightedge"
+ ></span
></td
><td class="doc"
><p
@@ -254,10 +266,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infixr 3 :+<br
- />pattern <a name="v::-43-" class="def"
+ >pattern <a name="v::-43-" class="def"
>(:+)</a
- > t t :: [t]</p
+ > t t :: [t] <span class="fixity"
+ >infixr 3</span
+ ><span class="rightedge"
+ ></span
+ ></p
><div class="doc"
><p
>Pattern synonym, infixr 3</p
@@ -265,13 +280,16 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infixl 6 <-><br
- /><span class="keyword"
+ ><span class="keyword"
>data</span
> a <a name="t:-60--45--62-" class="def"
><-></a
> b <span class="keyword"
>where</span
+ > <span class="fixity"
+ >infixl 6</span
+ ><span class="rightedge"
+ ></span
></p
><div class="doc"
><p
@@ -283,12 +301,15 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
><table
><tr
><td class="src"
- >infixr 6 :<-><br
- /><a name="v::-60--45--62-" class="def"
+ ><a name="v::-60--45--62-" class="def"
>(:<->)</a
> :: a -> b -> a <a href="Operators.html#t:-60--45--62-"
><-></a
- > b</td
+ > b <span class="fixity"
+ >infixr 6</span
+ ><span class="rightedge"
+ ></span
+ ></td
><td class="doc empty"
> </td
></tr
@@ -297,12 +318,15 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infix 3 ++<br
- /><span class="keyword"
+ ><span class="keyword"
>type family</span
> a <a name="t:-43--43-" class="def"
>++</a
- > b</p
+ > b <span class="fixity"
+ >infix 3</span
+ ><span class="rightedge"
+ ></span
+ ></p
><div class="doc"
><p
>Type family with fixity</p
@@ -310,12 +334,15 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infix 9 **<br
- /><span class="keyword"
+ ><span class="keyword"
>data family</span
> a <a name="t:-42--42-" class="def"
>**</a
- > b</p
+ > b <span class="fixity"
+ >infix 9</span
+ ><span class="rightedge"
+ ></span
+ ></p
><div class="doc"
><p
>Data family with fixity</p
@@ -323,13 +350,16 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infixr 1 ><><br
- /><span class="keyword"
+ ><span class="keyword"
>class</span
> a <a name="t:-62--60--62-" class="def"
>><></a
> b <span class="keyword"
>where</span
+ > <span class="fixity"
+ >infixr 1</span
+ ><span class="rightedge"
+ ></span
></p
><div class="doc"
><p
@@ -339,35 +369,43 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
><p class="caption"
>Associated Types</p
><p class="src"
- >infixl 2 <><<br
- /><span class="keyword"
+ ><span class="keyword"
>type</span
> a <a name="t:-60--62--60-" class="def"
><><</a
- > b :: *</p
+ > b :: * <span class="fixity"
+ >infixl 2</span
+ ><span class="rightedge"
+ ></span
+ ></p
><p class="src"
- >infixl 3 ><<<br
- /><span class="keyword"
+ ><span class="keyword"
>data</span
> a <a name="t:-62--60--60-" class="def"
>><<</a
- > b</p
+ > b <span class="fixity"
+ >infixl 3</span
+ ><span class="rightedge"
+ ></span
+ ></p
></div
><div class="subs methods"
><p class="caption"
>Methods</p
><p class="src"
- >infixl 5 <<><br
- />infixr 4 >><<br
- /><a name="v:-62--62--60-" class="def"
+ ><a name="v:-62--62--60-" class="def"
>(>><)</a
>, <a name="v:-60--60--62-" class="def"
>(<<>)</a
- > :: a -> b -> ()</p
+ > :: a -> b -> () <span class="fixity"
+ >infixl 5 <<></span
+ ><span class="fixity"
+ >infixr 4 >><</span
+ ><span class="rightedge"
+ ></span
+ ></p
><p class="src"
- >infixr 8 **>, >**<br
- />infixl 8 <**, **<<br
- /><a name="v:-42--42--62-" class="def"
+ ><a name="v:-42--42--62-" class="def"
>(**>)</a
>, <a name="v:-60--42--42-" class="def"
>(<**)</a
@@ -375,7 +413,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
>(>**)</a
>, <a name="v:-42--42--60-" class="def"
>(**<)</a
- > :: a -> a -> ()</p
+ > :: a -> a -> () <span class="fixity"
+ >infixr 8 **>, >**</span
+ ><span class="fixity"
+ >infixl 8 <**, **<</span
+ ><span class="rightedge"
+ ></span
+ ></p
><div class="doc"
><p
>Multiple fixities</p
@@ -384,14 +428,17 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
></div
><div class="top"
><p class="src"
- >infixl 6 >-<<br
- /><span class="keyword"
+ ><span class="keyword"
>type</span
> <a name="t:-62--45--60-" class="def"
>(>-<)</a
> a b = a <a href="Operators.html#t:-60--45--62-"
><-></a
- > b</p
+ > b <span class="fixity"
+ >infixl 6</span
+ ><span class="rightedge"
+ ></span
+ ></p
><div class="doc"
><p
>Type synonym with fixity</p
diff --git a/resources/html/Ocean.std-theme/ocean.css b/resources/html/Ocean.std-theme/ocean.css
index 3d81c3ca5a5b8d13653fb54dea16e70763d64178..ff4d1b532c9eb4687aeca28dfc808ff1708a6a06 100644
--- a/resources/html/Ocean.std-theme/ocean.css
+++ b/resources/html/Ocean.std-theme/ocean.css
@@ -378,6 +378,19 @@ div#style-menu-holder {
margin: 0 -0.5em 0 0.5em;
}
+#interface span.fixity {
+ color: #919191;
+ border-left: 1px solid #919191;
+ padding: 0.2em 0.5em 0.2em 0.5em;
+ margin: 0 -1em 0 1em;
+}
+
+#interface span.rightedge {
+ border-left: 1px solid #919191;
+ padding: 0.2em 0 0.2em 0;
+ margin: 0 0 0 1em;
+}
+
#interface table { border-spacing: 2px; }
#interface td {
vertical-align: top;
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 42f06280fb78b7c8e85b4d89f56331124e410a0b..c0efa5d0f10d7413237ec24f3638f0ac534b6707 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -88,7 +88,7 @@ ppPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
ppPatSig summary links loc (doc, _argDocs) docname args typ prov req fixities
splice unicode qual
| summary = pref1
- | otherwise = topDeclElem links loc splice [docname] (ppFixities fixities qual <=> pref1)
+ | otherwise = topDeclElem links loc splice [docname] (pref1 <+> ppFixities fixities qual)
+++ docSection qual doc
where
pref1 = hsep [ toHtml "pattern"
@@ -122,7 +122,7 @@ ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ)
occnames = map (nameOccName . getName) docnames
addFixities html
| summary = html
- | otherwise = ppFixities fixities qual <=> html
+ | otherwise = html <+> ppFixities fixities qual
ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName
@@ -160,20 +160,26 @@ 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 uniq_fs
+ppFixities [] _ = noHtml
+ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
where
- ppFix (ns, p, d) = toHtml d <+> toHtml (show p) <+> ppNames ns
+ ppFix (ns, p, d) = thespan ! [theclass "fixity"] <<
+ (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)
+ ppNames = case fs of
+ _:[] -> const noHtml -- Don't display names for fixities on single names
+ _ -> 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 ]
+ rightEdge = thespan ! [theclass "rightedge"] << noHtml
+
ppTyVars :: LHsTyVarBndrs DocName -> [Html]
ppTyVars tvs = map ppTyName (tyvarNames tvs)
@@ -200,7 +206,7 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars
, tcdRhs = ltype })
splice unicode qual
= ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
- (fixs <=> full, fixs <=> hdr, spaceHtml +++ equals)
+ (full <+> fixs, hdr <+> fixs, spaceHtml +++ equals)
splice unicode qual
where
hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
@@ -263,7 +269,7 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode
docname = unLoc $ fdLName decl
header_ = topDeclElem links loc splice [docname] $
- ppFixities fixities qual <=> ppTyFamHeader summary associated decl unicode qual
+ ppTyFamHeader summary associated decl unicode qual <+> ppFixities fixities qual
instancesBit
| FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl
@@ -438,8 +444,8 @@ ppClassDecl summary links instances fixities loc d subdocs
+++ atBit +++ methodBit +++ instancesBit
where
classheader
- | null lsigs = topDeclElem links loc splice [nm] (fixs <=> hdr unicode qual)
- | otherwise = topDeclElem links loc splice [nm] (fixs <=> hdr unicode qual <+> keyword "where")
+ | null lsigs = topDeclElem links loc splice [nm] (hdr unicode qual <+> fixs)
+ | otherwise = topDeclElem links loc splice [nm] (hdr unicode qual <+> keyword "where" <+> fixs)
-- Only the fixity relevant to the class header
fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual
@@ -538,8 +544,8 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
cons = dd_cons (tcdDataDefn dataDecl)
resTy = (con_res . unLoc . head) cons
- header_ = topDeclElem links loc splice [docname] (fix
- <=> ppDataHeader summary dataDecl unicode qual <+> whereBit)
+ header_ = topDeclElem links loc splice [docname] $
+ ppDataHeader summary dataDecl unicode qual <+> whereBit <+> fix
fix = ppFixities (filter (\(n,_) -> n == docname) fixities) qual
@@ -551,7 +557,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
constrBit = subConstructors qual
[ ppSideBySideConstr subdocs subfixs unicode qual c
- | c <- cons
+ | c <- cons
, let subfixs = filter (\(n,_) -> n == unLoc (con_name (unLoc c))) fixities
]
@@ -635,13 +641,15 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
PrefixCon args ->
hsep ((header_ +++ ppBinder False occ)
: map (ppLParendType unicode qual) args)
+ <+> fixity
- RecCon _ -> header_ +++ ppBinder False occ
+ RecCon _ -> header_ +++ ppBinder False occ <+> fixity
InfixCon arg1 arg2 ->
hsep [header_ +++ ppLParendType unicode qual arg1,
ppBinderInfix False occ,
ppLParendType unicode qual arg2]
+ <+> fixity
ResTyGADT resTy -> case con_details con of
-- prefix & infix could also use hsConDeclArgTys if it seemed to
@@ -657,13 +665,13 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
doRecordFields fields = subFields qual
(map (ppSideBySideField subdocs unicode qual) fields)
doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
- doGADTCon args resTy = fixity <=>
- ppBinder False occ <+> dcolon unicode
+ doGADTCon args resTy = ppBinder False occ <+> dcolon unicode
<+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual,
ppLType unicode qual (foldr mkFunTy resTy args) ]
+ <+> fixity
fixity = ppFixities fixities qual
- header_ = fixity <=> ppConstrHdr forall_ tyVars context unicode qual
+ header_ = ppConstrHdr forall_ tyVars context unicode qual
occ = nameOccName . getName . unLoc . con_name $ con
ltvs = con_qvars con
tyVars = tyvarNames (con_qvars con)
@@ -676,7 +684,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
ppSideBySideField :: [(DocName, DocForDecl DocName)] -> Unicode -> Qualification
- -> ConDeclField DocName -> SubDecl
+ -> ConDeclField DocName -> SubDecl
ppSideBySideField subdocs unicode qual (ConDeclField (L _ name) ltype _) =
(ppBinder False (nameOccName . getName $ name) <+> dcolon unicode <+> ppLType unicode qual ltype,
mbDoc,