aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorsimonmar <unknown>2002-04-10 15:50:11 +0000
committersimonmar <unknown>2002-04-10 15:50:11 +0000
commit76bd7b3484f8a6353736437f0b7fb0c1cdf199b6 (patch)
treeb046d1f9534160c5703814985b50414ba1731b8d /src
parentcfbaf9f7c17481e3df32e1c1c25e8eb5c06591a6 (diff)
[haddock @ 2002-04-10 15:50:10 by simonmar]
Generate a little table of contents at the top of the module doc (only if the module actually contains some section headings, though).
Diffstat (limited to 'src')
-rw-r--r--src/HaddockHtml.hs45
-rw-r--r--src/HaddockRename.hs4
-rw-r--r--src/HaddockTypes.hs9
-rw-r--r--src/Main.hs4
4 files changed, 51 insertions, 11 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 2ba34af0..daf9732c 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -284,9 +284,9 @@ ifaceToHtml mod iface
| null exports = Html.emptyTable
| otherwise =
td << table ! [width "100%", cellpadding 0, cellspacing 15] <<
- (description </> synopsis </> maybe_hr </> body)
+ (contents </> description </> synopsis </> maybe_hr </> body)
where
- exports = iface_exports iface
+ exports = numberSectionHeadings (iface_exports iface)
doc_map = iface_name_docs iface
has_doc (ExportDecl d)
@@ -295,6 +295,8 @@ ifaceToHtml mod iface
no_doc_at_all = not (any has_doc exports)
+ contents = td << ppModuleContents exports
+
description
| Just doc <- iface_doc iface
= (tda [theclass "section1"] << toHtml "Description") </>
@@ -312,16 +314,49 @@ ifaceToHtml mod iface
aboves (map (processExport doc_map True) exports))
maybe_hr
- | not (no_doc_at_all), ExportGroup 1 _ <- head exports
+ | not (no_doc_at_all), ExportGroup 1 _ _ <- head exports
= td << hr
| otherwise = Html.emptyTable
body = aboves (map (processExport doc_map False) exports)
+ppModuleContents :: [ExportItem] -> HtmlTable
+ppModuleContents exports
+ | null sections = Html.emptyTable
+ | otherwise = tda [theclass "section4"] << bold << toHtml "Contents"
+ </> td << dlist << concatHtml sections
+ where
+ (sections, _leftovers{-should be []-}) = process 0 exports
+
+ process :: Int -> [ExportItem] -> ([Html],[ExportItem])
+ process n [] = ([], [])
+ process n (ExportDecl _ : rest) = process n rest
+ process n items@(ExportGroup lev id doc : rest)
+ | lev <= n = ( [], items )
+ | otherwise = ( html:sections, rest2 )
+ where
+ html = (dterm << anchor ! [href ('#':id)] << markup htmlMarkup doc)
+ +++ mk_subsections subsections
+ (subsections, rest1) = process lev rest
+ (sections, rest2) = process n rest1
+
+ mk_subsections [] = noHtml
+ mk_subsections ss = ddef << dlist << concatHtml ss
+
+-- we need to assign a unique id to each section heading so we can hyperlink
+-- them from the contents:
+numberSectionHeadings :: [ExportItem] -> [ExportItem]
+numberSectionHeadings exports = go 1 exports
+ where go n [] = []
+ go n (ExportGroup lev _ doc : es)
+ = ExportGroup lev (show n) doc : go (n+1) es
+ go n (other:es)
+ = other : go n es
+
processExport :: FiniteMap HsName Doc -> Bool -> ExportItem -> HtmlTable
-processExport doc_map summary (ExportGroup lev doc)
+processExport doc_map summary (ExportGroup lev id doc)
| summary = Html.emptyTable
- | otherwise = ppDocGroup lev (markup htmlMarkup doc)
+ | otherwise = ppDocGroup lev (anchor ! [name id] << markup htmlMarkup doc)
processExport doc_map summary (ExportDecl decl)
= doDecl doc_map summary decl
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index 4c5a631b..d43fb959 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -191,9 +191,9 @@ lookupIdString str = do
renameExportItems items = mapM rn items
where
- rn (ExportGroup lev doc)
+ rn (ExportGroup lev id doc)
= do doc <- renameDoc doc
- return (ExportGroup lev doc)
+ return (ExportGroup lev id doc)
rn (ExportDecl decl)
= do decl <- renameDecl decl
return (ExportDecl decl)
diff --git a/src/HaddockTypes.hs b/src/HaddockTypes.hs
index e13fcb1a..e29d5dae 100644
--- a/src/HaddockTypes.hs
+++ b/src/HaddockTypes.hs
@@ -66,8 +66,13 @@ data Interface
type DocString = String
data ExportItem
- = ExportDecl HsDecl -- a declaration
- | ExportGroup Int Doc -- a section heading
+ = ExportDecl
+ HsDecl -- a declaration
+
+ | ExportGroup -- a section heading
+ Int -- section level (1, 2, 3, ... )
+ String -- section "id" (for hyperlinks)
+ Doc -- section heading text
type ModuleMap = FiniteMap Module Interface
diff --git a/src/Main.hs b/src/Main.hs
index f57d5dd6..796f4939 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -274,7 +274,7 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
= [ ExportDecl (restrictTo (map nameOfQName cs) decl) ]
lookupExport (HsEModuleContents m) = fullContentsOf m
lookupExport (HsEGroup lev str)
- = [ ExportGroup lev doc ]
+ = [ ExportGroup lev "" doc ]
where (doc, _names) = formatDocHeading (lookupForDoc env) str
-- ToDo: report the unresolved names
lookupExport _ = [] -- didn't find it?
@@ -300,7 +300,7 @@ mkExportItems mod_map mod env decl_map decls (Just specs)
fullContentsOfThisModule decls env =
[ mkExportItem decl | decl <- decls, keepDecl decl ]
where mkExportItem (HsDocGroup lev str) =
- ExportGroup lev doc
+ ExportGroup lev "" doc
where
(doc, _names) = formatDocHeading (lookupForDoc env) str
-- ToDo: report the unresolved names