Use <details> element for collapsibles (#690)

* Remove unnecessary call to 'collapseSection'

The call is unnecessary since there is no corresponding toggle for hiding the
section of orphan instances.

* Use <details> for collapsibles

This makes them work even when JS is disabled. Closes #560.

4 files changed, 41 insertions, 35 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index e8148782..c76c0c88 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -310,11 +310,11 @@ mkNode qual ss p (Node s leaf pkg srcPkg short ts) =
   htmlModule <+> shortDescr +++ htmlPkg +++ subtree
   where
     modAttrs = case (ts, leaf) of
-      (_:_, False) -> collapseControl p True "module"
+      (_:_, False) -> collapseControl p "module"
       (_,   _    ) -> [theclass "module"]
 
     cBtn = case (ts, leaf) of
-      (_:_, True) -> thespan ! collapseControl p True "" << spaceHtml
+      (_:_, True) -> thespan ! collapseControl p "" << spaceHtml
       (_,   _   ) -> noHtml
       -- We only need an explicit collapser button when the module name
       -- is also a leaf, and so is a link to a module page. Indeed, the
@@ -332,7 +332,12 @@ mkNode qual ss p (Node s leaf pkg srcPkg short ts) =
     shortDescr = maybe noHtml (origDocToHtml qual) short
     htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) srcPkg
 
-    subtree = mkNodeList qual (s:ss) p ts ! collapseSection p True ""
+    subtree =
+      if null ts then noHtml else
+      collapseDetails p DetailsOpen (
+        thesummary ! [ theclass "hide-when-js-enabled" ] << "Submodules" +++
+        mkNodeList qual (s:ss) p ts
+      )
 
 
 
@@ -586,10 +591,12 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
       | no_doc_at_all = noHtml
       | otherwise
       = divSynopsis $
-            paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++
-            shortDeclList (
-                mapMaybe (processExport True linksInfo unicode qual) exports
-            ) ! (collapseSection "syn" False "" ++ collapseToggle "syn")
+            collapseDetails "syn" DetailsClosed (
+              thesummary << "Synopsis" +++
+              shortDeclList (
+                  mapMaybe (processExport True linksInfo unicode qual) exports
+              ) ! collapseToggle "syn" ""
+            )
 
         -- if the documentation doesn't begin with a section header, then
         -- add one ("Documentation").
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 18c8a0ff..e63667b0 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -165,9 +165,9 @@ hackMarkup fmt' h' =
       UntouchedDoc d -> (markup fmt $ _doc d, [_meta d])
       CollapsingHeader (Header lvl titl) par n nm ->
         let id_ = makeAnchorId $ "ch:" ++ fromMaybe "noid:" nm ++ show n
-            expanded = False
-            col' = collapseControl id_ expanded "caption"
-            instTable = (thediv ! collapseSection id_ expanded [] <<)
+            col' = collapseControl id_ "caption"
+            summary = thesummary ! [ theclass "hide-when-js-enabled" ] << "Expand"
+            instTable contents = collapseDetails id_ DetailsClosed (summary +++ contents)
             lvs = zip [1 .. ] [h1, h2, h3, h4, h5, h6]
             getHeader = fromMaybe caption (lookup lvl lvs)
             subCaption = getHeader ! col' << markup fmt titl
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 6993c7f6..e020b909 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -199,10 +199,10 @@ subInstances :: Qualification
              -> [(SubDecl,Located DocName)] -> Html
 subInstances qual nm lnks splice = maybe noHtml wrap . instTable
   where
-    wrap = (subSection <<) . (subCaption +++)
-    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice
+    wrap contents = subSection (collapseDetails id_ DetailsOpen (summary +++ contents))
+    instTable = subTableSrc qual lnks splice
     subSection = thediv ! [theclass "subs instances"]
-    subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
+    summary = thesummary << "Instances"
     id_ = makeAnchorId $ "i:" ++ nm
 
 
@@ -212,7 +212,7 @@ subOrphanInstances :: Qualification
 subOrphanInstances qual lnks splice  = maybe noHtml wrap . instTable
   where
     wrap = ((h1 << "Orphan instances") +++)
-    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTableSrc qual lnks splice
+    instTable = fmap (thediv ! [ identifier ("section." ++ id_) ] <<) . subTableSrc qual lnks splice
     id_ = makeAnchorId $ "orphans"
 
 
@@ -222,7 +222,7 @@ subInstHead :: String -- ^ Instance unique id (for anchor generation)
 subInstHead iid hdr =
     expander noHtml <+> hdr
   where
-    expander = thespan ! collapseControl (instAnchorId iid) False "instance"
+    expander = thespan ! collapseControl (instAnchorId iid) "instance"
 
 
 subInstDetails :: String -- ^ Instance unique id (for anchor generation)
@@ -241,7 +241,9 @@ subFamInstDetails iid fi =
 subInstSection :: String -- ^ Instance unique id (for anchor generation)
                -> Html
                -> Html
-subInstSection iid = thediv ! collapseSection (instAnchorId iid) False "inst-details"
+subInstSection iid contents = collapseDetails (instAnchorId iid) DetailsClosed (summary +++ contents)
+  where
+    summary = thesummary ! [ theclass "hide-when-js-enabled" ] << "Instance details"
 
 instAnchorId :: String -> String
 instAnchorId iid = makeAnchorId $ "i:" ++ iid
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index a8b4a4ec..a75c4b9a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -25,7 +25,8 @@ module Haddock.Backends.Xhtml.Utils (
 
   hsep, vcat,
 
-  collapseSection, collapseToggle, collapseControl,
+  DetailsState(..), collapseDetails, thesummary,
+  collapseToggle, collapseControl,
 ) where
 
 
@@ -213,26 +214,22 @@ groupId g = makeAnchorId ("g:" ++ g)
 -- A section of HTML which is collapsible.
 --
 
--- | 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_
+data DetailsState = DetailsOpen | DetailsClosed
+
+collapseDetails :: String -> DetailsState -> Html -> Html
+collapseDetails id_ state = tag "details" ! (identifier id_ : openAttrs)
+  where openAttrs = case state of { DetailsOpen -> [emptyAttr "open"]; DetailsClosed -> [] }
+
+thesummary :: Html -> Html
+thesummary = tag "summary"
 
 -- | Attributes for an area that toggles a collapsed area
-collapseToggle :: String -> [HtmlAttr]
-collapseToggle id_ = [ strAttr "onclick" js ]
-  where js = "toggleSection('" ++ id_ ++ "')";
+collapseToggle :: String -> String -> [HtmlAttr]
+collapseToggle id_ classes = [ theclass cs, strAttr "data-details-id" id_ ]
+  where cs = unwords (words classes ++ ["details-toggle"])
 
 -- | 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
+collapseControl :: String -> String -> [HtmlAttr]
+collapseControl id_ classes = collapseToggle id_ cs
+  where cs = unwords (words classes ++ ["details-toggle-control"])
\ No newline at end of file