R/download.R

In mrjoh3/ggtrack: Build tracking banners using QR codes for addition to plots and reports

#' @title Tracker Download Link
#'
#' @description Save tracker object to file and render link or button for user download
#'
#' @param tracker tracker object to be saved
#' @param save_file character vector, where length > 1, path is generated using \link[base]{file.path}
#' @param download_file character vector, where length > 1, path is generated using \link[base]{file.path}
#' @param ext character device type passed to \link[ggplot2]{ggsave}
#' @param link_text character text to appear on the page
#' @param type character must be one of "link" or "button".
#' @param height integer height value passed to \link[ggplot2]{ggsave}
#' @param height_units character units value passed to \link[ggplot2]{ggsave}
#' @param button_style css object generated by \link[htmltools]{css} or a css character
#' @param date character date add to filename. Default is \code{format(Sys.time(), "%Y%m%d-%H%M%S")}
#' @param render Boolean, render in-place or save for later
#' @param stenograph use \link[stegasaur]{lsb_encode} to enbed content within the png output.
#' @param stenograph_text character text or R object to encode using \link[stegasaur]{lsb_encode}, must be less than 2^16 bytes
#'
#' @importFrom htmltools a css
#' @importFrom glue glue
#' @importFrom stegasaur lsb_encode
#'
#' @return html of the link object
#' @export
#'
make_download <- function(tracker,
                          save_file,
                          download_file,
                          ext = 'png',
                          link_text = 'download',
                          type = c('link','button'),
                          height = 13,
                          height_units = c("cm","mm", "in"),
                          button_style = htmltools::css(background.color = 'DodgerBlue',
                                                        border = 'none',
                                                        color = 'white',
                                                        padding = '12px 30px',
                                                        cursor = 'pointer',
                                                        font.size = '16px',
                                                        width = '150px'),
                          date = format(Sys.time(), '%Y%m%d-%H%M%S'),
                          render = TRUE,
                          stenograph = FALSE) {

  if (missing(save_file)) {
    save_file <- paste0('chart_', date, '.', ext)
  } else {
    save_file <- paste0(paste(save_file, collapse = .Platform$file.sep),
                        '_', date,
                        '.', ext)
  }

  if (missing(download_file)) {
    download_file <- save_file
  } else {
    download_file <- paste0(paste(download_file, collapse = .Platform$file.sep),
                            '_', date,
                            '.', ext)
  }

  type <- match.arg(type, choices = type)
  height_units <- match.arg(height_units, choices = height_units)

  # save to file
  ggsave(save_file, tracker, device = ext, height = height, units = height_units)

  if (!isFALSE(stenograph)) {
    img <- png::readPNG(save_file)
    png::writePNG(lsb_encode(stenograph, img), save_file) # need method to pass content lsb_encode
  }

  if (type == 'link') {
    link <- htmltools::a(href = download_file,
                         download = basename(download_file),
                         link_text)
  } else if (type == 'button'){
    link <- glue::glue('<a href="{download_file}" download="{basename(download_file)}">',
                          '<button type="submit" class="btn" style="{button_style}">',
                            '<i class="fa fa-download"></i>',
                            ' {link_text}',
                          '</button>',
                       '</a>')
  }

  if (render){
    cat(as.character(link))
  }

  return(link)

}