diff options
Diffstat (limited to 'src/HaddockHH.hs')
| -rw-r--r-- | src/HaddockHH.hs | 188 |
1 files changed, 94 insertions, 94 deletions
diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs index 05ff9243..5feac3e4 100644 --- a/src/HaddockHH.hs +++ b/src/HaddockHH.hs @@ -1,94 +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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
- text "<HTML>" $$
- text "<HEAD>" $$
- text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
- text "<!-- Sitemap 1.0 -->" $$
- text "</HEAD><BODY>" $$
- ppModuleTree tree $$
- text "</BODY><HTML>"
- writeFile (odir ++ pathSeparator:contentsHHFile) (render html)
- where
- ppModuleTree :: [ModuleTree] -> Doc
- ppModuleTree ts =
- text "<OBJECT type=\"text/site properties\">" $$
- text "<PARAM name=\"FrameName\" value=\"main\">" $$
- text "</OBJECT>" $$
- text "<UL>" $+$
- nest 4 (fn [] ts) $+$
- text "</UL>"
-
- 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 "<UL>" $+$
- nest 4 (fn (s:ss) ts) $+$
- text "</UL>"
-
- ppLeaf s ss isleaf =
- text "<LI>" <> nest 4
- (text "<OBJECT type=\"text/sitemap\">" $$
- text "<PARAM name=\"Name\" value=\"" <> text s <> text "\">" $$
- (if isleaf then text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile "" mod) <> text "\">" else empty) $$
- text "</OBJECT>") $+$
- text "</LI>"
- 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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$
- text "<HTML>" $$
- text "<HEAD>" $$
- text "<META name=\"GENERATOR\" content=\"Haddock\">" $$
- text "<!-- Sitemap 1.0 -->" $$
- text "</HEAD><BODY>" $$
- text "<UL>" $+$
- nest 4 (ppList index) $+$
- text "</UL>" $$
- text "</BODY><HTML>"
- 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 "<LI>" <> nest 4
- (text "<OBJECT type=\"text/sitemap\">" $$
- text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$
- text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile "" mod) <> char '#' <> text (show name) <> text "\">" $$
- text "</OBJECT>") $+$
- text "</LI>" $$
- ppList mods
\ No newline at end of file +module HaddockHH(ppHHContents, ppHHIndex) where + +import HsSyn hiding(Doc) +import Pretty +import 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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$ + text "<HTML>" $$ + text "<HEAD>" $$ + text "<META name=\"GENERATOR\" content=\"Haddock\">" $$ + text "<!-- Sitemap 1.0 -->" $$ + text "</HEAD><BODY>" $$ + ppModuleTree tree $$ + text "</BODY><HTML>" + writeFile (odir ++ pathSeparator:contentsHHFile) (render html) + where + ppModuleTree :: [ModuleTree] -> Doc + ppModuleTree ts = + text "<OBJECT type=\"text/site properties\">" $$ + text "<PARAM name=\"FrameName\" value=\"main\">" $$ + text "</OBJECT>" $$ + text "<UL>" $+$ + nest 4 (fn [] ts) $+$ + text "</UL>" + + 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 "<UL>" $+$ + nest 4 (fn (s:ss) ts) $+$ + text "</UL>" + + ppLeaf s ss isleaf = + text "<LI>" <> nest 4 + (text "<OBJECT type=\"text/sitemap\">" $$ + text "<PARAM name=\"Name\" value=\"" <> text s <> text "\">" $$ + (if isleaf then text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile "" mod) <> text "\">" else empty) $$ + text "</OBJECT>") $+$ + text "</LI>" + 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 "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$ + text "<HTML>" $$ + text "<HEAD>" $$ + text "<META name=\"GENERATOR\" content=\"Haddock\">" $$ + text "<!-- Sitemap 1.0 -->" $$ + text "</HEAD><BODY>" $$ + text "<UL>" $+$ + nest 4 (ppList index) $+$ + text "</UL>" $$ + text "</BODY><HTML>" + 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 "<LI>" <> nest 4 + (text "<OBJECT type=\"text/sitemap\">" $$ + text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$ + text "<PARAM name=\"Local\" value=\"" <> text (moduleHtmlFile "" mod) <> char '#' <> text (show name) <> text "\">" $$ + text "</OBJECT>") $+$ + text "</LI>" $$ + ppList mods |