[commit: haddock] master: Create hyperlinker module and plug it into the Haddock pipeline. (62d44cd)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : master
Link       : http://git.haskell.org/haddock.git/commitdiff/62d44cd1d37d83fa93d169c2e5b5b758fcc231d6

>---------------------------------------------------------------

commit 62d44cd1d37d83fa93d169c2e5b5b758fcc231d6
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Mon Jun 22 16:09:54 2015 +0200

    Create hyperlinker module and plug it into the Haddock pipeline.


>---------------------------------------------------------------

62d44cd1d37d83fa93d169c2e5b5b758fcc231d6
 haddock-api/haddock-api.cabal                   |  1 +
 haddock-api/src/Haddock.hs                      |  4 ++++
 haddock-api/src/Haddock/Backends/Hyperlinker.hs | 25 +++++++++++++++++++++++++
 haddock.cabal                                   |  1 +
 4 files changed, 31 insertions(+)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 109e5f9..6ffde97 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 3e58aba..e45456a 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 0000000..8861947
--- /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
diff --git a/haddock.cabal b/haddock.cabal
index ed570f5..0aebefd 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -101,6 +101,7 @@ executable haddock
       Haddock.Backends.LaTeX
       Haddock.Backends.HaddockDB
       Haddock.Backends.Hoogle
+      Haddock.Backends.Hyperlinker
       Haddock.ModuleTree
       Haddock.Types
       Haddock.Doc