From affd889d1b192d2cb9787c92202317b9e9401922 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Fri, 26 Jun 2015 21:13:12 +0200
Subject: Make source hyperlinker generate output in apropriate directory.

---
 haddock-api/src/Haddock/Backends/Hyperlinker.hs | 41 +++++++++++++++----------
 1 file changed, 25 insertions(+), 16 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Hyperlinker.hs')

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
-- 
cgit v1.2.3