From 16c666804946a08870926f25205117104625b72e Mon Sep 17 00:00:00 2001 From: Mark Lentczner Date: Tue, 13 Jul 2010 05:26:21 +0000 Subject: change to new page structure --- src/Haddock/Backends/Xhtml.hs | 59 ++++++++++++++++++++---------------- src/Haddock/Backends/Xhtml/Layout.hs | 36 +++++++++++++++++++++- src/Haddock/Backends/Xhtml/Util.hs | 7 ++++- 3 files changed, 74 insertions(+), 28 deletions(-) (limited to 'src') 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 +++ '`' -- cgit v1.2.3