diff options
| -rw-r--r-- | src/HaddockHH.hs | 21 | ||||
| -rw-r--r-- | src/HaddockHH2.hs | 162 | ||||
| -rw-r--r-- | src/HaddockHtml.hs | 94 | ||||
| -rw-r--r-- | src/HaddockUtil.hs | 23 | ||||
| -rw-r--r-- | src/HsSyn.lhs | 17 | ||||
| -rw-r--r-- | src/Main.hs | 26 |
6 files changed, 258 insertions, 85 deletions
diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs index f10c970e..77d97bca 100644 --- a/src/HaddockHH.hs +++ b/src/HaddockHH.hs @@ -18,9 +18,9 @@ contentsHHFile, indexHHFile :: String contentsHHFile = "index.hhc" indexHHFile = "index.hhk" -ppHHContents :: FilePath -> [Module] -> IO () -ppHHContents odir mods = do - let tree = mkModuleTree (zip mods (repeat Nothing)) --TODO: packages +ppHHContents :: FilePath -> [(Module,Interface)] -> IO () +ppHHContents odir ifaces = do + let tree = mkModuleTree (map (\(mod,_) -> (mod,Nothing)) ifaces) --TODO: packages html = text "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML//EN\">" $$ text "<HTML>" $$ @@ -83,21 +83,18 @@ ppHHIndex odir ifaces = do text "</BODY><HTML>" writeFile (odir ++ pathSeparator:indexHHFile) (render html) where - index :: [(HsName, Module)] - index = fmToList full_index + index :: [(HsName, [Module])] + index = fmToList (foldr getIfaceIndex emptyFM ifaces) - iface_indices = map getIfaceIndex ifaces - full_index = foldr1 plusFM iface_indices - - getIfaceIndex (mdl,iface) = listToFM - [ (name, mdl) | (name, Qual mdl' _) <- fmToList (iface_env iface), mdl == mdl'] + getIfaceIndex (mdl,iface) fm = + addListToFM_C (++) fm [(name, [mdl]) | (name, Qual mdl' _) <- fmToList (iface_env iface), mdl == mdl'] ppList [] = empty - ppList ((name,Module mdl):mdls) = + ppList ((name,(Module mdl:_)):mdls) = 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 "" mdl) <> char '#' <> text (show name) <> text "\">" $$ + text "<PARAM name=\"Local\" value=\"" <> text (nameHtmlRef "" mdl name) <> text "\">" $$ text "</OBJECT>") $+$ text "</LI>" $$ ppList mdls diff --git a/src/HaddockHH2.hs b/src/HaddockHH2.hs new file mode 100644 index 00000000..bb291bd7 --- /dev/null +++ b/src/HaddockHH2.hs @@ -0,0 +1,162 @@ +module HaddockHH2(ppHH2Contents, ppHH2Index, ppHH2Files, ppHH2Collection) where + +import HsSyn hiding(Doc) + +#if __GLASGOW_HASKELL__ < 503 +import Pretty +import FiniteMap +#else +import Text.PrettyPrint +import Data.FiniteMap +import Data.List +import Data.Char +#endif + +import HaddockModuleTree +import HaddockUtil +import HaddockTypes + +ppHH2Contents :: FilePath -> String -> [(Module,Interface)] -> IO () +ppHH2Contents odir package ifaces = do + let + contentsHH2File = package++".HxT" + + tree = mkModuleTree (map (\(mod,_) -> (mod,Nothing)) ifaces) --TODO: packages + doc = + text "<?xml version=\"1.0\"?>" $$
+ text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$ + text "<HelpTOC DTDVersion=\"1.0\">" $$ + nest 4 (ppModuleTree [] tree) $$ + text "</HelpTOC>" + writeFile (odir ++ pathSeparator:contentsHH2File) (render doc) + where + 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 []) = + text "<HelpTOCNode" <+> ppAttributes leaf (s:ss) <> text "/>" + ppNode ss (Node s leaf _pkg 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 -> String -> [(Module,Interface)] -> IO () +ppHH2Index odir 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=\"index.html\"/>") $$
+ text "</Keyword>" $$
+ text "</HelpIndex>" + writeFile (odir ++ pathSeparator:indexKHH2File) (render docK) + writeFile (odir ++ pathSeparator:indexNHH2File) (render docN) + where + index :: [(HsName, [Module])] + index = fmToList (foldr getIfaceIndex emptyFM ifaces) + + getIfaceIndex (mdl,iface) fm = + addListToFM_C (++) fm [(name, [mdl]) | (name, Qual mdl' _) <- fmToList (iface_env iface), mdl == mdl'] + + ppList [] = empty + ppList ((name,mdls):vs) = + text "<Keyword Term=\"" <> text (show name) <> text "\">" $$
+ nest 4 (vcat (map (ppJump name) mdls)) $$
+ text "</Keyword>" $$
+ ppList vs + + ppJump name (Module mdl) = text "<Jump Url=\"" <> text (nameHtmlRef fp mdl name) <> text "\"/>" + where + fp = case lookupFM html_xrefs (Module mdl) of + Nothing -> "" + Just fp0 -> fp0 + + +----------------------------------------------------------------------------------- + +ppHH2Files :: FilePath -> String -> [(Module,Interface)] -> IO () +ppHH2Files odir package ifaces = 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=\"index.html\"/>" $$
+ text "<File Url=\"doc-index.html\"/>" $$
+ ppIndexFiles chars $$
+ text "<File Url=\""<>text iconFile<>text "\"/>" $$
+ text "<File Url=\""<>text cssFile<>text "\"/>") $$
+ text "</HelpFileList>"
+ writeFile (odir ++ pathSeparator:filesHH2File) (render doc) + where + ppMods [] = empty + ppMods ((Module mdl,_):ifaces) = + text "<File Url=\"" <> text (moduleHtmlFile "" mdl) <> text "\"/>" $$
+ ppMods ifaces + + ppIndexFiles [] = empty + ppIndexFiles (c:cs) = + text "<File Url=\"doc-index-" <> char c <> text ".html\"/>" $$
+ ppIndexFiles cs + + chars :: [Char] + chars = keysFM (foldr getIfaceIndex emptyFM ifaces) + + getIfaceIndex (mdl,iface) fm = + addListToFM fm [(toUpper (head (show name)),()) | (name, Qual mdl' _) <- fmToList (iface_env iface), mdl == mdl'] + +----------------------------------------------------------------------------------- + +ppHH2Collection :: FilePath -> String -> [(Module,Interface)] -> IO () +ppHH2Collection odir package ifaces = do + let + 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 package <> 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 (odir ++ pathSeparator:collectionHH2File) (render doc) diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 1909805a..0f700f24 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -6,7 +6,7 @@ module HaddockHtml ( ppHtml, copyHtmlBits, - ppHtmlIndex, ppHtmlContents, foo + ppHtmlIndex, ppHtmlContents ) where import Prelude hiding (div) @@ -15,51 +15,39 @@ import HaddockTypes import HaddockUtil import HaddockModuleTree import HaddockHH +import HaddockHH2 import HsSyn import IO -import Maybe ( fromJust, isJust ) +import Maybe ( fromJust, isJust, fromMaybe ) import List ( sortBy ) import Char ( isUpper, toUpper, isAlpha, ord ) import Monad ( when, unless ) #if __GLASGOW_HASKELL__ < 503 import FiniteMap -import URI ( escapeString, unreserved ) #else import Data.FiniteMap -import Network.URI ( escapeString, unreserved ) #endif import Html import qualified Html -foo = 42 - --- ----------------------------------------------------------------------------- --- Files we need to copy from our $libdir - -cssFile, jsFile, iconFile :: String -cssFile = "haddock.css" -jsFile = "haddock.js" -iconFile = "haskell_icon.gif" -plusFile = "plus.jpg" -minusFile = "minus.jpg" - -- ----------------------------------------------------------------------------- -- Generating HTML documentation ppHtml :: String + -> Maybe String -- package -> Maybe String -> [(Module, Interface)] -> FilePath -- destination directory -> Maybe Doc -- prologue text, maybe - -> Bool -- do MS Help stuff + -> Maybe String -- the Html Help format (--html-help) -> Maybe String -- the contents URL (--use-contents) -> Maybe String -- the index URL (--use-index) -> IO () -ppHtml doctitle source_url ifaces odir prologue do_ms_help +ppHtml doctitle package source_url ifaces odir prologue maybe_html_help_format maybe_contents_url maybe_index_url = do let visible_ifaces = filter visible ifaces @@ -74,10 +62,20 @@ ppHtml doctitle source_url ifaces odir prologue do_ms_help when (not (isJust maybe_index_url)) $ ppHtmlIndex odir doctitle maybe_contents_url visible_ifaces - -- Generate index and contents page for MS help if requested - when do_ms_help $ do - ppHHContents odir (map fst visible_ifaces) - ppHHIndex odir visible_ifaces + -- Generate index and contents page for Html Help if requested + case maybe_html_help_format of + Nothing -> return () + Just "mshelp" -> do + ppHHContents odir visible_ifaces + ppHHIndex odir visible_ifaces + Just "mshelp2" -> do + let pkg_name = fromMaybe "pkg" package + ppHH2Contents odir pkg_name visible_ifaces + ppHH2Index odir pkg_name visible_ifaces + ppHH2Files odir pkg_name visible_ifaces + ppHH2Collection odir pkg_name visible_ifaces + Just format -> do + fail ("The "++format++" format is not implemented") mapM_ (ppHtmlModule odir doctitle source_url maybe_contents_url maybe_index_url) visible_ifaces @@ -348,7 +346,7 @@ ppHtmlIndex odir doctitle maybe_contents_url ifaces = do ppAnnot (HsVarName n) | isUpper c || c == ':' = toHtml "Data Constructor" | otherwise = toHtml "Function" - where c = head (ppHsIdentifier n) + where c = head (hsIdentifierStr n) indexLinks nm entries = tda [ theclass "indexlinks" ] << @@ -418,7 +416,7 @@ ifaceToHtml _ iface -- if the documentation doesn't begin with a section header, then -- add one ("Documentation"). maybe_doc_hdr - = case exports of + = case exports of [] -> Html.emptyTable ExportGroup _ _ _ : _ -> Html.emptyTable _ -> tda [ theclass "section1" ] << toHtml "Documentation" @@ -439,7 +437,7 @@ ppModuleContents exports | lev <= n = ( [], items ) | otherwise = ( html:secs, rest2 ) where - html = (dterm << linkedAnchor "" id0 << docToHtml doc) + html = (dterm << linkedAnchor id0 << docToHtml doc) +++ mk_subsections ssecs (ssecs, rest1) = process lev rest (secs, rest2) = process n rest1 @@ -595,6 +593,7 @@ ppHsDataDecl summary instances is_newty aboves (map (declBox.ppInstHead) instances) ) ) + ppHsDataDecl _ _ _ _ d = error $ "HaddockHtml.ppHsDataDecl: unexpected decl " ++ show d @@ -763,7 +762,7 @@ ppHsClassDecl summary instances orig_c ) inst_id = collapseId nm - instances_bit + instances_bit | null instances = Html.emptyTable | otherwise = s8 </> inst_hdr inst_id </> @@ -771,7 +770,7 @@ ppHsClassDecl summary instances orig_c collapsed inst_id ( spacedTable1 << ( aboves (map (declBox.ppInstHead) instances) - )) + )) ppHsClassDecl _ _ _ d = error $ "HaddockHtml.ppHsClassDecl: unexpected decl: " ++ show d @@ -902,23 +901,10 @@ isSpecial _ = False ppHsName :: HsName -> Html ppHsName nm = toHtml (hsNameStr nm) -hsAnchorNameStr :: HsName -> String -hsAnchorNameStr (HsTyClsName id0) = "t:" ++ ppHsIdentifier id0 -hsAnchorNameStr (HsVarName id0) = "v:" ++ ppHsIdentifier id0 - -hsNameStr :: HsName -> String -hsNameStr (HsTyClsName id0) = ppHsIdentifier id0 -hsNameStr (HsVarName id0) = ppHsIdentifier id0 - -ppHsIdentifier :: HsIdentifier -> String -ppHsIdentifier (HsIdent str) = str -ppHsIdentifier (HsSymbol str) = str -ppHsIdentifier (HsSpecial str) = str - ppHsBinder :: Bool -> HsName -> Html -- The Bool indicates whether we are generating the summary, in which case -- the binder will be a link to the full definition. -ppHsBinder True nm = linkedAnchor "" (hsAnchorNameStr nm) << ppHsBinder' nm +ppHsBinder True nm = linkedAnchor (hsAnchorNameStr nm) << ppHsBinder' nm ppHsBinder False nm = linkTarget nm +++ bold << ppHsBinder' nm ppHsBinder' :: HsName -> Html @@ -931,11 +917,11 @@ ppHsBindIdent (HsSymbol str) = parens (toHtml str) ppHsBindIdent (HsSpecial str) = toHtml str linkId :: Module -> Maybe HsName -> Html -> Html -linkId (Module mdl) mbStr = linkedAnchor (moduleHtmlFile fp mdl) frag - where frag = case mbStr of - Nothing -> "" - Just str -> hsAnchorNameStr str - fp = case lookupFM html_xrefs (Module mdl) of +linkId (Module mdl) mbName = anchor ! [href hr] + where hr = case mbName of + Nothing -> moduleHtmlFile fp mdl + Just name -> nameHtmlRef fp mdl name + fp = case lookupFM html_xrefs (Module mdl) of Nothing -> "" Just fp0 -> fp0 @@ -1108,14 +1094,6 @@ s15 = tda [ theclass "s15" ] << noHtml namedAnchor :: String -> Html -> Html namedAnchor n = anchor ! [name (escapeStr n)] -linkedAnchor :: String -> String -> Html -> Html -linkedAnchor ref frag = anchor ! [href hr] - where hr | null frag = ref - | otherwise = ref ++ '#': escapeStr frag - -escapeStr :: String -> String -escapeStr = flip escapeString unreserved - -- -- A section of HTML which is collapsible via a +/- button. -- @@ -1130,4 +1108,10 @@ collapsed id html = -- A quote is a valid part of a Haskell identifier, but it would interfere with -- the ECMA script string delimiter used in collapsebutton above. collapseId :: HsName -> String -collapseId nm = "i:" ++ escapeString (hsNameStr nm) (/= '\'') +collapseId nm = "i:" ++ escapeStr (hsNameStr nm) + +linkedAnchor :: String -> Html -> Html +linkedAnchor frag = anchor ! [href hr] + where hr | null frag = "" + | otherwise = '#': escapeStr frag + diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs index ce22ee24..5ce61011 100644 --- a/src/HaddockUtil.hs +++ b/src/HaddockUtil.hs @@ -15,10 +15,11 @@ module HaddockUtil ( -- * Filename utilities basename, dirname, splitFilename3, isPathSeparator, pathSeparator, - moduleHtmlFile, + moduleHtmlFile, nameHtmlRef, + cssFile, iconFile, jsFile, plusFile, minusFile, -- * Miscellaneous utilities - getProgramName, bye, die, dieMsg, mapSnd, mapMaybeM, + getProgramName, bye, die, dieMsg, mapSnd, mapMaybeM, escapeStr, -- * HTML cross reference mapping html_xrefs_ref, html_xrefs, @@ -37,11 +38,13 @@ import Monad import RegexString import FiniteMap import IOExts +import URI ( escapeString, unreserved ) #else import Text.Regex import Data.FiniteMap import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) +import Network.URI ( escapeString, unreserved ) #endif -- ----------------------------------------------------------------------------- @@ -271,6 +274,19 @@ moduleHtmlFile :: FilePath -> String -> FilePath moduleHtmlFile "" mod0 = mod0 ++ ".html" -- ToDo: Z-encode filename? moduleHtmlFile dir mod0 = dir ++ pathSeparator : mod0 ++ ".html" +nameHtmlRef :: FilePath -> String -> HsName -> String +nameHtmlRef fp mdl str = moduleHtmlFile fp mdl ++ '#':escapeStr (hsAnchorNameStr str) + +-- ----------------------------------------------------------------------------- +-- Files we need to copy from our $libdir + +cssFile, iconFile, jsFile, plusFile,minusFile :: String +cssFile = "haddock.css" +iconFile = "haskell_icon.gif" +jsFile = "haddock.js" +plusFile = "plus.jpg" +minusFile = "minus.jpg" + ----------------------------------------------------------------------------- -- misc. @@ -297,6 +313,9 @@ mapMaybeM :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b) mapMaybeM _ Nothing = return Nothing mapMaybeM f (Just a) = f a >>= return . Just +escapeStr :: String -> String +escapeStr str = escapeString str unreserved + ----------------------------------------------------------------------------- -- HTML cross references diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs index e43826a0..1599365c 100644 --- a/src/HsSyn.lhs +++ b/src/HsSyn.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: HsSyn.lhs,v 1.19 2003/11/06 12:39:47 simonmar Exp $ +% $Id: HsSyn.lhs,v 1.20 2004/07/27 22:58:24 krasimir Exp $ % % (c) The GHC Team, 1997-2002 % @@ -30,6 +30,8 @@ module HsSyn ( unit_tycon_qname, fun_tycon_qname, list_tycon_qname, tuple_tycon_qname, unit_tycon, fun_tycon, list_tycon, tuple_tycon, + hsIdentifierStr, hsAnchorNameStr, hsNameStr, + GenDoc(..), Doc, DocMarkup(..), markup, mapIdent, idMarkup, docAppend, docParagraph, @@ -386,6 +388,19 @@ list_tycon = HsTyCon list_tycon_qname tuple_tycon :: Int -> HsType tuple_tycon i = HsTyCon (tuple_tycon_qname i) +hsIdentifierStr :: HsIdentifier -> String +hsIdentifierStr (HsIdent str) = str +hsIdentifierStr (HsSymbol str) = str +hsIdentifierStr (HsSpecial str) = str + +hsAnchorNameStr :: HsName -> String +hsAnchorNameStr (HsTyClsName id0) = "t:" ++ hsIdentifierStr id0 +hsAnchorNameStr (HsVarName id0) = "v:" ++ hsIdentifierStr id0 + +hsNameStr :: HsName -> String +hsNameStr (HsTyClsName id0) = hsIdentifierStr id0 +hsNameStr (HsVarName id0) = hsIdentifierStr id0 + -- ----------------------------------------------------------------------------- -- Doc strings and formatting diff --git a/src/Main.hs b/src/Main.hs index 96b76f2e..1070538b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -51,12 +51,6 @@ import Regex import PackedString #endif -#if defined(mingw32_HOST_OS) -import Foreign.Marshal.Array -import Foreign -import Foreign.C -#endif - ----------------------------------------------------------------------------- -- Top-level stuff main :: IO () @@ -79,8 +73,8 @@ data Flag | Flag_Heading String | Flag_Package String | Flag_Html + | Flag_HtmlHelp String | Flag_Lib String - | Flag_MSHtmlHelp | Flag_NoImplicitPrelude | Flag_OutputDir FilePath | Flag_Prologue FilePath @@ -110,8 +104,8 @@ options = -- "output in docbook (SGML)", Option ['h'] ["html"] (NoArg Flag_Html) "output in HTML", - Option ['m'] ["ms-help"] (NoArg Flag_MSHtmlHelp) - "produce Microsoft HTML Help files (with -h)", + Option [] ["html-help"] (ReqArg Flag_HtmlHelp "format") + "produce index and table of contents in mshelp, mshelp2 or devhelp format (with -h)", Option ['s'] ["source"] (ReqArg Flag_SourceURL "URL") "base URL for links to source code", Option ['c'] ["css"] (ReqArg Flag_CSS "FILE") @@ -261,8 +255,11 @@ run flags files = do | (mdl, i) <- these_mod_ifaces ]) when (Flag_Html `elem` flags) $ do - ppHtml title source_url these_mod_ifaces odir - prologue (Flag_MSHtmlHelp `elem` flags) + let hhformat = case [hhformat | Flag_HtmlHelp hhformat <- flags] of + [] -> Nothing + formats -> Just (last formats) + ppHtml title package source_url these_mod_ifaces odir + prologue hhformat maybe_contents_url maybe_index_url copyHtmlBits odir libdir css_file @@ -439,7 +436,6 @@ mkInterface no_implicit_prelude verbose mod_map filename package -- make the "export items", which will be converted into docs later orig_export_list <- mkExportItems mod_map mdl exported_names decl_map sub_map final_decls opts orig_exports - let -- prune the export list to just those declarations that have @@ -529,8 +525,8 @@ derivedInstances mdl decl = case decl of isVar (HsTyVar _) = True isVar _ = False extra_constraint - | null complex_tvars = [] - | otherwise = [(unknownConstraint,complex_tvars)] + | null complex_tvars = [] + | otherwise = [(unknownConstraint,complex_tvars)] lhs | n == tuple_tycon_name (length tvs - 1) = HsTyTuple True (map HsTyVar tvs) @@ -843,7 +839,7 @@ getReExports :: Module -> FiniteMap HsQName HsQName -> FiniteMap HsName HsQName getReExports mdl exported exported_visible import_env - = listToFM (concat invisible_names) + = listToFM (concat invisible_names) where invisible_names = [ get_name n | n <- exported, n `notElem` exported_visible ] |