diff options
| -rw-r--r-- | html/haddock.css | 15 | ||||
| -rw-r--r-- | src/HaddockHtml.hs | 39 |
2 files changed, 35 insertions, 19 deletions
diff --git a/html/haddock.css b/html/haddock.css index aa6e13aa..db10f460 100644 --- a/html/haddock.css +++ b/html/haddock.css @@ -38,6 +38,21 @@ SPAN.keyword { text-decoration: underline; } /* Resize the buttom image to match the text size */ IMG.coll { width : 0.75em; height: 0.75em; margin-bottom: 0; margin-right: 0.5em } +/* --------- Contents page ---------- */ + +DIV.node { + padding-left: 3em; +} + +DIV.cnode { + padding-left: 1.75em; +} + +SPAN.pkg { + position: absolute; + left: 50em; +} + /* --------- Documentation elements ---------- */ TD.children { diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index b02caf5b..9b0f29fd 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -257,35 +257,36 @@ ppPrologue title (Just doc) = ppModuleTree :: String -> [ModuleTree] -> HtmlTable ppModuleTree _ ts = tda [theclass "section1"] << toHtml "Modules" </> - pad_td Nothing << vanillaTable << htmlTable + pad_td Nothing << fst (genTable empty 0 ts) where - genTable htmlTable id [] = (htmlTable,id) - genTable htmlTable id (x:xs) = genTable (htmlTable </> u) id' xs + genTable html id [] = (html,id) + genTable html id (x:xs) = genTable (html +++ u) id' xs where (u,id') = mkNode [] x id - (htmlTable,_) = genTable emptyTable 0 ts - -mkNode :: [String] -> ModuleTree -> Int -> (HtmlTable,Int) +mkNode :: [String] -> ModuleTree -> Int -> (Html,Int) mkNode ss (Node s leaf pkg short ts) id = htmlNode where htmlNode = case ts of - [] -> ( pad_td (Just 1.25) << htmlModule <-> shortDescr <-> htmlPkg,id) - _ -> ((pad_td Nothing<< (collapsebutton id_s +++ htmlModule) <-> shortDescr <-> htmlPkg) </> - (pad_td (Just 2) << sub_tree), id') + [] -> (node << (htmlModule +++ shortDescr +++ htmlPkg), id) + _ -> (cnode << (collapsebutton id_s +++ htmlModule +++ shortDescr + +++ htmlPkg +++ sub_tree), id') + + node = thediv ! [theclass "node"] + cnode = thediv ! [theclass "cnode"] - shortDescr :: HtmlTable + shortDescr :: Html shortDescr = case short of - Nothing -> td empty - Just doc -> tda [theclass "rdoc"] (docToHtml doc) + Nothing -> empty + Just doc -> thespan ! [theclass "rdoc"] << (docToHtml doc) htmlModule | leaf = ppHsModule mdl | otherwise = toHtml s htmlPkg = case pkg of - Nothing -> tda [width "1"] << empty - Just p -> td << toHtml p + Nothing -> empty + Just p -> thespan ! [theclass "pkg"] << toHtml p mdl = foldr (++) "" (s' : map ('.':) ss') (s':ss') = reverse (s:ss) @@ -293,13 +294,13 @@ mkNode ss (Node s leaf pkg short ts) id = htmlNode id_s = "n:" ++ show id - (sub_tree,id') = genSubTree emptyTable (id+1) ts + (sub_tree,id') = genSubTree empty (id+1) ts - genSubTree :: HtmlTable -> Int -> [ModuleTree] -> (Html,Int) - genSubTree htmlTable id [] = (sub_tree,id) + genSubTree :: Html -> Int -> [ModuleTree] -> (Html,Int) + genSubTree html id [] = (sub_tree,id) where - sub_tree = collapsed vanillaTable id_s htmlTable - genSubTree htmlTable id (x:xs) = genSubTree (htmlTable </> u) id' xs + sub_tree = collapsed thediv id_s html + genSubTree html id (x:xs) = genSubTree (html +++ u) id' xs where (u,id') = mkNode (s:ss) x id |