From 73b3db92d61711375ee11ccb39e2575929141563 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Sat, 17 Jul 2010 06:17:53 +0000
Subject: factored out head element generation
---
src/Haddock/Backends/Xhtml.hs | 58 ++++++++++++++++----------------------
src/Haddock/Backends/Xhtml/Util.hs | 4 ---
2 files changed, 25 insertions(+), 37 deletions(-)
(limited to 'src/Haddock')
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 743e95df..a21379e4 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -153,6 +153,26 @@ copyHtmlBits odir libdir _maybe_css = do
mapM_ copyLibFile cssFiles
mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile, framesFile ]
+
+headHtml :: String -> Maybe String -> Html
+headHtml docTitle miniPage =
+ header << [
+ meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"],
+ thetitle << docTitle,
+ styleSheet,
+ script ! [src jsFile, thetype "text/javascript"] << noHtml,
+ script ! [thetype "text/javascript"]
+ -- NB: Within XHTML, the content of script tags needs to be
+ -- a <![CDATA[ section. Will break if the miniPage name could
+ -- have "]]>" in it!
+ << primHtml (
+ "//<![CDATA[\nwindow.onload = function () {resetStyle();"
+ ++ setSynopsis ++ "};\n//]]>\n")
+ ]
+ where
+ setSynopsis = maybe "" (\p -> "setSynopsis(\"" ++ p ++ "\");") miniPage
+
+
footer :: Html
footer =
divFooter << paragraph << (
@@ -265,11 +285,7 @@ ppHtmlContents odir doctitle
let tree = mkModuleTree showPkgs
[(instMod iface, toInstalledDescription iface) | iface <- ifaces]
html =
- header
- (documentCharacterEncoding +++
- thetitle (toHtml doctitle) +++
- styleSheet +++
- (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+ headHtml doctitle Nothing +++
body << (
simpleHeader doctitle Nothing maybe_index_url
maybe_source_url maybe_wiki_url +++
@@ -354,11 +370,7 @@ ppHtmlContentsFrame :: FilePath -> String -> [InstalledInterface] -> IO ()
ppHtmlContentsFrame odir doctitle ifaces = do
let mods = flatModuleTree ifaces
html =
- header
- (documentCharacterEncoding +++
- thetitle (toHtml doctitle) +++
- styleSheet +++
- (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+ headHtml doctitle Nothing +++
miniBody << divModuleList <<
(sectionName << "Modules" +++
ulist << [ li ! [theclass "module"] << m | m <- mods ])
@@ -399,11 +411,7 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
where
indexPage showLetters ch items =
- header (documentCharacterEncoding +++
- thetitle (toHtml (doctitle ++ " (" ++ indexName ch ++ ")")) +++
- styleSheet +++
- (script ! [src jsFile, thetype "text/javascript"] $ noHtml)
- ) +++
+ headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing +++
body <<
(simpleHeader doctitle maybe_contents_url Nothing
maybe_source_url maybe_wiki_url +++
@@ -507,19 +515,7 @@ ppHtmlModule odir doctitle
mdl = ifaceMod iface
mdl_str = moduleString mdl
html =
- header (documentCharacterEncoding +++
- thetitle (toHtml mdl_str) +++
- styleSheet +++
- (script ! [src jsFile, thetype "text/javascript"] $ noHtml) +++
- (script ! [thetype "text/javascript"]
- -- NB: Within XHTML, the content of script tags needs to be
- -- a CDATA section. Will break if the generated name could
- -- have "]]>" in it!
- << primHtml (
- "//<![CDATA[\nwindow.onload = function () {setSynopsis(\"mini_"
- ++ moduleHtmlFile mdl ++ "\")};\n//]]>\n")
- )
- ) +++
+ headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) +++
body << (
pageHeader mdl_str iface doctitle
maybe_source_url maybe_wiki_url
@@ -535,11 +531,7 @@ ppHtmlModuleMiniSynopsis :: FilePath -> String -> Interface -> Bool -> IO ()
ppHtmlModuleMiniSynopsis odir _doctitle iface unicode = do
let mdl = ifaceMod iface
html =
- header
- (documentCharacterEncoding +++
- thetitle (toHtml $ moduleString mdl) +++
- styleSheet +++
- (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++
+ headHtml (moduleString mdl) Nothing +++
miniBody <<
(divModuleHeader << sectionName << moduleString mdl +++
miniSynopsis mdl iface unicode)
diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index bbd2814c..1fcf5e94 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -25,7 +25,6 @@ module Haddock.Backends.Xhtml.Util (
hsep,
collapsebutton, collapseId,
- documentCharacterEncoding,
cssFiles, styleSheet, stylePickers, styleMenu
) where
@@ -191,9 +190,6 @@ collapsebutton id_ =
collapseId :: Name -> String
collapseId nm = "i:" ++ escapeStr (getOccString nm)
-documentCharacterEncoding :: Html
-documentCharacterEncoding =
- meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"]
-- Standard set of style sheets, first is the preferred
cssThemes :: [(String, String)]
--
cgit v1.2.3