[Enable framed view of the HTML documentation. Thomas Schilling **20081024170408 This patch introduces: - A page that displays the documentation in a framed view. The left side will show a full module index. Clicking a module name will show it in the right frame. If Javascript is enabled, the left side is split again to show the modules at the top and a very short synopsis for the module currently displayed on the right. - Code to generate the mini-synopsis for each module and the mini module index ("index-frames.html"). - CSS rules for the mini-synopsis. - A very small amount of javascript to update the mini-synopsis (but only if inside a frame.) Some perhaps controversial things: - Sharing code was very difficult, so there is a small amount of code duplication. - The amount of generated pages has been doubled, since every module now also gets a mini-synopsis. The overhead should not be too much, but I haven't checked. Alternatively, the mini-synopsis could also be generated using Javascript if we properly annotate the actual synopsis. ] { hunk ./haddock.cabal 59 + html/frames.html addfile ./html/frames.html hunk ./html/frames.html 1 + + + + + + + + + + + + + + + hunk ./html/haddock-util.js 135 +function setSynopsis(filename) { + if (parent.window.synopsis) { + parent.window.synopsis.location = filename; + } +} + hunk ./html/haddock.css 7 + padding: 0 0; hunk ./html/haddock.css 269 +/* --------- Mini Synopsis for Frame View --------- */ + +.outer { + margin: 0 0; + padding: 0 0; +} + +.mini-synopsis { + padding: 0.25em 0.25em; +} + +.mini-synopsis H1 { font-size: 130%; } +.mini-synopsis H2 { font-size: 110%; } +.mini-synopsis H3 { font-size: 100%; } +.mini-synopsis H1, .mini-synopsis H2, .mini-synopsis H3 { + margin-top: 0.5em; + margin-bottom: 0.25em; + padding: 0 0; +} + +.mini-synopsis H1 { border-bottom: 1px solid #ccc; } + +.mini-topbar { + font-size: 130%; + background: #0077dd; + padding: 0.25em; +} + + hunk ./src/Haddock/Backends/Html.hs 32 -import Data.List ( sortBy ) +import Data.List ( sortBy, groupBy ) hunk ./src/Haddock/Backends/Html.hs 38 +import Data.Function +import Data.Ord ( comparing ) hunk ./src/Haddock/Backends/Html.hs 81 - hunk ./src/Haddock/Backends/Html.hs 150 - mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ] + mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile, framesFile ] hunk ./src/Haddock/Backends/Html.hs 335 + + -- XXX: think of a better place for this? + ppHtmlContentsFrame odir doctitle ifaces hunk ./src/Haddock/Backends/Html.hs 419 +-- | Turn a module tree into a flat list of full module names. E.g., +-- @ +-- A +-- +-B +-- +-C +-- @ +-- becomes +-- @["A", "A.B", "A.B.C"]@ +flatModuleTree :: [InstalledInterface] -> [Html] +flatModuleTree ifaces = + map (uncurry ppModule' . head) + . groupBy ((==) `on` fst) + . sortBy (comparing fst) + $ mods + where + mods = [ (moduleString mod, mod) | mod <- map instMod ifaces ] + ppModule' txt mod = + anchor ! [href ((moduleHtmlFile mod)), target mainFrameName] + << toHtml txt + +ppHtmlContentsFrame odir doctitle ifaces = do + let mods = flatModuleTree ifaces + html = + header + (documentCharacterEncoding +++ + thetitle (toHtml doctitle) +++ + styleSheet +++ + (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ + body << vanillaTable << p << ( + foldr (+++) noHtml (map (+++br) mods)) + writeFile (pathJoin [odir, frameIndexHtmlFile]) (renderHtml html) hunk ./src/Haddock/Backends/Html.hs 572 - (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ + (script ! [src jsFile, thetype "text/javascript"] $ noHtml) +++ + (script ! [thetype "text/javascript"] + -- XXX: quoting errors possible? + << Html [HtmlString ("window.onload = function () {setSynopsis(\"mini_" + ++ moduleHtmlFile mod ++ "\")};")]) + ) +++ hunk ./src/Haddock/Backends/Html.hs 586 + ppHtmlModuleMiniSynopsis odir doctitle iface hunk ./src/Haddock/Backends/Html.hs 588 +ppHtmlModuleMiniSynopsis :: FilePath -> String -> Interface -> IO () +ppHtmlModuleMiniSynopsis odir _doctitle iface = do + let mod = ifaceMod iface + html = + header + (documentCharacterEncoding +++ + thetitle (toHtml $ moduleString mod) +++ + styleSheet +++ + (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ + body << thediv ! [ theclass "outer" ] << ( + (thediv ! [theclass "mini-topbar"] + << toHtml (moduleString mod)) +++ + miniSynopsis mod iface) + writeFile (pathJoin [odir, "mini_" ++ moduleHtmlFile mod]) (renderHtml html) hunk ./src/Haddock/Backends/Html.hs 650 +miniSynopsis :: Module -> Interface -> Html +miniSynopsis mod iface = + thediv ! [ theclass "mini-synopsis" ] + << hsep (map (processForMiniSynopsis mod) $ exports) + + where + exports = numberSectionHeadings (ifaceRnExportItems iface) + +processForMiniSynopsis :: Module -> ExportItem DocName -> Html +processForMiniSynopsis mod (ExportDecl (L _loc decl0) _doc _insts) = + thediv ! [theclass "decl" ] << + case decl0 of + TyClD d@(TyFamily{}) -> ppTyFamHeader True False d + TyClD d@(TyData{tcdTyPats = ps}) + | Nothing <- ps -> keyword "data" <++> ppTyClBinderWithVarsMini mod d + | Just _ <- ps -> keyword "data" <++> keyword "instance" + <++> ppTyClBinderWithVarsMini mod d + TyClD d@(TySynonym{tcdTyPats = ps}) + | Nothing <- ps -> keyword "type" <++> ppTyClBinderWithVarsMini mod d + | Just _ <- ps -> keyword "type" <++> keyword "instance" + <++> ppTyClBinderWithVarsMini mod d + TyClD d@(ClassDecl {}) -> + keyword "class" <++> ppTyClBinderWithVarsMini mod d + SigD (TypeSig (L _ n) (L _ t)) -> + let nm = docNameOcc n + in ppNameMini mod nm + _ -> noHtml +processForMiniSynopsis mod (ExportGroup lvl _id txt) = + let heading | lvl == 1 = h1 + | lvl == 2 = h2 + | lvl >= 3 = h3 + in heading << docToHtml txt +processForMiniSynopsis _ _ = noHtml + +ppNameMini :: Module -> OccName -> Html +ppNameMini mod nm = + anchor ! [ href ( moduleHtmlFile mod ++ "#" + ++ (escapeStr (anchorNameStr nm))) + , target mainFrameName ] + << ppBinder' nm + +ppTyClBinderWithVarsMini :: Module -> TyClDecl DocName -> Html +ppTyClBinderWithVarsMini mod decl = + let n = unLoc $ tcdLName decl + ns = tyvarNames $ tcdTyVars decl + in ppTypeApp n ns (ppNameMini mod . docNameOcc) ppTyName hunk ./src/Haddock/Backends/Html.hs 1646 -infixr 8 <+> +infixr 8 <+>, <++> hunk ./src/Haddock/Backends/Html.hs 1650 +(<++>) :: Html -> Html -> Html +a <++> b = a +++ spaceHtml +++ b + hunk ./src/Haddock/Utils.hs 20 - contentsHtmlFile, indexHtmlFile, subIndexHtmlFile, pathJoin, + contentsHtmlFile, indexHtmlFile, + frameIndexHtmlFile, + moduleIndexFrameName, mainFrameName, synopsisFrameName, + subIndexHtmlFile, pathJoin, hunk ./src/Haddock/Utils.hs 25 - cssFile, iconFile, jsFile, plusFile, minusFile, + cssFile, iconFile, jsFile, plusFile, minusFile, framesFile, hunk ./src/Haddock/Utils.hs 201 +-- | The name of the module index file to be displayed inside a frame. +-- Modules are display in full, but without indentation. Clicking opens in +-- the main window. +frameIndexHtmlFile :: String +frameIndexHtmlFile = "index-frames.html" + +moduleIndexFrameName, mainFrameName, synopsisFrameName :: String +moduleIndexFrameName = "modules" +mainFrameName = "main" +synopsisFrameName = "synopsis" + hunk ./src/Haddock/Utils.hs 233 -cssFile, iconFile, jsFile, plusFile,minusFile :: String +cssFile, iconFile, jsFile, plusFile, minusFile, framesFile :: String hunk ./src/Haddock/Utils.hs 239 +framesFile = "frames.html" }