wordpress: R interface for WordPress

render_wordpress <- function(file, output_file = NULL, quiet = FALSE) {
  rmarkdown::render(
    input = file,
    output_file = output_file,
    output_format = wordpress_html(),
    quiet = quiet
  )
}

# output format -----------------------------------------------------------

wordpress_html <- function() {
  # Things that knitr renders:
  # - code chunks / output
  # - plot output
  knitr_opts <- rmarkdown::knitr_options(
    opts_chunk = list(
      class.source = "wp-block-code",
      class.output = "wp-block-code"
    ),
    knit_hooks = list(plot = knitr_plot_hook)
  )

  # Things that pandoc renders:
  # - paragraph (Para)
  # - heading (Header)
  # - code (CodeBlock)
  pandoc_opts <- rmarkdown::pandoc_options(
    to = "html",
    args = load_lua_filters()
  )

  base_format <- rmarkdown::html_fragment(section_divs = FALSE)

  rmarkdown::output_format(
    knitr = knitr_opts,
    pandoc = pandoc_opts,
    base_format = base_format,
    post_processor = post_processor
  )
}



# post process ------------------------------------------------------------

post_processor <- function(metadata, input_file, output_file, clean, verbose) {
  raw <- paste(
    "<body>",
    brio::read_file(output_file),
    "</body>"
  )

  root <- xml2::xml_find_first(xml2::read_html(raw), "//body")
  post_process_quotes(root)
  post_process_tables(root)
  post_process_code(root)

  html_fragment <- as.character(xml2::xml_contents(root))
  html_fragment <- paste(
    html_fragment[!grepl("^\\s*$", html_fragment)],
    collapse = "\n"
  )
  cat(html_fragment, "\n", sep = "", file = output_file)

  output_file
}

post_process_code <- function(root) {
  code <- xml2::xml_find_all(root, "//pre")
  xml2::xml_set_attr(code, "class", "wp-block-code")
}

post_process_quotes <- function(root) {
  quotes <- xml2::xml_find_all(root, "//blockquote")
  xml2::xml_set_attr(quotes, "class", "wp-block-quote")
}

post_process_tables <- function(root) {
  # Fix table caption
  tables <- xml2::xml_find_all(root, "//table")
  captions <- xml2::xml_find_first(tables, ".//caption")
  xml2::xml_remove(captions)
  has_caption <- !is.na(captions)

  fields <- list(tables[has_caption], xml2::xml_text(captions[has_caption]))
  purrr::pmap(fields, function(table, caption) {
    xml2::xml_add_sibling(table, "figcaption", caption)
  })

  # Fix alignment attribute / class
  cells <- xml2::xml_find_all(root, "//td[@align] | //th[@align]")
  align <- xml2::xml_attr(cells, "align")
  xml2::xml_set_attr(cells, "align", NULL)
  xml2::xml_set_attr(cells, "class", paste0("has-text-align-", align))
  xml2::xml_set_attr(cells, "data-align", align)

  # Fix row class
  rows <- xml2::xml_find_all(root, "//tr[@class]")
  xml2::xml_set_attr(rows, "class", NULL)
}


# lua filters -------------------------------------------------------------

load_lua_filters <- function() {
  lua_files <- fs::path_package("wordpress", "lua", c(
    "BulletList.lua",
    "CodeBlock.lua",
    "Header.lua",
    "Para.lua",
    "OrderedList.lua",
    "Table.lua",

    # Must be added after Para.lua
    "BlockQuote.lua"
  ))
  glue::glue("--lua-filter={lua_files}")
}

render_ast <- function(file) {
  if (tolower(fs::path_ext(file)) == "rmd") {
    output <- fs::path_ext_set(file, "md")
    file <- knitr::knit(file, output = output, quiet = TRUE)
  }
  stopifnot(fs::path_ext(file) == "md")
  path <- fs::path_ext_set(file, "json")
  rmarkdown::pandoc_convert(file, to = "json", wd = ".", output = path)
  jsonlite::write_json(jsonlite::read_json(path), path, pretty = TRUE, auto_unbox = TRUE)
  if (interactive()) {
    rstudioapi::navigateToFile(path)
  }
  invisible(path)
}


# knitr hooks -------------------------------------------------------------

knitr_plot_hook <- function(x, options) {
  tags <- htmltools::tags
  caption <- options$fig.cap
  block_class <- "wp-block-image"

  image <- tags$img(src = x)
  if (!is.null(caption)) {
    image$attribs$alt <- caption
    caption <- tags$figcaption(caption)
  }
  figure <- tags$figure(class = block_class, image, caption)

  open_comment <- "<!-- wp:image -->"
  close_comment <- "<!-- /wp:image -->"

  attributes <- list()

  align <- tryCatch(
    match.arg(options$fig.align, c("left", "center", "right", "wide", "full")),
    error = function(e) NULL
  )
  if (!is.null(align)) {
    attributes$align <- align
    align_class <- paste0("align", align)
    if (align %in% c("left", "center", "right")) {
      figure$attribs$class <- align_class
      figure <- tags$div(class = block_class, figure)
    } else if (align %in% c("wide", "full")) {
      figure$attribs$class <- paste(block_class, align_class)
    }
  }

  if (length(attributes)) {
    open_comment <- paste0(
      "<!-- wp:image ",
      jsonlite::toJSON(attributes, auto_unbox = TRUE),
      " -->"
    )
  }

  paste(open_comment, as.character(figure), close_comment, sep = "\n")
}