aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-30 21:58:08 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-06-30 22:37:50 +0200
commit6bebd572bc673d10ed68096f935cdc5a9d1839b5 (patch)
tree312af718d2f9289c276b3ce5b2aa80a6dd09941d
parent7d269444ea9c55a2b364ead45fe06d435fa078b2 (diff)
Make hyperlinker respect pretty-printer flag and add documentation.
-rw-r--r--haddock-api/src/Haddock.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs30
2 files changed, 24 insertions, 8 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index c76966fc..02e19531 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 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"