aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Hyperlinker.hs
blob: f2caa2c1c15440f08dc44df1e77fd1d6b507e190 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
module Haddock.Backends.Hyperlinker
    ( ppHyperlinkedSource
    , module Haddock.Backends.Hyperlinker.Utils
    ) where

import Haddock.Types
import Haddock.Backends.Hyperlinker.Renderer
import Haddock.Backends.Hyperlinker.Utils

import Text.XHtml hiding ((</>))
import GHC

import Data.Maybe
import System.Directory
import System.FilePath

ppHyperlinkedSource :: FilePath -> FilePath -> Maybe FilePath
                    -> PackageKey -> SrcMap -> [Interface]
                    -> IO ()
ppHyperlinkedSource outdir libdir mstyle pkg 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 pkg srcs) ifaces
  where
    srcdir = outdir </> hypSrcDir

ppHyperlinkedModuleSource :: FilePath
                          -> PackageKey -> SrcMap -> Interface
                          -> IO ()
ppHyperlinkedModuleSource srcdir pkg srcs iface =
    case ifaceTokenizedSrc iface of
        Just tokens -> writeFile path . showHtml . render' $ tokens
        Nothing -> return ()
  where
    render' = render (Just srcCssFile) (Just highlightScript) pkg srcs
    path = srcdir </> hypSrcModuleFile (ifaceMod iface)

srcCssFile :: FilePath
srcCssFile = "style.css"

highlightScript :: FilePath
highlightScript = "highlight.js"

defaultCssFile :: FilePath -> FilePath
defaultCssFile libdir = libdir </> "html" </> "solarized.css"