aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/haddock-api.cabal1
-rw-r--r--haddock-api/src/Haddock.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs25
3 files changed, 30 insertions, 0 deletions
diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 109e5f95..6ffde976 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -82,6 +82,7 @@ library
Haddock.Backends.LaTeX
Haddock.Backends.HaddockDB
Haddock.Backends.Hoogle
+ Haddock.Backends.Hyperlinker
Haddock.ModuleTree
Haddock.Types
Haddock.Doc
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