From 11ebf08d5ef30375ba5585b6079f696d49402c3f Mon Sep 17 00:00:00 2001 From: "davve@dtek.chalmers.se" Date: Sun, 25 Mar 2007 01:23:25 +0000 Subject: De-flatten the namespace --- src/HaddockHH2.hs | 182 ------------------------------------------------------ 1 file changed, 182 deletions(-) delete mode 100644 src/HaddockHH2.hs (limited to 'src/HaddockHH2.hs') diff --git a/src/HaddockHH2.hs b/src/HaddockHH2.hs deleted file mode 100644 index c329e254..00000000 --- a/src/HaddockHH2.hs +++ /dev/null @@ -1,182 +0,0 @@ -module HaddockHH2(ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where - -ppHH2Contents = error "not yet" -ppHH2Index = error "not yet" -ppHH2Files = error "not yet" -ppHH2Collection = error "not yet" - -{- -import HaddockModuleTree -import HaddockTypes -import HaddockUtil -import HsSyn2 hiding(Doc) -import qualified Map - -import Data.Char ( toUpper ) -import Data.Maybe ( fromMaybe ) -import Text.PrettyPrint - -ppHH2Contents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO () -ppHH2Contents odir doctitle maybe_package tree = do - let - contentsHH2File = package++".HxT" - - doc = - text "" $$ - text "" $$ - text "" $$ - nest 4 (text "text doctitle<>text"\" Url=\"index.html\">" $$ - nest 4 (ppModuleTree [] tree) $+$ - text "") $$ - text "" - writeFile (pathJoin [odir, contentsHH2File]) (render doc) - where - package = fromMaybe "pkg" maybe_package - - ppModuleTree :: [String] -> [ModuleTree] -> Doc - ppModuleTree ss [x] = ppNode ss x - ppModuleTree ss (x:xs) = ppNode ss x $$ ppModuleTree ss xs - ppModuleTree _ [] = error "HaddockHH2.ppHH2Contents.ppModuleTree: no module trees given" - - ppNode :: [String] -> ModuleTree -> Doc - ppNode ss (Node s leaf _pkg _short []) = - text " ppAttributes leaf (s:ss) <> text "/>" - ppNode ss (Node s leaf _pkg _short ts) = - text " ppAttributes leaf (s:ss) <> text ">" $$ - nest 4 (ppModuleTree (s:ss) ts) $+$ - text "" - - ppAttributes :: Bool -> [String] -> Doc - ppAttributes isleaf ss = hsep [ppId,ppTitle,ppUrl] - where - mdl = foldr (++) "" (s' : map ('.':) ss') - (s':ss') = reverse ss - -- reconstruct the module name - - ppId = text "Id=" <> doubleQuotes (text mdl) - - ppTitle = text "Title=" <> doubleQuotes (text (head ss)) - - ppUrl | isleaf = text " Url=" <> doubleQuotes (text (moduleHtmlFile mdl)) - | otherwise = empty - ------------------------------------------------------------------------------------ - -ppHH2Index :: FilePath -> Maybe String -> [Interface] -> IO () -ppHH2Index odir maybe_package ifaces = do - let - indexKHH2File = package++"K.HxK" - indexNHH2File = package++"N.HxK" - docK = - text "" $$ - text "" $$ - text "" $$ - nest 4 (ppList index) $+$ - text "" - docN = - text "" $$ - text "" $$ - text "" $$ - text "" $$ - nest 4 (text "text contentsHtmlFile<>text "\"/>") $$ - text "" $$ - text "" - writeFile (pathJoin [odir, indexKHH2File]) (render docK) - writeFile (pathJoin [odir, indexNHH2File]) (render docN) - where - package = fromMaybe "pkg" maybe_package - - index :: [(HsName, [Module])] - index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces) - - getIfaceIndex iface fm = - Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm - where mdl = iface_module iface - - ppList [] = empty - ppList ((name,mdls):vs) = - text " text (escapeStr (show name)) <> text "\">" $$ - nest 4 (vcat (map (ppJump name) mdls)) $$ - text "" $$ - ppList vs - - ppJump name (Module mdl) = text " text (nameHtmlRef mdl name) <> text "\"/>" - - ------------------------------------------------------------------------------------ - -ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO () -ppHH2Files odir maybe_package ifaces pkg_paths = do - let filesHH2File = package++".HxF" - doc = - text "" $$ - text "" $$ - text "" $$ - nest 4 (ppMods ifaces $$ - text "text contentsHtmlFile<>text "\"/>" $$ - text "text indexHtmlFile<>text "\"/>" $$ - ppIndexFiles chars $$ - ppLibFiles ("":pkg_paths)) $$ - text "" - writeFile (pathJoin [odir, filesHH2File]) (render doc) - where - package = fromMaybe "pkg" maybe_package - - ppMods [] = empty - ppMods (iface:ifaces) = - text " text (moduleHtmlFile mdl) <> text "\"/>" $$ - ppMods ifaces - where Module mdl = iface_module iface - - ppIndexFiles [] = empty - ppIndexFiles (c:cs) = - text "text (subIndexHtmlFile c)<>text "\"/>" $$ - ppIndexFiles cs - - ppLibFiles [] = empty - ppLibFiles (path:paths) = - ppLibFile cssFile $$ - ppLibFile iconFile $$ - ppLibFile jsFile $$ - ppLibFile plusFile $$ - ppLibFile minusFile $$ - ppLibFiles paths - where - toPath fname | null path = fname - | otherwise = pathJoin [path, fname] - ppLibFile fname = text "text (toPath fname)<>text "\"/>" - - chars :: [Char] - chars = map fst (Map.toAscList (foldr getIfaceIndex Map.empty ifaces)) - - getIfaceIndex iface fm = - Map.union (Map.fromList [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']) fm - where mdl = iface_module iface - ------------------------------------------------------------------------------------ - -ppHH2Collection :: FilePath -> String -> Maybe String -> IO () -ppHH2Collection odir doctitle maybe_package = do - let - package = fromMaybe "pkg" maybe_package - collectionHH2File = package++".HxC" - - doc = - text "" $$ - text "" $$ - text " text doctitle <> text "\">" $$ - nest 4 (text "" $$ - nest 4 (text " text package <> text ".HxF\"/>") $$ - text "" $$ - text " text package <> text ".HxT\"/>" $$ - text " text package <> text "K.HxK\"/>" $$ - text " text package <> text "N.HxK\"/>" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "" $$ - text "") $$ - text "" - writeFile (pathJoin [odir, collectionHH2File]) (render doc) --} -- cgit v1.2.3