diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 41 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 5 |
2 files changed, 30 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 diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 4fed3a1e..78c78aca 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -29,6 +29,7 @@ module Haddock.Utils ( moduleNameUrl, moduleNameUrl', moduleUrl, nameAnchorId, makeAnchorId, + defaultModuleSourceUrl, -- * Miscellaneous utilities getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr, @@ -277,6 +278,10 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r -- NB: '-' is legal in IDs, but we use it as the escape char +defaultModuleSourceUrl :: String +defaultModuleSourceUrl = "src/%{MODULE}.html" + + ------------------------------------------------------------------------------- -- * Files we need to copy from our $libdir ------------------------------------------------------------------------------- |