aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Haddock/Backends/Xhtml.hs44
-rw-r--r--src/Haddock/Backends/Xhtml/Utils.hs7
-rw-r--r--src/Haddock/Options.hs5
-rw-r--r--src/Main.hs8
4 files changed, 37 insertions, 27 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 3e127f31..272f54d0 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -66,12 +66,13 @@ ppHtml :: String
-> Maybe String -- the index URL (--use-index)
-> Bool -- whether to use unicode in output (--use-unicode)
-> Qualification -- how to qualify names
+ -> Bool -- output pretty html (newlines and indenting)
-> IO ()
ppHtml doctitle maybe_package ifaces odir prologue
themes maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url unicode
- qual = do
+ qual debug = do
let
visible_ifaces = filter visible ifaces
visible i = OptHide `notElem` ifaceOptions i
@@ -82,15 +83,16 @@ ppHtml doctitle maybe_package ifaces odir prologue
(map toInstalledIface visible_ifaces)
False -- we don't want to display the packages in a single-package contents
prologue
+ debug
when (isNothing maybe_index_url) $
ppHtmlIndex odir doctitle maybe_package
themes maybe_contents_url maybe_source_url maybe_wiki_url
- (map toInstalledIface visible_ifaces)
+ (map toInstalledIface visible_ifaces) debug
mapM_ (ppHtmlModule odir doctitle themes
maybe_source_url maybe_wiki_url
- maybe_contents_url maybe_index_url unicode qual) visible_ifaces
+ maybe_contents_url maybe_index_url unicode qual debug) visible_ifaces
copyHtmlBits :: FilePath -> FilePath -> Themes -> IO ()
@@ -219,10 +221,11 @@ ppHtmlContents
-> SourceURLs
-> WikiURLs
-> [InstalledInterface] -> Bool -> Maybe (Doc GHC.RdrName)
+ -> Bool
-> IO ()
ppHtmlContents odir doctitle _maybe_package
themes maybe_index_url
- maybe_source_url maybe_wiki_url ifaces showPkgs prologue = do
+ maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug = do
let tree = mkModuleTree showPkgs
[(instMod iface, toInstalledDescription iface) | iface <- ifaces]
html =
@@ -234,10 +237,10 @@ ppHtmlContents odir doctitle _maybe_package
ppModuleTree tree
]
createDirectoryIfMissing True odir
- writeFile (joinPath [odir, contentsHtmlFile]) (renderToString html)
+ writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
-- XXX: think of a better place for this?
- ppHtmlContentsFrame odir doctitle themes ifaces
+ ppHtmlContentsFrame odir doctitle themes ifaces debug
ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> Html
@@ -311,8 +314,8 @@ flatModuleTree ifaces =
ppHtmlContentsFrame :: FilePath -> String -> Themes
- -> [InstalledInterface] -> IO ()
-ppHtmlContentsFrame odir doctitle themes ifaces = do
+ -> [InstalledInterface] -> Bool -> IO ()
+ppHtmlContentsFrame odir doctitle themes ifaces debug = do
let mods = flatModuleTree ifaces
html =
headHtml doctitle Nothing themes +++
@@ -320,7 +323,7 @@ ppHtmlContentsFrame odir doctitle themes ifaces = do
(sectionName << "Modules" +++
ulist << [ li ! [theclass "module"] << m | m <- mods ])
createDirectoryIfMissing True odir
- writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString html)
+ writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString debug html)
--------------------------------------------------------------------------------
@@ -336,9 +339,10 @@ ppHtmlIndex :: FilePath
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
+ -> Bool
-> IO ()
ppHtmlIndex odir doctitle _maybe_package themes
- maybe_contents_url maybe_source_url maybe_wiki_url ifaces = do
+ maybe_contents_url maybe_source_url maybe_wiki_url ifaces debug = do
let html = indexPage split_indices Nothing
(if split_indices then [] else index)
@@ -348,9 +352,9 @@ ppHtmlIndex odir doctitle _maybe_package themes
mapM_ (do_sub_index index) initialChars
-- Let's add a single large index as well for those who don't know exactly what they're looking for:
let mergedhtml = indexPage False Nothing index
- writeFile (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString mergedhtml)
+ writeFile (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString debug mergedhtml)
- writeFile (joinPath [odir, indexHtmlFile]) (renderToString html)
+ writeFile (joinPath [odir, indexHtmlFile]) (renderToString debug html)
where
indexPage showLetters ch items =
@@ -391,7 +395,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
do_sub_index this_ix c
= unless (null index_part) $
- writeFile (joinPath [odir, subIndexHtmlFile [c]]) (renderToString html)
+ writeFile (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html)
where
html = indexPage True (Just c) index_part
index_part = [(n,stuff) | (n,stuff) <- this_ix, toUpper (head n) == c]
@@ -454,10 +458,10 @@ ppHtmlModule
:: FilePath -> String -> Themes
-> SourceURLs -> WikiURLs
-> Maybe String -> Maybe String -> Bool -> Qualification
- -> Interface -> IO ()
+ -> Bool -> Interface -> IO ()
ppHtmlModule odir doctitle themes
maybe_source_url maybe_wiki_url
- maybe_contents_url maybe_index_url unicode qual iface = do
+ maybe_contents_url maybe_index_url unicode qual debug iface = do
let
mdl = ifaceMod iface
mdl_str = moduleString mdl
@@ -475,13 +479,13 @@ ppHtmlModule odir doctitle themes
]
createDirectoryIfMissing True odir
- writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString html)
- ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode qual
+ writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
+ ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode qual debug
ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
- -> Interface -> Bool -> Qualification -> IO ()
-ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode qual = do
+ -> Interface -> Bool -> Qualification -> Bool -> IO ()
+ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode qual debug = do
let mdl = ifaceMod iface
html =
headHtml (moduleString mdl) Nothing themes +++
@@ -489,7 +493,7 @@ ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode qual = do
(divModuleHeader << sectionName << moduleString mdl +++
miniSynopsis mdl iface unicode qual)
createDirectoryIfMissing True odir
- writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString html)
+ writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString debug html)
ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Qualification -> Html
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index 3fd461fd..c250f5eb 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -85,9 +85,10 @@ spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url
run (c:rest) = c : run rest
-renderToString :: Html -> String
-renderToString = showHtml -- for production
---renderToString = prettyHtml -- for debugging
+renderToString :: Bool -> Html -> String
+renderToString debug html
+ | debug = renderHtml html
+ | otherwise = showHtml html
hsep :: [Html] -> Html
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index f9c86811..8e6c9ba9 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -77,6 +77,7 @@ data Flag
| Flag_UseUnicode
| Flag_NoTmpCompDir
| Flag_Qualification String
+ | Flag_PrettyHtml
deriving (Eq)
@@ -153,7 +154,9 @@ options backwardsCompat =
"output GHC lib dir",
Option ['w'] ["no-warnings"] (NoArg Flag_NoWarnings) "turn off all warnings",
Option [] ["no-tmp-comp-dir"] (NoArg Flag_NoTmpCompDir)
- "do not re-direct compilation output to a temporary directory"
+ "do not re-direct compilation output to a temporary directory",
+ Option [] ["pretty-html"] (NoArg Flag_PrettyHtml)
+ "generate html with newlines and indenting (for use with --html)"
]
diff --git a/src/Main.hs b/src/Main.hs
index 472f56b7..9d056efe 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -30,7 +30,7 @@ import Haddock.Version
import Haddock.InterfaceFile
import Haddock.Options
import Haddock.Utils
-import Haddock.GhcUtils
+import Haddock.GhcUtils hiding (pretty)
import Control.Monad
import Control.Exception
@@ -190,6 +190,7 @@ render flags ifaces installedIfaces srcMap = do
let
title = fromMaybe "" (optTitle flags)
unicode = Flag_UseUnicode `elem` flags
+ pretty = Flag_PrettyHtml `elem` flags
opt_wiki_urls = wikiUrls flags
opt_contents_url = optContentsUrl flags
opt_index_url = optIndexUrl flags
@@ -219,13 +220,13 @@ render flags ifaces installedIfaces srcMap = do
when (Flag_GenIndex `elem` flags) $ do
ppHtmlIndex odir title pkgStr
themes opt_contents_url sourceUrls' opt_wiki_urls
- allVisibleIfaces
+ allVisibleIfaces pretty
copyHtmlBits odir libDir themes
when (Flag_GenContents `elem` flags) $ do
ppHtmlContents odir title pkgStr
themes opt_index_url sourceUrls' opt_wiki_urls
- allVisibleIfaces True prologue
+ allVisibleIfaces True prologue pretty
copyHtmlBits odir libDir themes
when (Flag_Html `elem` flags) $ do
@@ -233,6 +234,7 @@ render flags ifaces installedIfaces srcMap = do
prologue
themes sourceUrls' opt_wiki_urls
opt_contents_url opt_index_url unicode opt_qualification
+ pretty
copyHtmlBits odir libDir themes
when (Flag_Hoogle `elem` flags) $ do
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 12:31:54 +0000