dev/generate-highcharts-api.R

In jbkunst/highcharter: A Wrapper for the 'Highcharts' Library

library(tidyverse)
library(rvest)
library(highcharter)

fout <- "dev/highcharts-api.R"

get_options <- function(url) {

  apihmtl <- read_html(url)
  
  opts <- apihmtl %>% 
    html_node("#options") %>% 
    html_nodes(".title")
  
  opts_text <- html_text(opts) %>% 
    str_trim() %>% 
    str_remove_all(":") 
  
  opts_url <- html_attr(opts, "href")
  
  dfopts <- tibble(
    option = opts_text,
    url = file.path(url, opts_url)
  )
    
}

dfopts <- c(
  "https://api.highcharts.com/highcharts",
  "https://api.highcharts.com/highstock",
  "https://api.highcharts.com/highmaps"
) %>% 
  map_df(get_options)

dfopts %>% 
  count(option) %>% 
  arrange(n)

dfopts <- distinct(dfopts, option, .keep_all = TRUE)

opts_to_remove <- c(
  "global", "lang", "noData",
  "defs", "data", "accessibility",
  "stockTools", "navigation", "time"
  )

dfopts <- dfopts %>% 
  filter(!option %in% opts_to_remove)


# run examples for each function ------------------------------------------
# run examples to check at least don't have errors
# don't assign if you want to see the outputs
dfopts %>%
  pull(option) %>%
  str_c("dev/examples-api/", ., ".R") %>%
  walk(function(script){
    
    message("Running ", script)
    try({
      source(script, echo = FALSE)
    })
        
  })


# write doc & examples ----------------------------------------------------
if(file.exists(fout)) file.remove(fout)

txt <- c(
  "# Generated by 'dev/generate-highcharts-api.R'",
  str_glue("# Generated in { dt }", dt = Sys.time()),
  "#",
  ""
)

write_lines(txt, fout)

dfopts %>% 
  pmap(function(option, url){
    
    # option <- "tooltip"
    # url <- "https://api.highcharts.com/highcharts/annotations"
    
    message(option, ": ", url)
    
    if(option == "colors") {
      
      roxy1 <- c("#' colors",
"#' ",
"#' An array containing the default colors for the chart's series. When all ",
"#' colors are used, new colors are pulled from the start again.",
"#' ")
      
    } else {
      
      doc <- read_html(url) 
      
      roxy1 <- doc %>% 
        html_node("#option-list") %>% 
        html_node("div") %>% 
        html_text() %>% 
        str_trim() %>% 
        str_split("\n", simplify = TRUE) %>% 
        str_trim() %>% 
        c("") %>% 
        str_c("#' ", .)
      
      
    }
      
    roxy1[1] <- str_c(str_to_title(roxy1[1]), " options for highcharter objects")
    
    roxy1 
    
    if(option == "tooltip") {
      
      roxy2 <- str_glue(
        "#' @param hc A `highchart` `htmlwidget` object. 
#' @param ... Arguments defined in \\url{{{url}}}. 
#' @param sort Logical value to implement sort according `this.point`
#'   \\url{{http://stackoverflow.com/a/16954666/829971}}.
#' @param table Logical value to implement table in tooltip: 
#'   \\url{{http://stackoverflow.com/a/22327749/829971}}.
#' 
#' @examples
#' ",
        url = url
      ) 
      
    } else if (option == "colors") {
      
      
      roxy2 <- c(
        "#' @param hc A `highchart` `htmlwidget` object. 
#' @param colors A vector of colors. 
#' 
#' @examples
#' ") 
      
    } else {
      
      roxy2 <- str_glue(
        "#' @param hc A `highchart` `htmlwidget` object. 
#' @param ... Arguments defined in \\url{{{url}}}. 
#' 
#' @examples
#' ",
        url = url
      ) 
      
    }
    
    roxy2
    
    roxy3 <- read_lines(str_glue("dev/examples-api/{ opt }.R", opt = option)) %>% 
      str_c("", ., "") %>% 
      str_c("#' ", .)
    
    roxy3
    
    if(option == "tooltip") {
      
      fun <- "#' 
#' @export
hc_tooltip <- function(hc, ..., sort = FALSE, table = FALSE) {
  
  if (sort)
    hc <- .hc_tooltip_sort(hc)
  
  if (table)
    hc <- .hc_tooltip_table(hc)
  
  if (length(list(...))) 
    hc <- .hc_opt(hc, \"tooltip\", ...)
  
  hc  
  
}

"
      
    } else if (option == "colors") {
      
      fun <- "#' 
#' @export
hc_colors <- function(hc, colors) {
  
  assertthat::assert_that(is.vector(colors))
  
  if (length(colors) == 1)
    colors <- list(colors)

  hc$x$hc_opts$colors <- colors
  
  hc
  
}

"
      
    } else {
      
      fun <- str_glue(
        "#' 
#' @export
hc_{ opt } <- function(hc, ...) {{
  
  .hc_opt(hc, \"{ opt }\", ...)
  
}}

",
        opt = option)
      
    }
    
    fun
    
    txt <- c(roxy1, roxy2, roxy3, fun) %>% 
      str_c(collapse = "\n") 
    
    
    write_lines(
      txt,
      fout,
      append = file.exists(fout)
      )
    
  })


message("Copying to R folder")
file.copy(
  fout, 
  file.path("R", basename(fout)),
  overwrite = TRUE
)

cli::cli_h1("devtools::document() & devtools::build()")
devtools::document()
devtools::build()