Update appearance of fixity annotations

This moves them in-line with their corresponding lines, similar to a
presentation envision by @hvr and described in #ghc.

Redundant operator names are also omitted when no ambiguity is present.

4 files changed, 141 insertions, 67 deletions

diff --git a/html-test/ref/Bug8.html b/html-test/ref/Bug8.html
index 7e5b5fee..ffbfe0e2 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 --&gt;<br
-	     /><a name="v:-45--45--62-" class="def"
+	  ><a name="v:-45--45--62-" class="def"
 	    >(--&gt;)</a
-	    > ::  t -&gt; t1 -&gt; <a href=""
+	    > ::  t -&gt; t1 -&gt; <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 ---&gt;<br
-	     /><a name="v:-45--45--45--62-" class="def"
+	  ><a name="v:-45--45--45--62-" class="def"
 	    >(---&gt;)</a
-	    > ::  [a] -&gt; <a href=""
+	    > ::  [a] -&gt; <a href="Bug8.html#t:Typ"
 	    >Typ</a
-	    > -&gt; <a href=""
+	    > -&gt; <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 fdc46aa6..9c360894 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 -&gt; a -&gt; a</p
+	    > ::  a -&gt; a -&gt; 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 -&gt; a -&gt; a</p
+	    > ::  a -&gt; a -&gt; 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 &lt;-&gt;<br
-	     /><span class="keyword"
+	  ><span class="keyword"
 	    >data</span
 	    > a <a name="t:-60--45--62-" class="def"
 	    >&lt;-&gt;</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 :&lt;-&gt;<br
-		   /><a name="v::-60--45--62-" class="def"
+		><a name="v::-60--45--62-" class="def"
 		  >(:&lt;-&gt;)</a
 		  > ::  a -&gt; b -&gt; a <a href="Operators.html#t:-60--45--62-"
 		  >&lt;-&gt;</a
-		  > b</td
+		  > b <span class="fixity"
+		  >infixr 6</span
+		  ><span class="rightedge"
+		  ></span
+		  ></td
 		><td class="doc empty"
 		>&nbsp;</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 &gt;&lt;&gt;<br
-	     /><span class="keyword"
+	  ><span class="keyword"
 	    >class</span
 	    > a <a name="t:-62--60--62-" class="def"
 	    >&gt;&lt;&gt;</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 &lt;&gt;&lt;<br
-	       /><span class="keyword"
+	    ><span class="keyword"
 	      >type</span
 	      > a <a name="t:-60--62--60-" class="def"
 	      >&lt;&gt;&lt;</a
-	      > b :: *</p
+	      > b :: * <span class="fixity"
+	      >infixl 2</span
+	      ><span class="rightedge"
+	      ></span
+	      ></p
 	    ><p class="src"
-	    >infixl 3 &gt;&lt;&lt;<br
-	       /><span class="keyword"
+	    ><span class="keyword"
 	      >data</span
 	      > a <a name="t:-62--60--60-" class="def"
 	      >&gt;&lt;&lt;</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 &lt;&lt;&gt;<br
-	       />infixr 4 &gt;&gt;&lt;<br
-	       /><a name="v:-62--62--60-" class="def"
+	    ><a name="v:-62--62--60-" class="def"
 	      >(&gt;&gt;&lt;)</a
 	      >, <a name="v:-60--60--62-" class="def"
 	      >(&lt;&lt;&gt;)</a
-	      > :: a -&gt; b -&gt; ()</p
+	      > :: a -&gt; b -&gt; () <span class="fixity"
+	      >infixl 5 &lt;&lt;&gt;</span
+	      ><span class="fixity"
+	      >infixr 4 &gt;&gt;&lt;</span
+	      ><span class="rightedge"
+	      ></span
+	      ></p
 	    ><p class="src"
-	    >infixr 8 **&gt;, &gt;**<br
-	       />infixl 8 &lt;**, **&lt;<br
-	       /><a name="v:-42--42--62-" class="def"
+	    ><a name="v:-42--42--62-" class="def"
 	      >(**&gt;)</a
 	      >, <a name="v:-60--42--42-" class="def"
 	      >(&lt;**)</a
@@ -375,7 +413,13 @@ window.onload = function () {pageLoad();setSynopsis("mini_Operators.html");};
 	      >(&gt;**)</a
 	      >, <a name="v:-42--42--60-" class="def"
 	      >(**&lt;)</a
-	      > :: a -&gt; a -&gt; ()</p
+	      > :: a -&gt; a -&gt; () <span class="fixity"
+	      >infixr 8 **&gt;, &gt;**</span
+	      ><span class="fixity"
+	      >infixl 8 &lt;**, **&lt;</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 &gt;-&lt;<br
-	     /><span class="keyword"
+	  ><span class="keyword"
 	    >type</span
 	    > <a name="t:-62--45--60-" class="def"
 	    >(&gt;-&lt;)</a
 	    > a b = a <a href="Operators.html#t:-60--45--62-"
 	    >&lt;-&gt;</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 3d81c3ca..ff4d1b53 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 42f06280..c0efa5d0 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,