From 6bebd572bc673d10ed68096f935cdc5a9d1839b5 Mon Sep 17 00:00:00 2001 From: Ɓukasz Hanuszczak Date: Tue, 30 Jun 2015 21:58:08 +0200 Subject: Make hyperlinker respect pretty-printer flag and add documentation. --- 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 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" -- cgit v1.2.3