Add a flag --pretty-html for rendering indented html with newlines

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