aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock.hs3
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs51
2 files changed, 39 insertions, 15 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 7ed43ad2..664168f1 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -435,6 +435,7 @@ render logger dflags unit_state flags sinceQual qual ifaces packages extSrcMap =
_ <- {-# SCC ppHtmlIndex #-}
ppHtmlIndex odir title pkgStr
themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls
+ withQuickjump
(concatMap piInstalledInterfaces allVisiblePackages) pretty
return ()
@@ -446,6 +447,7 @@ render logger dflags unit_state flags sinceQual qual ifaces packages extSrcMap =
_ <- {-# SCC ppHtmlContents #-}
ppHtmlContents unit_state odir title pkgStr
themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
+ withQuickjump
allVisiblePackages True prologue pretty
sincePkg (makeContentsQual qual)
return ()
@@ -778,4 +780,3 @@ getPrologue dflags flags =
rightOrThrowE :: Either String b -> IO b
rightOrThrowE (Left msg) = throwE msg
rightOrThrowE (Right x) = pure x
-
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 3dc1e8da..4cc6aa77 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -97,6 +97,7 @@ ppHtml state doctitle maybe_package ifaces reexported_ifaces odir prologue
when (isNothing maybe_contents_url) $
ppHtmlContents state odir doctitle maybe_package
themes maybe_mathjax_url maybe_index_url maybe_source_url maybe_wiki_url
+ withQuickjump
[PackageInterfaces
{ piPackageInfo = packageInfo
, piVisibility = Visible
@@ -109,6 +110,7 @@ ppHtml state doctitle maybe_package ifaces reexported_ifaces odir prologue
when (isNothing maybe_index_url) $ do
ppHtmlIndex odir doctitle maybe_package
themes maybe_mathjax_url maybe_contents_url maybe_source_url maybe_wiki_url
+ withQuickjump
(map toInstalledIface visible_ifaces ++ reexported_ifaces) debug
when withQuickjump $
@@ -117,7 +119,8 @@ ppHtml state doctitle maybe_package ifaces reexported_ifaces odir prologue
mapM_ (ppHtmlModule odir doctitle themes
maybe_mathjax_url maybe_source_url maybe_wiki_url maybe_base_url
- maybe_contents_url maybe_index_url unicode pkg qual debug) visible_ifaces
+ maybe_contents_url maybe_index_url withQuickjump
+ unicode pkg qual debug) visible_ifaces
copyHtmlBits :: FilePath -> FilePath -> Themes -> Bool -> IO ()
@@ -163,6 +166,15 @@ headHtml docTitle themes mathjax_url base_url =
, "}"
, "});" ]
+quickJumpButtonLi :: Bool -- ^ With Quick Jump?
+ -> Maybe Html
+-- The TypeScript should replace this <li> element, given its id. However, in
+-- case it does not, the element is given content here too.
+quickJumpButtonLi True = Just $ li ! [identifier "quick-jump-button"]
+ << anchor ! [href "#"] << "Quick Jump"
+
+quickJumpButtonLi False = Nothing
+
srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton (Just src_base_url, _, _, _) Nothing =
Just (anchor ! [href src_base_url] << "Source")
@@ -201,20 +213,18 @@ indexButton maybe_index_url
bodyHtml :: String -> Maybe Interface
-> SourceURLs -> WikiURLs
-> Maybe String -> Maybe String
+ -> Bool -- ^ With Quick Jump?
-> Html -> Html
bodyHtml doctitle iface
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url
+ withQuickjump
pageContent =
body << [
divPackageHeader << [
nonEmptySectionName << doctitle,
- unordList (catMaybes [
- srcButton maybe_source_url iface,
- wikiButton maybe_wiki_url (ifaceMod <$> iface),
- contentsButton maybe_contents_url,
- indexButton maybe_index_url])
- ! [theclass "links", identifier "page-menu"]
+ ulist ! [theclass "links", identifier "page-menu"]
+ << catMaybes (quickJumpButtonLi withQuickjump : otherButtonLis)
],
divContent << pageContent,
divFooter << paragraph << (
@@ -223,6 +233,13 @@ bodyHtml doctitle iface
(" version " ++ projectVersion)
)
]
+ where
+ otherButtonLis = (fmap . fmap) (li <<)
+ [ srcButton maybe_source_url iface
+ , wikiButton maybe_wiki_url (ifaceMod <$> iface)
+ , contentsButton maybe_contents_url
+ , indexButton maybe_index_url
+ ]
moduleInfo :: Interface -> Html
moduleInfo iface =
@@ -285,6 +302,7 @@ ppHtmlContents
-> Maybe String
-> SourceURLs
-> WikiURLs
+ -> Bool -- ^ With Quick Jump?
-> [PackageInterfaces] -> Bool -> Maybe (MDoc GHC.RdrName)
-> Bool
-> Maybe Package -- ^ Current package
@@ -292,7 +310,8 @@ ppHtmlContents
-> IO ()
ppHtmlContents state odir doctitle _maybe_package
themes mathjax_url maybe_index_url
- maybe_source_url maybe_wiki_url packages showPkgs prologue debug pkg qual = do
+ maybe_source_url maybe_wiki_url withQuickjump
+ packages showPkgs prologue debug pkg qual = do
let trees =
[ ( piPackageInfo pinfo
, mkModuleTree state showPkgs
@@ -317,7 +336,7 @@ ppHtmlContents state odir doctitle _maybe_package
headHtml doctitle themes mathjax_url Nothing +++
bodyHtml doctitle Nothing
maybe_source_url maybe_wiki_url
- Nothing maybe_index_url << [
+ Nothing maybe_index_url withQuickjump << [
ppPrologue pkg qual doctitle prologue,
ppSignatureTrees pkg qual sig_trees,
ppModuleTrees pkg qual trees
@@ -531,11 +550,12 @@ ppHtmlIndex :: FilePath
-> Maybe String
-> SourceURLs
-> WikiURLs
+ -> Bool -- ^ With Quick Jump?
-> [InstalledInterface]
-> Bool
-> IO ()
ppHtmlIndex odir doctitle _maybe_package themes
- maybe_mathjax_url maybe_contents_url maybe_source_url maybe_wiki_url ifaces debug = do
+ maybe_mathjax_url maybe_contents_url maybe_source_url maybe_wiki_url withQuickjump ifaces debug = do
let html = indexPage split_indices Nothing
(if split_indices then [] else index)
@@ -554,7 +574,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
headHtml (doctitle ++ " (" ++ indexName ch ++ ")") themes maybe_mathjax_url Nothing +++
bodyHtml doctitle Nothing
maybe_source_url maybe_wiki_url
- maybe_contents_url Nothing << [
+ maybe_contents_url Nothing withQuickjump << [
if showLetters then indexInitialLetterLinks else noHtml,
if null items then noHtml else
divIndex << [sectionName << indexName ch, buildIndex items]
@@ -652,11 +672,14 @@ ppHtmlIndex odir doctitle _maybe_package themes
ppHtmlModule
:: FilePath -> String -> Themes
-> Maybe String -> SourceURLs -> WikiURLs -> BaseURL
- -> Maybe String -> Maybe String -> Bool -> Maybe Package -> QualOption
+ -> Maybe String -> Maybe String
+ -> Bool -- ^ With Quick Jump?
+ -> Bool -> Maybe Package -> QualOption
-> Bool -> Interface -> IO ()
ppHtmlModule odir doctitle themes
maybe_mathjax_url maybe_source_url maybe_wiki_url maybe_base_url
- maybe_contents_url maybe_index_url unicode pkg qual debug iface = do
+ maybe_contents_url maybe_index_url withQuickjump
+ unicode pkg qual debug iface = do
let
mdl = ifaceMod iface
aliases = ifaceModuleAliases iface
@@ -676,7 +699,7 @@ ppHtmlModule odir doctitle themes
headHtml mdl_str_annot themes maybe_mathjax_url maybe_base_url +++
bodyHtml doctitle (Just iface)
maybe_source_url maybe_wiki_url
- maybe_contents_url maybe_index_url << [
+ maybe_contents_url maybe_index_url withQuickjump << [
divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str_linked)),
ifaceToHtml maybe_source_url maybe_wiki_url iface unicode pkg real_qual
]
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 18:06:40 +0000