diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-22 17:20:37 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-06-30 22:37:49 +0200 |
commit | 6f16398a26a12d58b3ba7f1924e2b6b00e68f5f7 (patch) | |
tree | d85ee833ededcfc3df42e381154655e01b6a8751 | |
parent | 62d44cd1d37d83fa93d169c2e5b5b758fcc231d6 (diff) |
Add support for providing custom CSS files for hyperlinked source.
-rw-r--r-- | haddock-api/haddock-api.cabal | 1 | ||||
-rw-r--r-- | haddock-api/resources/html/solarized.css | 55 | ||||
-rw-r--r-- | haddock-api/src/Haddock.hs | 3 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 26 | ||||
-rw-r--r-- | 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 6ffde976..14656994 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 00000000..e4bff385 --- /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 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 = |