diff options
| -rw-r--r-- | html-test/ref/Bug8.html | 20 | ||||
| -rw-r--r-- | html-test/ref/Operators.html | 133 | ||||
| -rw-r--r-- | resources/html/Ocean.std-theme/ocean.css | 13 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 42 |
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 --><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 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 -> 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 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, |