aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock.hs3
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs26
-rw-r--r--haddock-api/src/Haddock/Options.hs6
3 files changed, 28 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index e45456ab..698122e3 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -244,6 +244,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
opt_index_url = optIndexUrl flags
odir = outputDir flags
opt_latex_style = optLaTeXStyle flags
+ opt_source_css = optSourceCssFile flags
visibleIfaces = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]
@@ -310,7 +311,7 @@ render dflags flags qual ifaces installedIfaces srcMap = do
libDir
when (Flag_HyperlinkedSource `elem` flags) $ do
- ppHyperlinkedSource odir libDir Nothing visibleIfaces
+ ppHyperlinkedSource odir libDir opt_source_css visibleIfaces
-- | 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 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 =