From 40f44d7bd3afb519fb92297cf03aa52db2844eda Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Thu, 25 Mar 2004 15:17:24 +0000
Subject: [haddock @ 2004-03-25 15:17:23 by simonmar] Add support for
 collaspible parts of the page, with a +/- button and a bit of JavaScript. 
 Make the instances collapsible, and collapse them by default.

This makes documentation with long lists of instances (eg. the
Prelude) much easier to read.  Maybe we should give other
documentation sections the same treatment.
---
 src/HaddockHtml.hs | 61 +++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 44 insertions(+), 17 deletions(-)

(limited to 'src/HaddockHtml.hs')

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
-- 
cgit v1.2.3