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 | 
