From 9728087302a03143624d030642770f17be1eb097 Mon Sep 17 00:00:00 2001 From: krasimir Date: Tue, 9 Jul 2002 16:33:33 +0000 Subject: [haddock @ 2002-07-09 16:33:31 by krasimir] 'Microsoft HTML Help' support --- src/HaddockHH.hs | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 94 insertions(+) create mode 100644 src/HaddockHH.hs (limited to 'src/HaddockHH.hs') diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs new file mode 100644 index 00000000..05ff9243 --- /dev/null +++ b/src/HaddockHH.hs @@ -0,0 +1,94 @@ +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 "" $$ + text "" $$ + 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 "" + + ppLeaf s ss isleaf = + text "
  • " <> nest 4 + (text "" $$ + text " text s <> text "\">" $$ + (if isleaf then text " text (moduleHtmlFile "" mod) <> text "\">" else empty) $$ + 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 "" $$ + 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 "
  • " <> nest 4 + (text "" $$ + text " text (show name) <> text "\">" $$ + text " text (moduleHtmlFile "" mod) <> char '#' <> text (show name) <> text "\">" $$ + text "") $+$ + text "
    • " $$ + ppList mods \ No newline at end of file -- cgit v1.2.3