aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs41
1 files changed, 25 insertions, 16 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 9337307c..2ed4dbdd 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -1,45 +1,54 @@
module Haddock.Backends.Hyperlinker (ppHyperlinkedSource) where
import Haddock.Types
+import Haddock.Utils
+import Haddock.Backends.Xhtml.Types
+import Haddock.Backends.Xhtml.Utils
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]
+ppHyperlinkedSource :: FilePath -> FilePath
+ -> Maybe FilePath
+ -> SourceURLs
+ -> [Interface]
-> IO ()
-ppHyperlinkedSource outdir libdir mstyle ifaces = do
- createDirectoryIfMissing True $ srcPath outdir
+ppHyperlinkedSource outdir libdir mstyle urls ifaces = do
+ createDirectoryIfMissing True srcdir
let cssFile = fromMaybe (defaultCssFile libdir) mstyle
- copyFile cssFile $ srcPath outdir </> srcCssFile
+ copyFile cssFile $ srcdir </> srcCssFile
copyFile (libdir </> "html" </> highlightScript) $
- srcPath outdir </> highlightScript
- mapM_ (ppHyperlinkedModuleSource outdir) ifaces
+ srcdir </> highlightScript
+ mapM_ (ppHyperlinkedModuleSource outdir urls) ifaces
+ where
+ srcdir = srcPath outdir urls
-ppHyperlinkedModuleSource :: FilePath -> Interface -> IO ()
-ppHyperlinkedModuleSource outdir iface = case ifaceTokenizedSrc iface of
+ppHyperlinkedModuleSource :: FilePath -> SourceURLs -> Interface -> IO ()
+ppHyperlinkedModuleSource outdir urls iface = case ifaceTokenizedSrc iface of
Just tokens -> writeFile path $ showHtml . render mCssFile mJsFile $ tokens
Nothing -> return ()
where
mCssFile = Just $ srcCssFile
mJsFile = Just $ highlightScript
- path = srcPath outdir </> moduleSourceFile (ifaceMod iface)
-
-moduleSourceFile :: Module -> FilePath
-moduleSourceFile = (++ ".html") . moduleNameString . moduleName
+ srcFile = spliceURL Nothing (Just $ ifaceMod iface) Nothing Nothing $
+ srcModUrl urls
+ path = outdir </> srcFile
-srcPath :: FilePath -> FilePath
-srcPath outdir = outdir </> "src"
+srcPath :: FilePath -> SourceURLs -> FilePath
+srcPath outdir urls = outdir </> takeDirectory (srcModUrl urls)
srcCssFile :: FilePath
-srcCssFile = "style.css"
+srcCssFile = "srcstyle.css"
highlightScript :: FilePath
highlightScript = "highlight.js"
defaultCssFile :: FilePath -> FilePath
defaultCssFile libdir = libdir </> "html" </> "solarized.css"
+
+srcModUrl :: SourceURLs -> String
+srcModUrl (_, mModSrcUrl, _, _) = fromMaybe defaultModuleSourceUrl mModSrcUrl