diff options
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs | 6 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Layout.hs | 14 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Meta.hs | 28 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 35 |
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 |