diff options
| -rw-r--r-- | haddock.cabal | 6 | ||||
| -rw-r--r-- | src/Haddock/Backends/DevHelp.hs | 86 | ||||
| -rw-r--r-- | src/Haddock/Backends/HH.hs | 185 | ||||
| -rw-r--r-- | src/Haddock/Backends/HH2.hs | 196 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 60 | ||||
| -rw-r--r-- | src/Haddock/Options.hs | 8 | ||||
| -rw-r--r-- | src/Main.hs | 10 |
7 files changed, 8 insertions, 543 deletions
diff --git a/haddock.cabal b/haddock.cabal index eaf3aadf..1ae9a656 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 e6225303..00000000 --- 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 7f58fd02..00000000 --- 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 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) --} diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index b249ddf3..2befd9bd 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 53b9337d..132a5e52 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 f75dcad9..40b1d42a 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 |