aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs23
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs17
2 files changed, 15 insertions, 25 deletions
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")