Custom pkgdown tweak page hooks • admiralci

Introduction

This article will go over the following:

The process for using custom hooks in R packages
Example how to create custom hooks

For more information about hooks, please read help("getHook", "base").

The examples of issues that can be solved by tweak html file:

Links broken on pkgdown site #13

Custom hooks

Currently, pkgdown does not allow the set up of any custom action. However, using custom hooks we can apply changes during execution by using the tweak_page() function to execute extra code based on the hook content.

To reproduce this behavior on local environment:

pkgdown_env <- asNamespace("pkgdown")
rlang::env_unlock(env = pkgdown_env)
rlang::env_binding_unlock(env = pkgdown_env)
# Modify tweak_page
pkgdown_env$call_hook <- function(hook_name, ...) {
  # Get hooks from base::getHook
  hooks <- getHook(paste0("UserHook::admiralci::", hook_name))
  if (!is.list(hooks)) {
    hooks <- list(hooks)
  }

  # Evaluate hooks
  purrr::map(hooks, function(fun) {
    fun(...)
  }) %>%
    invisible()
}
environment(pkgdown_env$call_hook) <- pkgdown_env

tweak_page <- body(pkgdown_env$tweak_page)
body(pkgdown_env$tweak_page) <-
  as.call(
    append(
      as.list(tweak_page),
      expression(call_hook("tweak_page", html, name, pkg)),
      after=length(tweak_page)
    )
  )

rlang::env_binding_lock(env = pkgdown_env)
rlang::env_lock(pkgdown_env)

This part is executed automatically on GitHub CI. The developer need to define only the hooks.

Creating hooks

The UserHook::admiralci::tweak_page hook should be defined as function. Please note that an error in function will stop the pkgdown from building the site. The below code showing an example of tweak_page function. The most convenient way to set up the hook is to define them in the package .onLoad event.

# Tweak page with special custom hook.
setHook("UserHook::admiralci::tweak_page", function(...) {
  html <- ..1
  name <- ..2
  pkg <- ..3
  

  links <- xml2::xml_find_all(html, ".//a")
  if (length(links) == 0)
    return(invisible())

  hrefs <- xml2::xml_attr(links, "href")
  needs_tweak <- grepl("\\.yml$", hrefs) & xml2::url_parse(hrefs)$scheme == ""

  fix_links <- function(x) {
    x <- gsub("^./", "", x)
    x <- paste0("https://github.com/pharmaverse/admiralci/blob/HEAD/", x)
  }

  if (any(needs_tweak)) {
    purrr::walk2(
      links[needs_tweak],
      fix_links(hrefs[needs_tweak]),
      xml2::xml_set_attr,
      attr = "href"
    )
  }

  invisible()
})