diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaddockHtml.hs | 61 | ||||
| -rw-r--r-- | src/Html.hs | 8 |
2 files changed, 51 insertions, 18 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 7b909a02..527fe758 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -39,8 +39,9 @@ foo = 42 -- ----------------------------------------------------------------------------- -- Files we need to copy from our $libdir -cssFile, iconFile :: String +cssFile, jsFile, iconFile :: String cssFile = "haddock.css" +jsFile = "haddock.js" iconFile = "haskell_icon.gif" -- ----------------------------------------------------------------------------- @@ -88,13 +89,13 @@ copyHtmlBits odir libdir maybe_css = do Just f -> f css_destination = odir ++ pathSeparator:cssFile - icon_file = libdir ++ pathSeparator:iconFile - icon_destination = odir ++ pathSeparator:iconFile + copyFile f = do + s <- readFile (libdir ++ pathSeparator:f) + writeFile (odir ++ pathSeparator:f) s css_contents <- readFile css_file writeFile css_destination css_contents - icon_contents <- readFile icon_file - writeFile icon_destination icon_contents + mapM_ copyFile [ iconFile, jsFile ] contentsHtmlFile, indexHtmlFile :: String @@ -369,7 +370,8 @@ ppHtmlModule odir doctitle source_url let html = header (thetitle (toHtml mdl) +++ thelink ! [href cssFile, - rel "stylesheet", thetype "text/css"]) +++ + rel "stylesheet", thetype "text/css"] +++ + (script ! [src jsFile] $ noHtml)) +++ body << vanillaTable << ( pageHeader mdl iface doctitle source_url maybe_contents_url maybe_index_url </> s15 </> @@ -579,13 +581,18 @@ ppHsDataDecl summary instances is_newty aboves (map ppSideBySideConstr cons) ) + inst_id = "i:" ++ hsNameStr nm + instances_bit | null instances = Html.emptyTable | otherwise - = inst_hdr </> - tda [theclass "body"] << spacedTable1 << ( - aboves (map (declBox.ppInstHead) instances) - ) + = inst_hdr inst_id </> + tda [theclass "body"] << + collapsed inst_id ( + spacedTable1 << ( + aboves (map (declBox.ppInstHead) instances) + ) + ) ppHsDataDecl _ _ _ _ d = error $ "HaddockHtml.ppHsDataDecl: unexpected decl " ++ show d @@ -753,11 +760,16 @@ ppHsClassDecl summary instances orig_c ] ) + inst_id = "i:" ++ hsNameStr nm instances_bit - = s8 </> inst_hdr </> - tda [theclass "body"] << spacedTable1 << ( + | null instances = Html.emptyTable + | otherwise + = s8 </> inst_hdr inst_id </> + tda [theclass "body"] << + collapsed inst_id ( + spacedTable1 << ( aboves (map (declBox.ppInstHead) instances) - ) + )) ppHsClassDecl _ _ _ d = error $ "HaddockHtml.ppHsClassDecl: unexpected decl: " ++ show d @@ -1074,10 +1086,13 @@ spacedTable1, spacedTable5 :: Html -> Html spacedTable1 = table ! [theclass "vanilla", cellspacing 1, cellpadding 0] spacedTable5 = table ! [theclass "vanilla", cellspacing 5, cellpadding 0] -constr_hdr, meth_hdr, inst_hdr :: HtmlTable -constr_hdr = tda [ theclass "section4" ] << toHtml "Constructors" -meth_hdr = tda [ theclass "section4" ] << toHtml "Methods" -inst_hdr = tda [ theclass "section4" ] << toHtml "Instances" +constr_hdr, meth_hdr :: HtmlTable +constr_hdr = tda [ theclass "section4" ] << toHtml "Constructors" +meth_hdr = tda [ theclass "section4" ] << toHtml "Methods" + +inst_hdr :: String -> HtmlTable +inst_hdr id = + tda [ theclass "section4" ] << (collapsebutton id +++ toHtml " Instances") dcolon, arrow, darrow :: Html dcolon = toHtml "::" @@ -1098,3 +1113,15 @@ linkedAnchor ref frag = anchor ! [href hr] escapeStr :: String -> String escapeStr = flip escapeString unreserved + +-- +-- A section of HTML which is collapsible via a +/- button. +-- +collapsebutton :: String -> Html +collapsebutton id = + button ! [ theclass "coll", onclick ("toggle(this,'" ++ id ++ "')") ] << + toHtml "+" + +collapsed :: String -> Html -> Html +collapsed id html = + thediv ! [identifier id, thestyle "display:none;"] << html diff --git a/src/Html.hs b/src/Html.hs index 04294b81..81cbad93 100644 --- a/src/Html.hs +++ b/src/Html.hs @@ -9,7 +9,7 @@ -- Stability : experimental -- Portability : portable -- --- $Id: Html.hs,v 1.2 2002/07/24 09:42:18 simonmar Exp $ +-- $Id: Html.hs,v 1.3 2004/03/25 15:17:24 simonmar Exp $ -- -- An Html combinator library -- @@ -214,6 +214,7 @@ blockquote :: Html -> Html body :: Html -> Html bold :: Html -> Html br :: Html +button :: Html -> Html caption :: Html -> Html center :: Html -> Html cite :: Html -> Html @@ -249,6 +250,7 @@ paragraph :: Html -> Html param :: Html pre :: Html -> Html sample :: Html -> Html +script :: Html -> Html select :: Html -> Html small :: Html -> Html strong :: Html -> Html @@ -283,6 +285,7 @@ blockquote = tag "BLOCKQUOTE" body = tag "BODY" bold = tag "B" br = itag "BR" +button = tag "BUTTON" caption = tag "CAPTION" center = tag "CENTER" cite = tag "CITE" @@ -318,6 +321,7 @@ paragraph = tag "P" param = itag "PARAM" pre = tag "PRE" sample = tag "SAMP" +script = tag "SCRIPT" select = tag "SELECT" small = tag "SMALL" strong = tag "STRONG" @@ -391,6 +395,7 @@ nohref :: HtmlAttr noresize :: HtmlAttr noshade :: HtmlAttr nowrap :: HtmlAttr +onclick :: String -> HtmlAttr rel :: String -> HtmlAttr rev :: String -> HtmlAttr rows :: String -> HtmlAttr @@ -460,6 +465,7 @@ nohref = emptyAttr "NOHREF" noresize = emptyAttr "NORESIZE" noshade = emptyAttr "NOSHADE" nowrap = emptyAttr "NOWRAP" +onclick = strAttr "ONCLICK" rel = strAttr "REL" rev = strAttr "REV" rows = strAttr "ROWS" |