R/generate_report.R

In bahlolab/HaplotypReportR: Generate Reports using HaplotypR

#' @importFrom rlang is_string
#' @importFrom stringr str_detect str_c
generate_report <- function(data, browse_report = TRUE) {

  exp_names <-
    c("run_name", "sample_deplex_res", "marker_deplex_table", "quality_res", "trim_merge_res", "snp_res",
      "results_rds", "out_dir", "haplotype_res")

  # check args
  stopifnot(is.list(data), all(exp_names %in% names(data)))

  message("---- generating report ----")

  output_file <- file.path(data$out_dir, str_c(make_clean_names(data$run_name), '_report.html'))
  rmd_file <- system.file(file.path('rmd', 'report.Rmd'), package = 'HaplotypReportR', mustWork = TRUE)
  rmd_env <- list2env(data, envir = new.env())

  rmarkdown::render(input = rmd_file,
                    output_file = output_file,
                    envir = rmd_env)

  if (browse_report) {
    browseURL(path.expand(output_file))
  }

  message("report save to \"", output_file, "\"")

  return(invisible(output_file))
}

#' @importFrom readr write_csv read_lines
#' @importFrom rlang is_string
#' @importFrom stringr str_c
#' @importFrom dplyr "%>%"
include_csv_download <- function(df, link_text, file_name) {

  stopifnot(is.data.frame(df), is_string(link_text), is_string(file_name))

  tmp_fn <- tempfile(fileext = '.csv')

  write_csv(df, tmp_fn)

  encoded_csv <-
    read_lines(tmp_fn) %>%
    str_c(collapse="\n") %>%
    openssl::base64_encode() %>%
    { str_c('data:text/csv;base64,', .) }

  file.remove(tmp_fn)

  html_link <-
    str_c('<a download="', file_name, '" href="', encoded_csv, '">', link_text, '</a>')

  return(html_link)
}

#' @importFrom readr write_csv read_lines
#' @importFrom rlang is_string
#' @importFrom stringr str_c
#' @importFrom dplyr "%>%"
include_fasta_download <- function(dnass, link_text, file_name) {

  stopifnot(is_string(link_text), is_string(file_name))

  tmp_fn <- tempfile(fileext = '.fa')

  Biostrings::writeXStringSet(dnass, tmp_fn)

  encoded_fa <-
    read_lines(tmp_fn) %>%
    str_c(collapse="\n") %>%
    openssl::base64_encode() %>%
    { str_c('data:text;base64,', .) }

  file.remove(tmp_fn)

  html_link <-
    str_c('<a download="', file_name, '" href="', encoded_fa, '">', link_text, '</a>')

  return(html_link)
}

#' @importFrom purrr map2_chr
#' @importFrom stringr str_c
#' @importFrom dplyr "%>%"
include_fasta_download_list <- function(dnass_list, fasta_names = names(dnass_list)) {

  map2_chr(dnass_list, fasta_names, function(dnass, nm) {
    include_fasta_download(dnass,
                           link_text = str_c('Download ', nm, ' fasta'),
                           file_name = str_c(nm, '.fasta'))}) %>%
    { str_c('<li>', ., '</li>') } %>%
    str_c(collapse = '\n') %>%
    { str_c('<ul>', ., '</ul>') }
}

#' @importFrom purrr map
include_alignment_html <- function(alignment_list) {

  alignment_html <-
    map(alignment_list, function(al) {
      fn <- tempfile(fileext = '.html')
      DECIPHER::BrowseSeqs(al, htmlFile = fn, openURL = FALSE)
      include <- htmltools::includeHTML(fn)
      file.remove(fn)
      return(include)
    })

  htmltools::tagList(alignment_html)
}