module HaddockHH(ppHHContents, ppHHIndex) where
import HsSyn hiding(Doc)
import Text.PrettyPrint
import Data.FiniteMap
import HaddockModuleTree
import HaddockUtil
import HaddockTypes
contentsHHFile = "index.hhc"
indexHHFile = "index.hhk"
ppHHContents :: FilePath -> [Module] -> IO ()
ppHHContents odir mods = do
let tree = mkModuleTree mods
html =
text "" $$
text "" $$
text "" $$
text "" $$
text "" $$
text "" $$
ppModuleTree tree $$
text ""
writeFile (odir ++ pathSeparator:contentsHHFile) (render html)
where
ppModuleTree :: [ModuleTree] -> Doc
ppModuleTree ts =
text "" $$
text "
" $+$
nest 4 (fn [] ts) $+$
text "
"
fn :: [String] -> [ModuleTree] -> Doc
fn ss [x] = ppNode ss x
fn ss (x:xs) = ppNode ss x $$ fn ss xs
ppNode :: [String] -> ModuleTree -> Doc
ppNode ss (Node s leaf []) =
ppLeaf s ss leaf
ppNode ss (Node s leaf ts) =
ppLeaf s ss leaf $$
text "
" $+$
nest 4 (fn (s:ss) ts) $+$
text "
"
ppLeaf s ss isleaf =
text "
" <> nest 4
(text "") $+$
text "
"
where
mod = foldr (++) "" (s' : map ('.':) ss')
(s':ss') = reverse (s:ss)
-- reconstruct the module name
-------------------------------
ppHHIndex :: FilePath -> [(Module,Interface)] -> IO ()
ppHHIndex odir ifaces = do
let html =
text "" $$
text "" $$
text "" $$
text "" $$
text "" $$
text "" $$
text "
" $+$
nest 4 (ppList index) $+$
text "
" $$
text ""
writeFile (odir ++ pathSeparator:indexHHFile) (render html)
where
index :: [(HsName, Module)]
index = fmToList full_index
iface_indices = map getIfaceIndex ifaces
full_index = foldr1 plusFM iface_indices
getIfaceIndex (mod,iface) = listToFM
[ (name, mod) | (name, Qual mod' _) <- fmToList (iface_env iface), mod == mod']
ppList [] = empty
ppList ((name,Module mod):mods) =
text "