From 6bebd572bc673d10ed68096f935cdc5a9d1839b5 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 30 Jun 2015 21:58:08 +0200
Subject: Make hyperlinker respect pretty-printer flag and add documentation.
---
haddock-api/src/Haddock/Backends/Hyperlinker.hs | 30 +++++++++++++++++++------
1 file changed, 23 insertions(+), 7 deletions(-)
(limited to 'haddock-api/src/Haddock')
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index f2caa2c1..1fadef49 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"
--
cgit v1.2.3