clean up collapser logics

	javascript code for collapasble sections cleaned up
	rewrote class utilities in javascript to be more robust
	refactored utilities for generating collapsable sections
made toc be same color as synopsis
module list has needed clear attribute in CSS

4 files changed, 36 insertions, 27 deletions

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index d28c31cc..8ea55e9b 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -264,7 +264,7 @@ mkNode ss p (Node s leaf pkg short ts) =
   where
     modAttrs = case ts of
       [] -> [theclass "module"]
-      _ -> collapser p "module"
+      _ -> collapseControl p True "module"
 
     htmlModule = thespan ! modAttrs <<
       (if leaf
@@ -278,7 +278,7 @@ mkNode ss p (Node s leaf pkg short ts) =
     shortDescr = maybe noHtml origDocToHtml short
     htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) pkg
 
-    subtree = mkNodeList (s:ss) p ts ! [identifier p, theclass "show"]
+    subtree = mkNodeList (s:ss) p ts ! collapseSection p True ""
 
 
 -- | Turn a module tree into a flat list of full module names.  E.g.,
@@ -504,10 +504,10 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
       | no_doc_at_all = noHtml
       | otherwise
       = divSynposis $
-            paragraph ! collapser "syn" "caption" << "Synopsis" +++ 
+            paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++ 
             shortDeclList (
                 mapMaybe (processExport True linksInfo unicode) exports
-            ) ! ([identifier "syn"] ++ collapser "syn" "hide")
+            ) ! (collapseSection "syn" False "" ++ collapseToggle "syn")
 
         -- if the documentation doesn't begin with a section header, then
         -- add one ("Documentation").
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 65830055..7031a9ae 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -385,9 +385,9 @@ ppClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortCl
 
 ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Html
 ppInstances instances baseName unicode
-  = subInstances instId (map instDecl instances)
+  = subInstances instName (map instDecl instances)
   where
-    instId = collapseId (getName baseName)
+    instName = getOccString $ getName baseName
     instDecl :: DocInstance DocName -> SubDecl
     instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
     instHead ([],   n, ts) = ppAppNameTypes n ts unicode
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 02146476..1a0feeb4 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -40,6 +40,7 @@ import Haddock.Backends.Xhtml.DocMarkup
 import Haddock.Backends.Xhtml.Types
 import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
+import Haddock.Utils (makeAnchorId)
 
 import Text.XHtml hiding ( name, title, p, quote )
 
@@ -154,13 +155,13 @@ subFields = divSubDecls "fields" "Fields" . subDlist
 
 
 subInstances :: String -> [SubDecl] -> Html
-subInstances id_ = maybe noHtml wrap . instTable
+subInstances nm = maybe noHtml wrap . instTable
   where
     wrap = (subSection <<) . (subCaption +++)
-    instTable = fmap (thediv ! [identifier id_, theclass "show"] <<) . subTable
+    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTable
     subSection = thediv ! [theclass $ "subs instances"]
-    subCaption = paragraph ! collapser id_ "caption" << "Instances"
-
+    subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
+    id_ = makeAnchorId $ "i:" ++ nm
 
 subMethods :: [Html] -> Html
 subMethods = divSubDecls "methods" "Methods" . subBlock
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index d3b75b43..10f9e766 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -24,7 +24,7 @@ module Haddock.Backends.Xhtml.Utils (
 
   hsep,
 
-  collapser, collapseId,
+  collapseSection, collapseToggle, collapseControl,
 ) where
 
 
@@ -173,21 +173,29 @@ linkedAnchor n = anchor ! [href ('#':n)]
 
 
 --
--- A section of HTML which is collapsible via a +/- button.
+-- A section of HTML which is collapsible.
 --
 
--- TODO: Currently the initial state is non-collapsed. Change the 'minusFile'
--- below to a 'plusFile' and the 'display:block;' to a 'display:none;' when we
--- use cookies from JavaScript to have a more persistent state.
-
-collapser :: String -> String -> [HtmlAttr]
-collapser id_ classes = [ theclass cs, strAttr "onclick" js ]
-  where
-    cs = unwords (words classes ++ ["collapser"])
-    js = "toggleSection(this,'" ++ id_ ++ "')"
-
-
--- 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 :: Name -> String
-collapseId nm = "i:" ++ escapeStr (getOccString nm)
+-- | Attributes for an area that can be collapsed
+collapseSection :: String -> Bool -> String -> [HtmlAttr]
+collapseSection id_ state classes = [ identifier sid, theclass cs ]
+  where cs = unwords (words classes ++ [pick state "show" "hide"])
+        sid = "section." ++ id_
+
+-- | Attributes for an area that toggles a collapsed area
+collapseToggle :: String -> [HtmlAttr]
+collapseToggle id_ = [ strAttr "onclick" js ]
+  where js = "toggleSection('" ++ id_ ++ "')";
+  
+-- | Attributes for an area that toggles a collapsed area,
+-- and displays a control.
+collapseControl :: String -> Bool -> String -> [HtmlAttr]
+collapseControl id_ state classes =
+  [ identifier cid, theclass cs ] ++ collapseToggle id_
+  where cs = unwords (words classes ++ [pick state "collapser" "expander"])
+        cid = "control." ++ id_
+
+
+pick :: Bool -> a -> a -> a
+pick True  t _ = t
+pick False _ f = f