diff options
-rw-r--r-- | html/xhaddock.css | 20 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 23 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 17 |
3 files changed, 16 insertions, 44 deletions
diff --git a/html/xhaddock.css b/html/xhaddock.css index e0a4922a..731eee8a 100644 --- a/html/xhaddock.css +++ b/html/xhaddock.css @@ -296,29 +296,11 @@ p.arg span { float: none; } -p.inst-header { - font-weight: bold; - margin-bottom: 0; -} -p.inst-header img { +img.coll { width : 0.75em; height: 0.75em; margin-bottom: 0; margin-right: 0.5em } -ul.int { - margin-top: 1em; - margin-bottom: 1em; -} -ul.inst li { - background-color: #f0f0f0; - font-family: monospace; - vertical-align: top; - margin-top: 1px; - margin-bottom: 1px; - padding: 2px; - margin-left: 20px; - list-style-type: none; -} td.arg { padding: 3px; diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index f5aa4fcf..6e0c5601 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -392,26 +392,13 @@ ppClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortCl ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Html ppInstances instances baseName unicode - | null instances = noHtml - | otherwise = - instHdr instId +++ - collapsed thediv instId ( - spacedTable1 << aboves (map (ppDocInstance unicode) instances) - ) + = subInstances instId (map instDecl instances) where instId = collapseId (getName baseName) - --- | Print a possibly commented instance. The instance header is printed inside --- an 'argBox'. The comment is printed to the right of the box in normal comment --- style. -ppDocInstance :: Bool -> DocInstance DocName -> HtmlTable -ppDocInstance unicode (instHead, maybeDoc) = - argBox (ppInstHead unicode instHead) <-> maybeRDocBox maybeDoc - - -ppInstHead :: Bool -> InstHead DocName -> Html -ppInstHead unicode ([], n, ts) = ppAppNameTypes n ts unicode -ppInstHead unicode (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode + instDecl :: DocInstance DocName -> SubDecl + instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, []) + instHead ([], n, ts) = ppAppNameTypes n ts unicode + instHead (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode lookupAnySubdoc :: (Eq name1) => diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index 440d8e1e..70f5d88c 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -21,11 +21,13 @@ module Haddock.Backends.Xhtml.Layout ( SubDecl, subArguments, - subConstructors, subFields, + subConstructors, + subFields, + subInstances, topDeclElem, declElem, - instHdr, atHdr, methHdr, + atHdr, methHdr, argBox, ndocBox, rdocBox, maybeRDocBox, vanillaTable, vanillaTable2, spacedTable1, spacedTable5 @@ -70,7 +72,7 @@ divTopDecl = thediv ! [theclass "top"] type SubDecl = (Html, Maybe (Doc DocName), [Html]) -divSubDecls :: String -> String -> Maybe Html -> Html +divSubDecls :: (HTML a) => String -> a -> Maybe Html -> Html divSubDecls cssClass captionName = maybe noHtml wrap where wrap = (subSection <<) . (subCaption +++) @@ -109,6 +111,11 @@ subConstructors = divSubDecls "constructors" "Constructors" . subTable subFields :: [(Html, Maybe (Doc DocName), [Html])] -> Html subFields = divSubDecls "fields" "Fields" . subTable +subInstances :: String -> [(Html, Maybe (Doc DocName), [Html])] -> Html +subInstances id_ = divSubDecls "instances" instCaption . instTable + where + instCaption = collapsebutton id_ +++ " Instances" + instTable = (collapsed thediv id_ `fmap`) . subTable -- a box for displaying code declElem :: Html -> Html @@ -178,7 +185,3 @@ spacedTable5 = table ! [theclass "vanilla", cellspacing 5, cellpadding 0] methHdr, atHdr :: Html methHdr = h5 << "Methods" atHdr = h5 << "Associated Types" - -instHdr :: String -> Html -instHdr id_ = - h5 << (collapsebutton id_ +++ toHtml " Instances") |