R/create_report.R

In MarijnJABoer/befitteR: A bundle of health, fitness, food and body related equations, formula's and more, so you can become fit

#' @title Create Report
#'
#' @description
#' \lifecycle{stable}
#'
#' Create reports based on a set of parameters using predefined skeletons.
#'
#' @param output Output file with type
#' @param title Document title
#' @param template_name Name of the template
#' @param params A list of named parameters for the R Markdown document
#' @param see_now Will launch browser if true, Default: FALSE
#' @param quiet Will hide R Markdown render messages, Default: TRUE
#' @param \dots other arguments to be passed to \link{render}
#'
#' @details Available reports are:
#' - `body`
#' - `kcal`
#'
#' @examples
#' \dontrun{
#' create_report(
#'   output = "test-body.html",
#'   title = "Body statistics",
#'   template_name = "body",
#'   params = list(
#'     name = "John Doe",
#'     weight = 80,
#'     height = 180,
#'     sex = "male",
#'     age = 30,
#'     waist = 80,
#'     neck = 35,
#'     hip = 50,
#'     desired_bmi = 23,
#'     squat = 75,
#'     bench = 50
#'   ),
#'   quiet = TRUE,
#'   see_now = FALSE
#' )
#' }
#' @rdname create_report
#' @export
#' @importFrom rmarkdown render
#' @importFrom checkmate test_file_exists
#' @importFrom here here
#' @importFrom utils browseURL
#'
create_report <-
  function(output,
           title,
           template_name,
           params,
           see_now = FALSE,
           quiet = FALSE,
           ...) {
    templates <- c("body", "kcal")
    checkmate::assert_choice(template_name, templates)
    if (template_name == "body") {
      body_param_names <-
        c(
          "name",
          "weight",
          "height",
          "sex",
          "age",
          "waist",
          "neck",
          "hip",
          "desired_bmi",
          "squat",
          "bench"
        )
      checkmate::assert_list(
        params,
        len = length(body_param_names),
        any.missing = FALSE,
        all.missing = FALSE
      )
      # TODO(MJABOER: should have a better error message)
      checkmate::assert_names(names(params), identical.to = body_param_names)
    }
    if (template_name == "kcal") {
      kcal_param_names <-
        c("name",
          "weight",
          "height",
          "sex",
          "age",
          "bfp",
          "objective",
          "effort")
      checkmate::assert_list(
        params,
        len = length(kcal_param_names),
        any.missing = FALSE,
        all.missing = FALSE
      )
      # TODO(MJABOER: should have a better error message)
      checkmate::assert_names(names(params), identical.to = kcal_param_names)
    }
    input <- system.file("rmarkdown",
                         "templates",
                         template_name,
                         "skeleton",
                         "skeleton.Rmd",
                         package = "befitteR")
    output_file <- file.path(here::here(), output)
    params <- c(params, title = title)
    rmarkdown::render(
      input = input,
      output_file = output_file,
      params = params,
      quiet = quiet,
      # Below is a fix for:
      # `Error: params object already exists in knit
      # environment so can't be overwritten by render params ``
      envir = new.env(),
      # TODO(MJABOER): Fix the use of the footer...s
      output_options = list(html_document =
                              list(include = list(
                                after_body = system.file('rmarkdown',
                                                         'templates',
                                                         'footer.html',
                                                         package = 'befitteR')
                              ))),
      encoding = "UTF-8",
      ...
    )
    # Open report?
    if (see_now) {
      # nocov start
      browseURL(output_file)
    } # nocov end
    message("\nReport is generated at \"", output_file, "\".")
  }