[commit: haddock] master: Make hyperlinker respect pretty-printer flag and add documentation. (6bebd57)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/6bebd572bc673d10ed68096f935cdc5a9d1839b5

>---------------------------------------------------------------

commit 6bebd572bc673d10ed68096f935cdc5a9d1839b5
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Tue Jun 30 21:58:08 2015 +0200

    Make hyperlinker respect pretty-printer flag and add documentation.


>---------------------------------------------------------------

6bebd572bc673d10ed68096f935cdc5a9d1839b5
 haddock-api/src/Haddock.hs                      |  2 +-
 haddock-api/src/Haddock/Backends/Hyperlinker.hs | 30 +++++++++++++++++++------
 2 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index c76966f..02e1953 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -321,7 +321,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
                   libDir
 
   when (Flag_HyperlinkedSource `elem` flags) $ do
-    ppHyperlinkedSource odir libDir opt_source_css pkgKey srcMap ifaces
+    ppHyperlinkedSource odir libDir opt_source_css pretty pkgKey srcMap ifaces
 
 -- | From GHC 7.10, this function has a potential to crash with a
 -- nasty message such as @expectJust getPackageDetails@ because
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index f2caa2c..1fadef4 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -14,35 +14,51 @@ import Data.Maybe
 import System.Directory
 import System.FilePath
 
-ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath
-                    -> PackageKey -> SrcMap -> [Interface]
+
+-- | Generate hyperlinked source for given interfaces.
+--
+-- Note that list of interfaces should also contain interfaces normally hidden
+-- when generating documentation. Otherwise this could lead to dead links in
+-- produced source.
+ppHyperlinkedSource :: FilePath -- ^ Output directory
+                    -> FilePath -- ^ Resource directory
+                    -> Maybe FilePath -- ^ Custom CSS file path
+                    -> Bool -- ^ Flag indicating whether to pretty-print HTML
+                    -> PackageKey -- ^ Package for which we create source
+                    -> SrcMap -- ^ Paths to external sources
+                    -> [Interface] -- ^ Interfaces for which we create source
                     -> IO ()
-ppHyperlinkedSource outdir libdir mstyle pkg srcs ifaces = do
+ppHyperlinkedSource outdir libdir mstyle pretty pkg srcs ifaces = do
     createDirectoryIfMissing True srcdir
     let cssFile = fromMaybe (defaultCssFile libdir) mstyle
     copyFile cssFile $ srcdir </> srcCssFile
     copyFile (libdir </> "html" </> highlightScript) $
         srcdir </> highlightScript
-    mapM_ (ppHyperlinkedModuleSource srcdir pkg srcs) ifaces
+    mapM_ (ppHyperlinkedModuleSource srcdir pretty pkg srcs) ifaces
   where
     srcdir = outdir </> hypSrcDir
 
-ppHyperlinkedModuleSource :: FilePath
+-- | Generate hyperlinked source for particular interface.
+ppHyperlinkedModuleSource :: FilePath -> Bool
                           -> PackageKey -> SrcMap -> Interface
                           -> IO ()
-ppHyperlinkedModuleSource srcdir pkg srcs iface =
+ppHyperlinkedModuleSource srcdir pretty pkg srcs iface =
     case ifaceTokenizedSrc iface of
-        Just tokens -> writeFile path . showHtml . render' $ tokens
+        Just tokens -> writeFile path . html . render' $ tokens
         Nothing -> return ()
   where
     render' = render (Just srcCssFile) (Just highlightScript) pkg srcs
+    html = if pretty then renderHtml else showHtml
     path = srcdir </> hypSrcModuleFile (ifaceMod iface)
 
+-- | Name of CSS file in output directory.
 srcCssFile :: FilePath
 srcCssFile = "style.css"
 
+-- | Name of highlight script in output and resource directory.
 highlightScript :: FilePath
 highlightScript = "highlight.js"
 
+-- | Path to default CSS file.
 defaultCssFile :: FilePath -> FilePath
 defaultCssFile libdir = libdir </> "html" </> "solarized.css"