Fix #783 Don't show button if --quickjump not present

Author: mpilgrem

haddock-api/resources/html/haddock-bundle.min.js

@@ -45,11 +45,12 @@ class PageMenuButton extends Component<any, any> {
 
 }
 
-function addSearchPageMenuButton(action: () => void) {
-  const pageMenu = document.querySelector('#page-menu') as HTMLUListElement;
-  const dummy = document.createElement('li');
-  pageMenu.insertBefore(dummy, pageMenu.firstChild);
-  preact.render(<PageMenuButton onClick={action} title="Quick Jump" />, pageMenu, dummy);
+function addSearchPageMenuButton(quickJumpButton: HTMLLIElement) {
+  const showHide = function(action: () => void) {
+    const pageMenu = document.querySelector('#page-menu') as HTMLUListElement;
+    preact.render(<PageMenuButton onClick={action} title="Quick Jump" />, pageMenu, quickJumpButton);
+  };
+  return showHide;
 }
 
 // -------------------------------------------------------------------------- //
@@ -410,10 +411,14 @@ function NoResultsMsg(props: { searchString: string }) {
 }
 
 export function init(docBaseUrl?: string, showHide?: (action: () => void) => void) {
-  preact.render(
-    <QuickJump baseUrl={docBaseUrl || "."} showHideTrigger={showHide || addSearchPageMenuButton} />,
-    document.body
-  );
+  // A <li> element with this id should exist if --quickjump was set
+  const quickJumpButton = document.getElementById('quick-jump-button');
+  if (quickJumpButton)
+    preact.render(
+      <QuickJump baseUrl={docBaseUrl || "."} showHideTrigger={showHide ||
+        addSearchPageMenuButton(quickJumpButton as HTMLLIElement)} />,
+      document.body
+    );
 }
 
 // export to global object

haddock-api/resources/html/js-src/quick-jump.tsx

@@ -372,6 +372,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
       _ <- {-# SCC ppHtmlIndex #-}
            ppHtmlIndex odir title pkgStr
                   themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls
+                  withQuickjump
                   allVisibleIfaces pretty
       return ()
 
@@ -382,6 +383,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
       _ <- {-# SCC ppHtmlContents #-}
            ppHtmlContents dflags' odir title pkgStr
                      themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
+                     withQuickjump
                      allVisibleIfaces True prologue pretty
                      sincePkg (makeContentsQual qual)
       return ()

haddock-api/resources/html/package-lock.json

@@ -88,13 +88,15 @@ ppHtml dflags doctitle maybe_package ifaces reexported_ifaces odir prologue
   when (isNothing maybe_contents_url) $
     ppHtmlContents dflags odir doctitle maybe_package
         themes maybe_mathjax_url maybe_index_url maybe_source_url maybe_wiki_url
+        withQuickjump
         (map toInstalledIface visible_ifaces ++ reexported_ifaces)
         False -- we don't want to display the packages in a single-package contents
         prologue debug pkg (makeContentsQual qual)
 
   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 $
@@ -103,7 +105,8 @@ ppHtml dflags doctitle maybe_package ifaces reexported_ifaces odir prologue
 
   mapM_ (ppHtmlModule odir doctitle themes
            maybe_mathjax_url maybe_source_url maybe_wiki_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 ()
@@ -142,6 +145,15 @@ headHtml docTitle themes mathjax_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")
@@ -180,20 +192,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 << (
@@ -202,6 +212,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 =
@@ -267,14 +284,16 @@ ppHtmlContents
    -> Maybe String
    -> SourceURLs
    -> WikiURLs
+   -> Bool  -- ^ With Quick Jump?
    -> [InstalledInterface] -> Bool -> Maybe (MDoc GHC.RdrName)
    -> Bool
    -> Maybe Package  -- ^ Current package
    -> Qualification  -- ^ How to qualify names
    -> IO ()
 ppHtmlContents dflags odir doctitle _maybe_package
   themes mathjax_url maybe_index_url
-  maybe_source_url maybe_wiki_url ifaces showPkgs prologue debug pkg qual = do
+  maybe_source_url maybe_wiki_url withQuickjump
+  ifaces showPkgs prologue debug pkg qual = do
   let tree = mkModuleTree dflags showPkgs
          [(instMod iface, toInstalledDescription iface)
          | iface <- ifaces
@@ -287,7 +306,7 @@ ppHtmlContents dflags odir doctitle _maybe_package
         headHtml doctitle themes mathjax_url +++
         bodyHtml doctitle Nothing
           maybe_source_url maybe_wiki_url
-          Nothing maybe_index_url << [
+          Nothing maybe_index_url withQuickjump << [
             ppPrologue pkg qual doctitle prologue,
             ppSignatureTree pkg qual sig_tree,
             ppModuleTree pkg qual tree
@@ -420,11 +439,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)
 
@@ -443,7 +463,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
       headHtml (doctitle ++ " (" ++ indexName ch ++ ")") themes maybe_mathjax_url +++
       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]
@@ -541,11 +561,14 @@ ppHtmlIndex odir doctitle _maybe_package themes
 ppHtmlModule
         :: FilePath -> String -> Themes
         -> Maybe String -> SourceURLs -> WikiURLs
-        -> 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_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
@@ -565,7 +588,7 @@ ppHtmlModule odir doctitle themes
         headHtml mdl_str_annot themes maybe_mathjax_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
           ]