From 6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Mon, 22 Jun 2015 17:20:37 +0200
Subject: Add support for providing custom CSS files for hyperlinked source.
---
haddock-api/src/Haddock/Backends/Hyperlinker.hs | 26 +++++++++++++++++++------
haddock-api/src/Haddock/Options.hs | 6 ++++++
2 files changed, 26 insertions(+), 6 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 88619474..66392a67 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -5,21 +5,35 @@ import Haddock.Backends.Hyperlinker.Renderer
import GHC
import Text.XHtml hiding ((</>))
+
+import Data.Maybe
import System.Directory
import System.FilePath
ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath -> [Interface]
-> IO ()
ppHyperlinkedSource outdir libdir mstyle ifaces = do
- createDirectoryIfMissing True (outdir </> "src")
- mapM_ (ppHyperlinkedModuleSource outdir mstyle) ifaces
+ createDirectoryIfMissing True $ srcPath outdir
+ let cssFile = fromMaybe (defaultCssFile libdir) mstyle
+ copyFile cssFile $ srcPath outdir </> srcCssFile
+ mapM_ (ppHyperlinkedModuleSource outdir) ifaces
-ppHyperlinkedModuleSource :: FilePath -> Maybe FilePath -> Interface -> IO ()
-ppHyperlinkedModuleSource outdir mstyle iface = case ifaceTokenizedSrc iface of
- Just tokens -> writeFile path $ showHtml . render mstyle $ tokens
+ppHyperlinkedModuleSource :: FilePath -> Interface -> IO ()
+ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of
+ Just tokens -> writeFile path $ showHtml . render mSrcCssFile $ tokens
Nothing -> return ()
where
- path = outdir </> "src" </> moduleSourceFile (ifaceMod iface)
+ mSrcCssFile = Just $ srcCssFile
+ path = srcPath outdir </> moduleSourceFile (ifaceMod iface)
moduleSourceFile :: Module -> FilePath
moduleSourceFile = (++ ".html") . moduleNameString . moduleName
+
+srcPath :: FilePath -> FilePath
+srcPath outdir = outdir </> "src"
+
+srcCssFile :: FilePath
+srcCssFile = "style.css"
+
+defaultCssFile :: FilePath -> FilePath
+defaultCssFile libdir = libdir </> "html" </> "solarized.css"
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index c9d5688c..f84989ef 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -21,6 +21,7 @@ module Haddock.Options (
optContentsUrl,
optIndexUrl,
optCssFile,
+ optSourceCssFile,
sourceUrls,
wikiUrls,
optDumpInterfaceFile,
@@ -67,6 +68,7 @@ data Flag
| Flag_LaTeX
| Flag_LaTeXStyle String
| Flag_HyperlinkedSource
+ | Flag_SourceCss String
| Flag_Help
| Flag_Verbosity String
| Flag_Version
@@ -119,6 +121,8 @@ options backwardsCompat =
"output for Hoogle; you may want --package-name and --package-version too",
Option [] ["hyperlinked-source"] (NoArg Flag_HyperlinkedSource)
"generate highlighted and hyperlinked source code (for use with --html)",
+ Option [] ["source-css"] (ReqArg Flag_SourceCss "FILE")
+ "use custom CSS file instead of default one in hyperlinked source",
Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL")
"URL for a source code link on the contents\nand index pages",
Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"])
@@ -242,6 +246,8 @@ optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ]
optCssFile :: [Flag] -> Maybe FilePath
optCssFile flags = optLast [ str | Flag_CSS str <- flags ]
+optSourceCssFile :: [Flag] -> Maybe FilePath
+optSourceCssFile flags = optLast [ str | Flag_SourceCss str <- flags ]
sourceUrls :: [Flag] -> (Maybe String, Maybe String, Maybe String, Maybe String)
sourceUrls flags =
--
cgit v1.2.3