diff options
Diffstat (limited to 'haddock-api/src')
-rw-r--r-- | haddock-api/src/Haddock.hs | 4 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 25 |
2 files changed, 29 insertions, 0 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 3e58aba3..e45456ab 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -30,6 +30,7 @@ import Haddock.Backends.Xhtml import Haddock.Backends.Xhtml.Themes (getThemes) import Haddock.Backends.LaTeX import Haddock.Backends.Hoogle +import Haddock.Backends.Hyperlinker import Haddock.Interface import Haddock.Parser import Haddock.Types @@ -308,6 +309,9 @@ render dflags flags qual ifaces installedIfaces srcMap = do ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style libDir + when (Flag_HyperlinkedSource `elem` flags) $ do + ppHyperlinkedSource odir libDir Nothing visibleIfaces + -- | From GHC 7.10, this function has a potential to crash with a -- nasty message such as @expectJust getPackageDetails@ because -- package name and versions can no longer reliably be extracted in diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs new file mode 100644 index 00000000..88619474 --- /dev/null +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -0,0 +1,25 @@ +module Haddock.Backends.Hyperlinker (ppHyperlinkedSource) where + +import Haddock.Types +import Haddock.Backends.Hyperlinker.Renderer + +import GHC +import Text.XHtml hiding ((</>)) +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 + +ppHyperlinkedModuleSource :: FilePath -> Maybe FilePath -> Interface -> IO () +ppHyperlinkedModuleSource outdir mstyle iface = case ifaceTokenizedSrc iface of + Just tokens -> writeFile path $ showHtml . render mstyle $ tokens + Nothing -> return () + where + path = outdir </> "src" </> moduleSourceFile (ifaceMod iface) + +moduleSourceFile :: Module -> FilePath +moduleSourceFile = (++ ".html") . moduleNameString . moduleName |