diff --git a/haddock.cabal b/haddock.cabal
index eaf3aadf58bfa650217cf3835e4f34d94083659a..1ae9a6563b76825be15c5eb1ee4721901f743215 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -117,9 +117,6 @@ executable haddock
Haddock.Backends.Xhtml.Utils
Haddock.Backends.LaTeX
Haddock.Backends.HaddockDB
- Haddock.Backends.DevHelp
- Haddock.Backends.HH
- Haddock.Backends.HH2
Haddock.Backends.Hoogle
Haddock.ModuleTree
Haddock.Types
@@ -181,9 +178,6 @@ library
Haddock.Backends.Xhtml.Utils
Haddock.Backends.LaTeX
Haddock.Backends.HaddockDB
- Haddock.Backends.DevHelp
- Haddock.Backends.HH
- Haddock.Backends.HH2
Haddock.Backends.Hoogle
Haddock.ModuleTree
Haddock.Types
diff --git a/src/Haddock/Backends/DevHelp.hs b/src/Haddock/Backends/DevHelp.hs
deleted file mode 100644
index e62253032932d5c1accd2956f1e76f9181bb65e2..0000000000000000000000000000000000000000
--- a/src/Haddock/Backends/DevHelp.hs
+++ /dev/null
@@ -1,86 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Haddock.Backends.DevHelp
--- Copyright : (c) Simon Marlow 2003-2006,
--- David Waern 2006
--- License : BSD-like
---
--- Maintainer : haddock@projects.haskell.org
--- Stability : experimental
--- Portability : portable
------------------------------------------------------------------------------
-module Haddock.Backends.DevHelp (ppDevHelpFile) where
-
-import Haddock.ModuleTree
-import Haddock.Types hiding (Doc)
-import Haddock.Utils
-
-import Module
-import Name ( Name, nameModule, getOccString, nameOccName )
-
-import Data.Maybe ( fromMaybe )
-import qualified Data.Map as Map
-import System.FilePath
-import Text.PrettyPrint
-
-ppDevHelpFile :: FilePath -> String -> Maybe String -> [Interface] -> IO ()
-ppDevHelpFile odir doctitle maybe_package ifaces = do
- let devHelpFile = package++".devhelp"
- tree = mkModuleTree True [ (ifaceMod iface, toDescription iface) | iface <- ifaces ]
- doc =
- text "<?xml version=\"1.0\" encoding=\"utf-8\" standalone=\"no\"?>" $$
- (text "<book xmlns=\"http://www.devhelp.net/book\" title=\""<>text doctitle<>
- text "\" link=\""<>text contentsHtmlFile<>text"\" author=\"\" name=\""<>text package<>text "\">") $$
- text "<chapters>" $$
- nest 4 (ppModuleTree [] tree) $+$
- text "</chapters>" $$
- text "<functions>" $$
- nest 4 (ppList index) $+$
- text "</functions>" $$
- text "</book>"
- writeFile (joinPath [odir, devHelpFile]) (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 "HaddockHH.ppHHContents.fn: no module trees given"
-
- ppNode :: [String] -> ModuleTree -> Doc
- ppNode ss (Node s leaf _ _short ts) =
- case ts of
- [] -> text "<sub"<+>ppAttribs<>text "/>"
- _ ->
- text "<sub"<+>ppAttribs<>text ">" $$
- nest 4 (ppModuleTree (s:ss) ts) $+$
- text "</sub>"
- where
- ppLink | leaf = text (moduleHtmlFile (mkModule (stringToPackageId "")
- (mkModuleName mdl)))
- | otherwise = empty
-
- ppAttribs = text "name="<>doubleQuotes (text s)<+>text "link="<>doubleQuotes ppLink
-
- mdl = foldr (++) "" (s' : map ('.':) ss')
- (s':ss') = reverse (s:ss)
- -- reconstruct the module name
-
- index :: [(Name, [Module])]
- index = Map.toAscList (foldr getModuleIndex Map.empty ifaces)
-
- getModuleIndex iface fm =
- Map.unionWith (++) (Map.fromListWith (flip (++)) [(name, [mdl]) | name <- ifaceExports iface, nameModule name == mdl]) fm
- where mdl = ifaceMod iface
-
- ppList :: [(Name, [Module])] -> Doc
- ppList [] = empty
- ppList ((name,refs):mdls) =
- ppReference name refs $$
- ppList mdls
-
- ppReference :: Name -> [Module] -> Doc
- ppReference _ [] = empty
- ppReference name (mdl:refs) =
- text "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (moduleNameUrl mdl (nameOccName name))<>text"\"/>" $$
- ppReference name refs
diff --git a/src/Haddock/Backends/HH.hs b/src/Haddock/Backends/HH.hs
deleted file mode 100644
index 7f58fd020bf524a773f83a3423608b336811f299..0000000000000000000000000000000000000000
--- a/src/Haddock/Backends/HH.hs
+++ /dev/null
@@ -1,185 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Haddock.Backends.HH
--- Copyright : (c) Simon Marlow 2003
--- License : BSD-like
---
--- Maintainer : haddock@projects.haskell.org
--- Stability : experimental
--- Portability : portable
------------------------------------------------------------------------------
-module Haddock.Backends.HH (ppHHContents, ppHHIndex, ppHHProject) where
-
-ppHHContents, ppHHIndex, ppHHProject :: a
-ppHHContents = error "not yet"
-ppHHIndex = error "not yet"
-ppHHProject = 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
-
-ppHHContents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
-ppHHContents odir doctitle maybe_package tree = do
- let contentsHHFile = package++".hhc"
-
- 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 (joinPath [odir, contentsHHFile]) (render html)
- where
- package = fromMaybe "pkg" maybe_package
-
- ppModuleTree :: [ModuleTree] -> Doc
- ppModuleTree ts =
- text "<OBJECT type=\"text/site properties\">" $$
- text "<PARAM name=\"FrameName\" value=\"main\">" $$
- text "</OBJECT>" $$
- text "<UL>" $+$
- nest 4 (text "<LI>" <> nest 4
- (text "<OBJECT type=\"text/sitemap\">" $$
- nest 4 (text "<PARAM name=\"Name\" value=\""<>text doctitle<>text "\">" $$
- text "<PARAM name=\"Local\" value=\"index.html\">") $$
- text "</OBJECT>") $+$
- text "</LI>" $$
- text "<UL>" $+$
- nest 4 (fn [] ts) $+$
- text "</UL>") $+$
- text "</UL>"
-
- fn :: [String] -> [ModuleTree] -> Doc
- fn ss [x] = ppNode ss x
- fn ss (x:xs) = ppNode ss x $$ fn ss xs
- fn _ [] = error "HaddockHH.ppHHContents.fn: no module trees given"
-
- ppNode :: [String] -> ModuleTree -> Doc
- ppNode ss (Node s leaf _pkg _ []) =
- ppLeaf s ss leaf
- ppNode ss (Node s leaf _pkg _ 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 mdl) <> text "\">" else empty) $$
- text "</OBJECT>") $+$
- text "</LI>"
- where
- mdl = foldr (++) "" (s' : map ('.':) ss')
- (s':ss') = reverse (s:ss)
- -- reconstruct the module name
-
--------------------------------
-ppHHIndex :: FilePath -> Maybe String -> [Interface] -> IO ()
-ppHHIndex odir maybe_package ifaces = do
- let indexHHFile = package++".hhk"
-
- 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 (joinPath [odir, indexHHFile]) (render html)
- where
- package = fromMaybe "pkg" maybe_package
-
- index :: [(HsName, [Module])]
- index = Map.toAscList (foldr getIfaceIndex Map.empty ifaces)
-
- getIfaceIndex iface fm =
- foldl (\m (k,e) -> Map.insertWith (++) k e m) fm [(name, [mdl]) | (name, Qual mdl' _) <- Map.toAscList (iface_env iface), mdl == mdl']
- where mdl = iface_module iface
-
- ppList [] = empty
- ppList ((name,refs):mdls) =
- text "<LI>" <> nest 4
- (text "<OBJECT type=\"text/sitemap\">" $$
- text "<PARAM name=\"Name\" value=\"" <> text (show name) <> text "\">" $$
- ppReference name refs $$
- text "</OBJECT>") $+$
- text "</LI>" $$
- ppList mdls
-
- ppReference name [] = empty
- ppReference name (Module mdl:refs) =
- text "<PARAM name=\"Local\" value=\"" <> text (moduleNameURL mdl name) <> text "\">" $$
- ppReference name refs
-
-
-ppHHProject :: FilePath -> String -> Maybe String -> [Interface] -> [FilePath] -> IO ()
-ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
- let projectHHFile = package++".hhp"
- doc =
- text "[OPTIONS]" $$
- text "Compatibility=1.1 or later" $$
- text "Compiled file=" <> text package <> text ".chm" $$
- text "Contents file=" <> text package <> text ".hhc" $$
- text "Default topic=" <> text contentsHtmlFile $$
- text "Display compile progress=No" $$
- text "Index file=" <> text package <> text ".hhk" $$
- text "Title=" <> text doctitle $$
- space $$
- text "[FILES]" $$
- ppMods ifaces $$
- text contentsHtmlFile $$
- text indexHtmlFile $$
- ppIndexFiles chars $$
- ppLibFiles ("":pkg_paths)
- writeFile (joinPath [odir, projectHHFile]) (render doc)
- where
- package = fromMaybe "pkg" maybe_package
-
- ppMods [] = empty
- ppMods (iface:ifaces) =
- let Module mdl = iface_module iface in
- text (moduleHtmlFile mdl) $$
- ppMods ifaces
-
- ppIndexFiles [] = empty
- ppIndexFiles (c:cs) =
- text (subIndexHtmlFile c) $$
- 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 (toPath fname)
-
- 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
--}
diff --git a/src/Haddock/Backends/HH2.hs b/src/Haddock/Backends/HH2.hs
deleted file mode 100644
index b2fe5e9263bb0e028f20a502b9e67b31956a1251..0000000000000000000000000000000000000000
--- 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)
--}
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index b249ddf37f7f30d3f82cf8ac5b9ceb66fccc3b93..2befd9bd3a726c7b9778d7559d47e3c8cc538a9e 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -13,15 +13,11 @@
module Haddock.Backends.Xhtml (
ppHtml, copyHtmlBits,
ppHtmlIndex, ppHtmlContents,
- ppHtmlHelpFiles
) where
import Prelude hiding (div)
-import Haddock.Backends.DevHelp
-import Haddock.Backends.HH
-import Haddock.Backends.HH2
import Haddock.Backends.Xhtml.Decl
import Haddock.Backends.Xhtml.DocMarkup
import Haddock.Backends.Xhtml.Layout
@@ -67,7 +63,6 @@ ppHtml :: String
-> [Interface]
-> FilePath -- destination directory
-> Maybe (Doc GHC.RdrName) -- prologue text, maybe
- -> Maybe String -- the Html Help format (--html-help)
-> SourceURLs -- the source URL (--source)
-> WikiURLs -- the wiki URL (--wiki)
-> Maybe String -- the contents URL (--use-contents)
@@ -75,7 +70,7 @@ ppHtml :: String
-> Bool -- whether to use unicode in output (--use-unicode)
-> IO ()
-ppHtml doctitle maybe_package ifaces odir prologue maybe_html_help_format
+ppHtml doctitle maybe_package ifaces odir prologue
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url unicode = do
let
@@ -83,48 +78,21 @@ ppHtml doctitle maybe_package ifaces odir prologue maybe_html_help_format
visible i = OptHide `notElem` ifaceOptions i
when (not (isJust maybe_contents_url)) $
ppHtmlContents odir doctitle maybe_package
- maybe_html_help_format maybe_index_url maybe_source_url maybe_wiki_url
+ maybe_index_url maybe_source_url maybe_wiki_url
(map toInstalledIface visible_ifaces)
False -- we don't want to display the packages in a single-package contents
prologue
when (not (isJust maybe_index_url)) $
- ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
+ ppHtmlIndex odir doctitle maybe_package
maybe_contents_url maybe_source_url maybe_wiki_url
(map toInstalledIface visible_ifaces)
- when (not (isJust maybe_contents_url && isJust maybe_index_url)) $
- ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format []
-
mapM_ (ppHtmlModule odir doctitle
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url unicode) visible_ifaces
-ppHtmlHelpFiles
- :: String -- doctitle
- -> Maybe String -- package
- -> [Interface]
- -> FilePath -- destination directory
- -> Maybe String -- the Html Help format (--html-help)
- -> [FilePath] -- external packages paths
- -> IO ()
-ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format pkg_paths = do
- let
- visible_ifaces = filter visible ifaces
- visible i = OptHide `notElem` ifaceOptions i
-
- -- Generate index and contents page for Html Help if requested
- case maybe_html_help_format of
- Nothing -> return ()
- Just "mshelp" -> ppHHProject odir doctitle maybe_package visible_ifaces pkg_paths
- Just "mshelp2" -> do
- ppHH2Files odir maybe_package visible_ifaces pkg_paths
- ppHH2Collection odir doctitle maybe_package
- Just "devhelp" -> ppDevHelpFile odir doctitle maybe_package visible_ifaces
- Just format -> fail ("The "++format++" format is not implemented")
-
-
copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
(bracket (openFile fromFPath ReadMode) hClose $ \hFrom ->
@@ -269,13 +237,12 @@ ppHtmlContents
-> String
-> Maybe String
-> Maybe String
- -> Maybe String
-> SourceURLs
-> WikiURLs
-> [InstalledInterface] -> Bool -> Maybe (Doc GHC.RdrName)
-> IO ()
ppHtmlContents odir doctitle
- maybe_package maybe_html_help_format maybe_index_url
+ _maybe_package maybe_index_url
maybe_source_url maybe_wiki_url ifaces showPkgs prologue = do
let tree = mkModuleTree showPkgs
[(instMod iface, toInstalledDescription iface) | iface <- ifaces]
@@ -293,14 +260,6 @@ ppHtmlContents odir doctitle
-- XXX: think of a better place for this?
ppHtmlContentsFrame odir doctitle ifaces
- -- Generate contents page for Html Help if requested
- case maybe_html_help_format of
- Nothing -> return ()
- Just "mshelp" -> ppHHContents odir doctitle maybe_package tree
- Just "mshelp2" -> ppHH2Contents odir doctitle maybe_package tree
- Just "devhelp" -> return ()
- Just format -> fail ("The "++format++" format is not implemented")
-
ppPrologue :: String -> Maybe (Doc GHC.RdrName) -> Html
ppPrologue _ Nothing = noHtml
@@ -386,12 +345,11 @@ ppHtmlIndex :: FilePath
-> String
-> Maybe String
-> Maybe String
- -> Maybe String
-> SourceURLs
-> WikiURLs
-> [InstalledInterface]
-> IO ()
-ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
+ppHtmlIndex odir doctitle _maybe_package
maybe_contents_url maybe_source_url maybe_wiki_url ifaces = do
let html = indexPage split_indices Nothing
(if split_indices then [] else index)
@@ -403,14 +361,6 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
writeFile (joinPath [odir, indexHtmlFile]) (renderToString html)
- -- Generate index and contents page for Html Help if requested
- case maybe_html_help_format of
- Nothing -> return ()
- Just "mshelp" -> ppHHIndex odir maybe_package ifaces
- Just "mshelp2" -> ppHH2Index odir maybe_package ifaces
- Just "devhelp" -> return ()
- Just format -> fail ("The "++format++" format is not implemented")
-
where
indexPage showLetters ch items =
headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing +++
diff --git a/src/Haddock/Options.hs b/src/Haddock/Options.hs
index 53b9337d9d3b6abf9899ef9564ba090b6330c370..132a5e5218b6525243a648ef617fe6b8187a8baf 100644
--- a/src/Haddock/Options.hs
+++ b/src/Haddock/Options.hs
@@ -19,7 +19,6 @@ module Haddock.Options (
outputDir,
optContentsUrl,
optIndexUrl,
- optHtmlHelpFormat,
optCssFile,
optSourceUrls,
optWikiUrls,
@@ -47,7 +46,6 @@ data Flag
| Flag_Heading String
| Flag_Html
| Flag_Hoogle
- | Flag_HtmlHelp String
| Flag_Lib String
| Flag_OutputDir FilePath
| Flag_Prologue FilePath
@@ -100,8 +98,6 @@ options backwardsCompat =
Option ['U'] ["use-unicode"] (NoArg Flag_UseUnicode) "use Unicode in HTML output",
Option [] ["hoogle"] (NoArg Flag_Hoogle)
"output for Hoogle",
- Option [] ["html-help"] (ReqArg Flag_HtmlHelp "format")
- "produce index and table of contents in\nmshelp, mshelp2 or devhelp format (with -h)",
Option [] ["source-base"] (ReqArg Flag_SourceBaseURL "URL")
"URL for a source code link on the contents\nand index pages",
Option ['s'] (if backwardsCompat then ["source", "source-module"] else ["source-module"])
@@ -193,10 +189,6 @@ optIndexUrl :: [Flag] -> Maybe String
optIndexUrl flags = optLast [ url | Flag_UseIndex url <- flags ]
-optHtmlHelpFormat :: [Flag] -> Maybe String
-optHtmlHelpFormat flags = optLast [ hhformat | Flag_HtmlHelp hhformat <- flags ]
-
-
optCssFile :: [Flag] -> Maybe FilePath
optCssFile flags = optLast [ str | Flag_CSS str <- flags ]
diff --git a/src/Main.hs b/src/Main.hs
index f75dcad9ce17d4672238d2e5c464a834b50635e8..40b1d42a8a53968f9d49fcbba3a314993cf119c9 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -179,7 +179,6 @@ render flags ifaces installedIfaces = do
opt_wiki_urls = optWikiUrls flags
opt_contents_url = optContentsUrl flags
opt_index_url = optIndexUrl flags
- opt_html_help_format = optHtmlHelpFormat flags
css_file = optCssFile flags
odir = outputDir flags
opt_latex_style = optLaTeXStyle flags
@@ -198,23 +197,20 @@ render flags ifaces installedIfaces = do
prologue <- getPrologue flags
when (Flag_GenIndex `elem` flags) $ do
- ppHtmlIndex odir title packageStr opt_html_help_format
+ ppHtmlIndex odir title packageStr
opt_contents_url opt_source_urls opt_wiki_urls
allVisibleIfaces
copyHtmlBits odir libDir css_file
- when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $
- ppHtmlHelpFiles title packageStr visibleIfaces odir opt_html_help_format []
-
when (Flag_GenContents `elem` flags) $ do
- ppHtmlContents odir title packageStr opt_html_help_format
+ ppHtmlContents odir title packageStr
opt_index_url opt_source_urls opt_wiki_urls
allVisibleIfaces True prologue
copyHtmlBits odir libDir css_file
when (Flag_Html `elem` flags) $ do
ppHtml title packageStr visibleIfaces odir
- prologue opt_html_help_format
+ prologue
opt_source_urls opt_wiki_urls
opt_contents_url opt_index_url unicode
copyHtmlBits odir libDir css_file