Add support for providing custom CSS files for hyperlinked source.

1 files changed, 20 insertions, 6 deletions

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"