aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/Xhtml.hs59
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs36
-rw-r--r--src/Haddock/Backends/Xhtml/Util.hs7
3 files changed, 74 insertions, 28 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index c8a64ece..dc24acbd 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -152,7 +152,7 @@ copyHtmlBits odir libdir maybe_css = do
footer :: Html
footer =
- thediv ! [theclass "bottom"] << paragraph << (
+ divFooter << paragraph << (
"Produced by " +++
(anchor ! [href projectUrl] << toHtml projectName) +++
(" version " ++ projectVersion)
@@ -194,8 +194,8 @@ simpleHeader :: String -> Maybe String -> Maybe String
-> SourceURLs -> WikiURLs -> Html
simpleHeader doctitle maybe_contents_url maybe_index_url
maybe_source_url maybe_wiki_url =
- thediv ! [theclass "package-header"] << (
- paragraph ! [theclass "caption"] << doctitle +++
+ divPackageHeader << (
+ sectionName << nonEmpty doctitle +++
unordList (catMaybes [
srcButton maybe_source_url Nothing,
wikiButton maybe_wiki_url Nothing,
@@ -210,8 +210,8 @@ pageHeader :: String -> Interface -> String
pageHeader mdl iface doctitle
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url =
- thediv ! [theclass "package-header"] << (
- paragraph ! [theclass "caption"] << (doctitle +++ spaceHtml) +++
+ divPackageHeader << (
+ sectionName << nonEmpty doctitle +++
unordList (catMaybes [
srcButton maybe_source_url (Just iface),
wikiButton maybe_wiki_url (Just $ ifaceMod iface),
@@ -219,8 +219,8 @@ pageHeader mdl iface doctitle
indexButton maybe_index_url
]) ! [theclass "links"]
) +++
- thediv ! [theclass "module-header"] << (
- paragraph ! [theclass "caption"] << mdl +++
+ divModuleHeader << (
+ sectionName << mdl +++
moduleInfo iface
)
@@ -606,8 +606,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
= ppModuleContents exports +++
description +++
synopsis +++
- maybe_doc_hdr +++
- bdy
+ divInterface (maybe_doc_hdr +++ bdy)
where
exports = numberSectionHeadings (ifaceRnExportItems iface)
@@ -623,16 +622,18 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
description
= case ifaceRnDoc iface of
Nothing -> noHtml
- Just doc -> h1 << toHtml "Description" +++ docToHtml doc
+ Just doc -> divDescription $
+ sectionName << "Description" +++ docToHtml doc
-- omit the synopsis if there are no documentation annotations at all
synopsis
| no_doc_at_all = noHtml
| otherwise
- = h1 << "Synopsis" +++
- unordList (
- mapMaybe (processExport True linksInfo unicode) exports
- ) ! [theclass "synopsis"]
+ = divSynposis $
+ sectionName << "Synopsis" +++
+ shortDeclList (
+ mapMaybe (processExport True linksInfo unicode) exports
+ )
-- if the documentation doesn't begin with a section header, then
-- add one ("Documentation").
@@ -644,8 +645,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
bdy =
foldr (+++) noHtml $
- map (thediv ! [theclass "decldoc"]) $
- mapMaybe (processExport False linksInfo unicode) exports
+ mapMaybe (processExport False linksInfo unicode) exports
linksInfo = (maybe_source_url, maybe_wiki_url)
@@ -702,8 +702,8 @@ ppModuleContents exports
| null sections = noHtml
| otherwise = contentsDiv
where
- contentsDiv = thediv ! [theclass "table-of-contents"] << (
- paragraph ! [theclass "caption"] << "Contents" +++
+ contentsDiv = divTableOfContents << (
+ sectionName << "Contents" +++
unordList sections)
(sections, _leftovers{-should be []-}) = process 0 exports
@@ -737,20 +737,28 @@ processExport :: Bool -> LinksInfo -> Bool -> (ExportItem DocName) -> Maybe Html
processExport summary _ _ (ExportGroup lev id0 doc)
= nothingIf summary $ groupTag lev << namedAnchor id0 << docToHtml doc
processExport summary links unicode (ExportDecl decl doc subdocs insts)
- = Just $ ppDecl summary links decl doc insts subdocs unicode
-processExport _ _ _ (ExportNoDecl y [])
- = Just $ ppDocName y
-processExport _ _ _ (ExportNoDecl y subs)
- = Just $ ppDocName y +++ parenList (map ppDocName subs)
+ = processDecl summary $ ppDecl summary links decl doc insts subdocs unicode
+processExport summary _ _ (ExportNoDecl y [])
+ = processDeclOneLiner summary $ ppDocName y
+processExport summary _ _ (ExportNoDecl y subs)
+ = processDeclOneLiner summary $ ppDocName y +++ parenList (map ppDocName subs)
processExport summary _ _ (ExportDoc doc)
= nothingIf summary $ docToHtml doc
-processExport _ _ _ (ExportModule mdl)
- = Just $ toHtml "module" <+> ppModule mdl ""
+processExport summary _ _ (ExportModule mdl)
+ = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl ""
nothingIf :: Bool -> a -> Maybe a
nothingIf True _ = Nothing
nothingIf False a = Just a
+processDecl :: Bool -> Html -> Maybe Html
+processDecl True = Just
+processDecl False = Just . divTopDecl
+
+processDeclOneLiner :: Bool -> Html -> Maybe Html
+processDeclOneLiner True = Just
+processDeclOneLiner False = Just . divTopDecl . declElem
+
groupTag :: Int -> Html -> Html
groupTag lev
| lev == 1 = h1
@@ -760,4 +768,3 @@ groupTag lev
-
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index ac6f5021..86c722b7 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -11,6 +11,14 @@
-- Portability : portable
-----------------------------------------------------------------------------
module Haddock.Backends.Xhtml.Layout (
+ divPackageHeader, divModuleHeader, divFooter,
+ divTableOfContents, divDescription, divSynposis, divInterface,
+
+ sectionName,
+
+ shortDeclList,
+ divTopDecl,
+
topDeclElem, declElem,
instHdr, atHdr, methHdr, constrHdr,
@@ -29,10 +37,36 @@ import Text.XHtml hiding ( name, title, p, quote )
import FastString ( unpackFS )
import GHC
+-- Sections of the document
+
+divPackageHeader, divModuleHeader, divFooter :: Html -> Html
+divPackageHeader = thediv ! [identifier "package-header"]
+divModuleHeader = thediv ! [identifier "module-header"]
+divFooter = thediv ! [identifier "footer"]
+
+divTableOfContents, divDescription, divSynposis, divInterface :: Html -> Html
+divTableOfContents = thediv ! [identifier "table-of-contents"]
+divDescription = thediv ! [identifier "description"]
+divSynposis = thediv ! [identifier "synopsis"]
+divInterface = thediv ! [identifier "interface"]
+
+-- | The name of a section, used directly after opening a section
+sectionName :: Html -> Html
+sectionName = paragraph ! [theclass "caption"]
+
+
+-- | Declaration containers
+
+shortDeclList :: [Html] -> Html
+shortDeclList items = ulist << map (li ! [theclass "src short"] <<) items
+
+divTopDecl :: Html -> Html
+divTopDecl = thediv ! [theclass "top"]
+
-- a box for displaying code
declElem :: Html -> Html
-declElem = paragraph ! [theclass "decl"]
+declElem = paragraph ! [theclass "src"]
-- a box for top level documented names
-- it adds a source and wiki link at the right hand side of the box
diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index 9e13acd6..826b69f1 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -16,7 +16,7 @@ module Haddock.Backends.Xhtml.Util (
namedAnchor, linkedAnchor,
spliceURL,
- (<+>), char, empty,
+ (<+>), char, empty, nonEmpty,
keyword, punctuate,
braces, brackets, pabrackets, parens, parenList, ubxParenList,
@@ -110,6 +110,11 @@ char c = toHtml [c]
empty :: Html
empty = noHtml
+-- | ensure content contains at least something (a non-breaking space)
+nonEmpty :: (HTML a) => a -> Html
+nonEmpty a = if isNoHtml h then spaceHtml else h
+ where h = toHtml a
+
quote :: Html -> Html
quote h = char '`' +++ h +++ '`'
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 00:11:38 +0000