Merge remote-tracking branch 'origin/master' into ghc-head

4 files changed, 55 insertions, 28 deletions

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/Meta.hs b/haddock-api/src/Haddock/Backends/Xhtml/Meta.hs
new file mode 100644
index 00000000..621bdd41
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Meta.hs
@@ -0,0 +1,28 @@
+module Haddock.Backends.Xhtml.Meta where
+
+import Haddock.Utils.Json
+import Haddock.Version
+
+import Data.ByteString.Builder (hPutBuilder)
+import System.FilePath ((</>))
+import System.IO (withFile, IOMode (WriteMode))
+
+-- | Everytime breaking changes to the Quckjump api
+-- happen this needs to be modified.
+quickjumpVersion :: Int
+quickjumpVersion = 1
+
+-- | Writes a json encoded file containing additional
+-- information about the generated documentation. This
+-- is useful for external tools (e.g. hackage).
+writeHaddockMeta :: FilePath -> Bool -> IO ()
+writeHaddockMeta odir withQuickjump = do
+  let
+    meta_json :: Value
+    meta_json = object (concat [
+        [ "haddock_version"   .= String projectVersion ]
+      , [ "quickjump_version" .= quickjumpVersion | withQuickjump ]
+      ])
+
+  withFile (odir </> "meta.json") WriteMode $ \h ->
+    hPutBuilder h (encodeToBuilder meta_json)
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