aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends/HH2.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends/HH2.hs')
-rw-r--r--src/Haddock/Backends/HH2.hs196
1 files changed, 0 insertions, 196 deletions
diff --git a/src/Haddock/Backends/HH2.hs b/src/Haddock/Backends/HH2.hs
deleted file mode 100644
index b2fe5e92..00000000
--- a/src/Haddock/Backends/HH2.hs
+++ /dev/null
@@ -1,196 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Haddock.Backends.HH2
--- Copyright : (c) Simon Marlow 2003
--- License : BSD-like
---
--- Maintainer : haddock@projects.haskell.org
--- Stability : experimental
--- Portability : portable
------------------------------------------------------------------------------
-module Haddock.Backends.HH2 (ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where
-
-import Haddock.Types
-
-ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO ()
-ppHH2Files = error "not yet"
-
-ppHH2Contents, ppHH2Index, ppHH2Collection :: a
-ppHH2Contents = error "not yet"
-ppHH2Index = error "not yet"
-ppHH2Collection = error "not yet"
-
-{-
-import HaddockModuleTree
-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 "<?xml version=\"1.0\"?>" $$
- text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$
- text "<HelpTOC DTDVersion=\"1.0\">" $$
- nest 4 (text "<HelpTOCNode Title=\""<>text doctitle<>text"\" Url=\"index.html\">" $$
- nest 4 (ppModuleTree [] tree) $+$
- text "</HelpTOCNode>") $$
- text "</HelpTOC>"
- writeFile (joinPath [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 "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text "/>"
- ppNode ss (Node s leaf _pkg _short ts) =
- text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text ">" $$
- nest 4 (ppModuleTree (s:ss) ts) $+$
- text "</HelpTOCNode>"
-
- 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 "<?xml version=\"1.0\"?>" $$
- text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
- text "<HelpIndex DTDVersion=\"1.0\" Name=\"K\">" $$
- nest 4 (ppList index) $+$
- text "</HelpIndex>"
- docN =
- text "<?xml version=\"1.0\"?>" $$
- text "<!DOCTYPE HelpIndex SYSTEM \"ms-help://hx/resources/HelpIndex.DTD\">" $$
- text "<HelpIndex DTDVersion=\"1.0\" Name=\"NamedURLIndex\">" $$
- text "<Keyword Term=\"HomePage\">" $$
- nest 4 (text "<Jump Url=\""<>text contentsHtmlFile<>text "\"/>") $$
- text "</Keyword>" $$
- text "</HelpIndex>"
- writeFile (joinPath [odir, indexKHH2File]) (render docK)
- writeFile (joinPath [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 "<Keyword Term=\"" <> text (escapeStr (show name)) <> text "\">" $$
- nest 4 (vcat (map (ppJump name) mdls)) $$
- text "</Keyword>" $$
- ppList vs
-
- ppJump name (Module mdl) = text "<Jump Url=\"" <> text (moduleNameUrl mdl name) <> text "\"/>"
-
-
------------------------------------------------------------------------------------
-
-ppHH2Files :: FilePath -> Maybe String -> [Interface] -> [FilePath] -> IO ()
-ppHH2Files odir maybe_package ifaces pkg_paths = do
- let filesHH2File = package++".HxF"
- doc =
- text "<?xml version=\"1.0\"?>" $$
- text "<!DOCTYPE HelpFileList SYSTEM \"ms-help://hx/resources/HelpFileList.DTD\">" $$
- text "<HelpFileList DTDVersion=\"1.0\">" $$
- nest 4 (ppMods ifaces $$
- text "<File Url=\""<>text contentsHtmlFile<>text "\"/>" $$
- text "<File Url=\""<>text indexHtmlFile<>text "\"/>" $$
- ppIndexFiles chars $$
- ppLibFiles ("":pkg_paths)) $$
- text "</HelpFileList>"
- writeFile (joinPath [odir, filesHH2File]) (render doc)
- where
- package = fromMaybe "pkg" maybe_package
-
- ppMods [] = empty
- ppMods (iface:ifaces) =
- text "<File Url=\"" <> text (moduleHtmlFile mdl) <> text "\"/>" $$
- ppMods ifaces
- where Module mdl = iface_module iface
-
- ppIndexFiles [] = empty
- ppIndexFiles (c:cs) =
- text "<File Url=\""<>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 = joinPath [path, fname]
- ppLibFile fname = text "<File Url=\""<>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 "<?xml version=\"1.0\"?>" $$
- text "<!DOCTYPE HelpCollection SYSTEM \"ms-help://hx/resources/HelpCollection.DTD\">" $$
- text "<HelpCollection DTDVersion=\"1.0\" LangId=\"1033\" Title=\"" <> text doctitle <> text "\">" $$
- nest 4 (text "<CompilerOptions CreateFullTextIndex=\"Yes\">" $$
- nest 4 (text "<IncludeFile File=\"" <> text package <> text ".HxF\"/>") $$
- text "</CompilerOptions>" $$
- text "<TOCDef File=\"" <> text package <> text ".HxT\"/>" $$
- text "<KeywordIndexDef File=\"" <> text package <> text "K.HxK\"/>" $$
- text "<KeywordIndexDef File=\"" <> text package <> text "N.HxK\"/>" $$
- text "<ItemMoniker Name=\"!DefaultToc\" ProgId=\"HxDs.HxHierarchy\" InitData=\"\"/>" $$
- text "<ItemMoniker Name=\"!DefaultFullTextSearch\" ProgId=\"HxDs.HxFullTextSearch\" InitData=\"\"/>" $$
- text "<ItemMoniker Name=\"!DefaultAssociativeIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"A\"/>" $$
- text "<ItemMoniker Name=\"!DefaultKeywordIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"K\"/>" $$
- text "<ItemMoniker Name=\"!DefaultNamedUrlIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"NamedURLIndex\"/>" $$
- text "<ItemMoniker Name=\"!SampleInfo\" ProgId=\"HxDs.HxSampleCollection\" InitData=\"\"/>") $$
- text "</HelpCollection>"
- writeFile (joinPath [odir, collectionHH2File]) (render doc)
--}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 21:51:37 +0000