[commit: haddock] master: Add support for providing custom CSS files for hyperlinked source. (6f16398)
git at git.haskell.org
git at git.haskell.org
Wed Jul 8 08:40:58 UTC 2015
Repository : ssh://git@git.haskell.org/haddock
On branch : master
Link : http://git.haskell.org/haddock.git/commitdiff/6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7
>---------------------------------------------------------------
commit 6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date: Mon Jun 22 17:20:37 2015 +0200
Add support for providing custom CSS files for hyperlinked source.
>---------------------------------------------------------------
6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7
haddock-api/haddock-api.cabal | 1 +
haddock-api/resources/html/solarized.css | 55 +++++++++++++++++++++++++
haddock-api/src/Haddock.hs | 3 +-
haddock-api/src/Haddock/Backends/Hyperlinker.hs | 26 +++++++++---
haddock-api/src/Haddock/Options.hs | 6 +++
5 files changed, 84 insertions(+), 7 deletions(-)
diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 6ffde97..1465699 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -18,6 +18,7 @@ stability: experimental
data-dir:
resources
data-files:
+ html/solarized.css
html/frames.html
html/haddock-util.js
html/Classic.theme/haskell_icon.gif
diff --git a/haddock-api/resources/html/solarized.css b/haddock-api/resources/html/solarized.css
new file mode 100644
index 0000000..e4bff38
--- /dev/null
+++ b/haddock-api/resources/html/solarized.css
@@ -0,0 +1,55 @@
+body {
+ background-color: #fdf6e3;
+}
+
+.hs-identifier {
+ color: #073642;
+}
+
+.hs-identifier.hs-var {
+}
+
+.hs-identifier.hs-type {
+ color: #5f5faf;
+}
+
+.hs-keyword {
+ color: #af005f;
+}
+
+.hs-string, .hs-char {
+ color: #cb4b16;
+}
+
+.hs-number {
+ color: #268bd2;
+}
+
+.hs-operator {
+ color: #d33682;
+}
+
+.hs-glyph, .hs-special {
+ color: #dc322f;
+}
+
+.hs-comment {
+ color: #8a8a8a;
+}
+
+.hs-pragma {
+ color: #2aa198;
+}
+
+.hs-cpp {
+ color: #859900;
+}
+
+a:link, a:visited {
+ text-decoration: none;
+ border-bottom: 1px solid #eee8d5;
+}
+
+a:hover {
+ background-color: #eee8d5;
+}
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index e45456a..698122e 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 8861947..66392a6 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 c9d5688..f84989e 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 =
More information about the ghc-commits
mailing list