aboutsummaryrefslogtreecommitdiff
path: root/src/HaddockHtml.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaddockHtml.hs')
-rw-r--r--src/HaddockHtml.hs42
1 files changed, 30 insertions, 12 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