aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Hyperlinker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Hyperlinker.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs64
1 files changed, 64 insertions, 0 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
new file mode 100644
index 00000000..248a8a54
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -0,0 +1,64 @@
+module Haddock.Backends.Hyperlinker
+ ( ppHyperlinkedSource
+ , module Haddock.Backends.Hyperlinker.Types
+ , module Haddock.Backends.Hyperlinker.Utils
+ ) where
+
+
+import Haddock.Types
+import Haddock.Backends.Hyperlinker.Renderer
+import Haddock.Backends.Hyperlinker.Types
+import Haddock.Backends.Hyperlinker.Utils
+
+import Text.XHtml hiding ((</>))
+
+import Data.Maybe
+import System.Directory
+import System.FilePath
+
+
+-- | Generate hyperlinked source for given interfaces.
+--
+-- Note that list of interfaces should also contain interfaces normally hidden
+-- when generating documentation. Otherwise this could lead to dead links in
+-- produced source.
+ppHyperlinkedSource :: FilePath -- ^ Output directory
+ -> FilePath -- ^ Resource directory
+ -> Maybe FilePath -- ^ Custom CSS file path
+ -> Bool -- ^ Flag indicating whether to pretty-print HTML
+ -> SrcMap -- ^ Paths to sources
+ -> [Interface] -- ^ Interfaces for which we create source
+ -> IO ()
+ppHyperlinkedSource outdir libdir mstyle pretty srcs ifaces = do
+ createDirectoryIfMissing True srcdir
+ let cssFile = fromMaybe (defaultCssFile libdir) mstyle
+ copyFile cssFile $ srcdir </> srcCssFile
+ copyFile (libdir </> "html" </> highlightScript) $
+ srcdir </> highlightScript
+ mapM_ (ppHyperlinkedModuleSource srcdir pretty srcs) ifaces
+ where
+ srcdir = outdir </> hypSrcDir
+
+-- | Generate hyperlinked source for particular interface.
+ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMap -> Interface
+ -> IO ()
+ppHyperlinkedModuleSource srcdir pretty srcs iface =
+ case ifaceTokenizedSrc iface of
+ Just tokens -> writeFile path . html . render' $ tokens
+ Nothing -> return ()
+ where
+ render' = render (Just srcCssFile) (Just highlightScript) srcs
+ html = if pretty then renderHtml else showHtml
+ path = srcdir </> hypSrcModuleFile (ifaceMod iface)
+
+-- | Name of CSS file in output directory.
+srcCssFile :: FilePath
+srcCssFile = "style.css"
+
+-- | Name of highlight script in output and resource directory.
+highlightScript :: FilePath
+highlightScript = "highlight.js"
+
+-- | Path to default CSS file.
+defaultCssFile :: FilePath -> FilePath
+defaultCssFile libdir = libdir </> "html" </> "solarized.css"