diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaddockHtml.hs | 42 | ||||
| -rw-r--r-- | src/Main.hs | 12 |
2 files changed, 40 insertions, 14 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 4f64d1f7..4c98bc51 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -39,16 +39,18 @@ import System.IO ( IOMode(..), hClose, hGetBuf, hPutBuf ) ppHtml :: String -> Maybe String -- package - -> Maybe String -> [Interface] -> FilePath -- destination directory -> Maybe Doc -- prologue text, maybe -> Maybe String -- the Html Help format (--html-help) + -> Maybe String -- the source URL (--source) + -> Maybe String -- the wiki URL (--wiki) -> Maybe String -- the contents URL (--use-contents) -> Maybe String -- the index URL (--use-index) -> IO () -ppHtml doctitle maybe_package source_url ifaces odir prologue maybe_html_help_format +ppHtml doctitle maybe_package ifaces odir prologue maybe_html_help_format + maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url = do let visible_ifaces = filter visible ifaces @@ -66,7 +68,8 @@ ppHtml doctitle maybe_package source_url ifaces odir prologue maybe_html_help_fo when (not (isJust maybe_contents_url && isJust maybe_index_url)) $ ppHtmlHelpFiles doctitle maybe_package ifaces odir maybe_html_help_format [] - mapM_ (ppHtmlModule odir doctitle source_url + mapM_ (ppHtmlModule odir doctitle + maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url) visible_ifaces ppHtmlHelpFiles @@ -130,9 +133,9 @@ footer = ) -src_button :: Maybe String -> String -> Interface -> HtmlTable -src_button source_url _ iface - | Just u <- source_url = +srcButton :: Maybe String -> String -> Interface -> HtmlTable +srcButton maybe_source_url _ iface + | Just u <- maybe_source_url = let src_url = spliceSrcURL iface u in topButBox (anchor ! [href src_url] << toHtml "Source code") @@ -149,6 +152,13 @@ spliceSrcURL iface url = run url modl_str = case iface_module iface of { Module m -> map (\x -> if x == '.' then '/' else x) m } +wikiButton :: Maybe String -> Interface -> HtmlTable +wikiButton Nothing _ = Html.emptyTable +wikiButton (Just wiki_base_url) iface + = topButBox (anchor ! [href url] << toHtml "Wiki") + where url = pathJoin [wiki_base_url, mod] + Module mod = iface_module iface + contentsButton :: Maybe String -> HtmlTable contentsButton maybe_contents_url = topButBox (anchor ! [href url] << toHtml "Contents") @@ -175,15 +185,19 @@ simpleHeader doctitle maybe_contents_url maybe_index_url = )) pageHeader :: String -> Interface -> String - -> Maybe String -> Maybe String -> Maybe String -> HtmlTable -pageHeader mdl iface doctitle source_url maybe_contents_url maybe_index_url = + -> Maybe String -> Maybe String + -> Maybe String -> Maybe String -> HtmlTable +pageHeader mdl iface doctitle + maybe_source_url maybe_wiki_url + maybe_contents_url maybe_index_url = (tda [theclass "topbar"] << vanillaTable << ( (td << image ! [src "haskell_icon.gif", width "16", height 16, alt " "] ) <-> (tda [theclass "title"] << toHtml doctitle) <-> - src_button source_url mdl iface <-> + srcButton maybe_source_url mdl iface <-> + wikiButton maybe_wiki_url iface <-> contentsButton maybe_contents_url <-> indexButton maybe_index_url ) @@ -453,9 +467,12 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format maybe_contents_ur -- Generate the HTML page for a module ppHtmlModule - :: FilePath -> String -> Maybe String -> Maybe String -> Maybe String + :: FilePath -> String + -> Maybe String -> Maybe String + -> Maybe String -> Maybe String -> Interface -> IO () -ppHtmlModule odir doctitle source_url +ppHtmlModule odir doctitle + maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url iface = do let Module mdl = iface_module iface @@ -465,7 +482,8 @@ ppHtmlModule odir doctitle source_url styleSheet +++ (script ! [src jsFile, thetype "text/javascript"] $ noHtml)) +++ body << vanillaTable << ( - pageHeader mdl iface doctitle source_url + pageHeader mdl iface doctitle + maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url </> s15 </> ifaceToHtml mdl iface </> s15 </> footer diff --git a/src/Main.hs b/src/Main.hs index bed74040..2d6408f0 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -79,6 +79,7 @@ data Flag | Flag_Prologue FilePath | Flag_ReadInterface FilePath | Flag_SourceURL String + | Flag_WikiURL String | Flag_Help | Flag_Verbose | Flag_Version @@ -110,6 +111,8 @@ options = "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 [] ["wiki"] (ReqArg Flag_WikiURL "URL") + "base URL for links to a wiki", Option ['c'] ["css"] (ReqArg Flag_CSS "FILE") "the CSS file to use for HTML output", Option ['p'] ["prologue"] (ReqArg Flag_Prologue "FILE") @@ -161,7 +164,11 @@ run flags files = do [] -> Nothing (t:_) -> Just t - source_url = case [str | Flag_SourceURL str <- flags] of + maybe_source_url = case [str | Flag_SourceURL str <- flags] of + [] -> Nothing + (t:_) -> Just t + + maybe_wiki_url = case [str | Flag_WikiURL str <- flags] of [] -> Nothing (t:_) -> Just t @@ -292,8 +299,9 @@ run flags files = do | i <- these_ifaces ]) when (Flag_Html `elem` flags) $ do - ppHtml title package source_url these_ifaces odir + ppHtml title package these_ifaces odir prologue maybe_html_help_format + maybe_source_url maybe_wiki_url maybe_contents_url maybe_index_url copyHtmlBits odir libdir css_file |