3 files changed, 32 insertions, 23 deletions
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