inst/app/tools/app/report_funs.R

In radiant.data: Data Menu for Radiant: Business Analytics using R and Shiny

file_upload_button <- function(inputId, label = "", multiple = FALSE,
                               accept = NULL, buttonLabel = "Load", title = "Load data",
                               class = "", icn = "upload", progress = FALSE) {
  if (getOption("radiant.shinyFiles", FALSE)) {
    shinyFiles::shinyFileChoose(
      input = input,
      id = inputId,
      session = session,
      roots = sf_volumes,
      filetype = gsub(".", "", accept, fixed = TRUE)
    )

    # actionButton(inputId, buttonLabel, icon = icon(icn), class = class)
    shinyFiles::shinyFilesButton(
      inputId, buttonLabel, label,
      title = title, multiple = FALSE,
      class = class, icon = icon(icn, verify_fa = FALSE)
    )
  } else {
    if (length(accept) > 0) {
      accept <- paste(accept, collapse = ",")
    } else {
      accept <- ""
    }

    if (!is.empty(label)) {
      label <- paste0("</br><label>", label, "</label></br>")
    }

    btn <- paste0(label, "
        <label class='input-group-btn'>
          <span class='btn btn-default btn-file-solitary ", class, "'>
            <i class='fa fa-upload'></i>
            ", buttonLabel, "
            <input id='", inputId, "' name='", inputId, "' type='file' style='display: none;' accept='", accept, "'/>
          </span>
        </label>
     ")

    if (progress) {
      btn <- paste0(btn, "\n<div id='uploadfile_progress' class='progress progress-striped active shiny-file-input-progress'>
        <div class='progress-bar'></div>
      </div>")
    }

    HTML(btn)
  }
}

## Thanks to @timelyportfolio for this comment/fix
## https://github.com/timelyportfolio/functionplotR/issues/1#issuecomment-224369431
## needed to include deps in saved reports rendered using rmarkdown
getdeps <- function() {
  htmltools::attachDependencies(
    htmltools::tagList(),
    c(
      htmlwidgets:::getDependency("DiagrammeR", "DiagrammeR"),
      htmlwidgets:::getDependency("plotly", "plotly")
    )
  )
}

## get information from rstudio editor
rstudio_context <- function(type = "rmd") {
  rse <- rstudioapi::getSourceEditorContext()
  path <- rse$path
  ext <- tools::file_ext(path)

  if (is.empty(path) || !file.exists(path) || tolower(ext) != type) {
    ## path will be empty of new file hasn't been save yet
    list(path = "", rpath = "", base = "", base_name = "", ext = "", content = "")
  } else {
    path <- normalizePath(path, winslash = "/")
    pdir <- getOption("radiant.project_dir", default = radiant.data::find_home())

    sel <- rse$selection[[1]][["text"]]
    if (is.empty(sel)) {
      content <- paste0(rse$content, collapse = "\n")
    } else {
      content <- paste0(sel, collapse = "\n")
    }

    base <- basename(path)
    base_name <- sub(paste0(".", ext), "", base)

    rpath <- if (is.empty(pdir)) {
      path
    } else {
      sub(paste0(pdir, "/"), "", path)
    }

    list(
      path = path,
      rpath = rpath,
      base = base,
      base_name = sub(paste0(".", ext, "$"), "", base),
      ext = tolower(ext),
      content = content
    )
  }
}

scrub <- . %>%
  gsub("&lt;!--/html_preserve--&gt;", "", .) %>%
  gsub("&lt;!--html_preserve--&gt;", "", .) %>%
  gsub("&lt;!&ndash;html_preserve&ndash;&gt;", "", .) %>%
  gsub("&lt;!&ndash;/html_preserve&ndash;&gt;", "", .) ## knitr adds this

setup_report <- function(report, ech, add_yml = TRUE, type = "rmd",
                         save_type = "Notebook", lib = "radiant") {
  report <- fix_smart(report) %>%
    gsub("^```\\s*\\{", "\n\n```{", .) %>%
    gsub("^```\\s*\n", "```\n\n", .) %>%
    sub("^---\n(.*?)\n---", "", .) %>%
    sub("<!--(.*?)-->", "", .)

  ## screenshot option
  sopts <- ifelse(save_type == "PDF", ",\n  screenshot.opts = list(vheight = 1200)", "")

  if (add_yml) {
    if (save_type %in% c("PDF", "Word", "Powerpoint")) {
      yml <- ""
    } else if (save_type == "HTML") {
      yml <- "---\npagetitle: HTML report\noutput:\n  html_document:\n    highlight: zenburn\n    theme: cosmo\n    df_print: paged\n    toc: yes\n---\n\n"
    } else if (save_type %in% c("Rmd", "Rmd + Data (zip)")) {
      yml <- "---\npagetitle: Rmd report\noutput:\n  html_document:\n    highlight: zenburn\n    theme: cosmo\n    df_print: paged\n    toc: yes\n    code_folding: hide\n    code_download: true\n---\n\n"
    } else {
      yml <- "---\npagetitle: Notebook report\noutput:\n  html_notebook:\n    highlight: zenburn\n    theme: cosmo\n    toc: yes\n    code_folding: hide\n---\n\n"
    }
  } else {
    yml <- ""
  }

  if (missing(ech)) {
    ech <- if (save_type %in% c("PDF", "Word", "Powerpoint", "HTML")) "FALSE" else "TRUE"
  }

  if (grepl("```{r r_setup, include = FALSE}\n", report, fixed = TRUE)) {
    report
  } else {
    paste0(yml, "```{r r_setup, include = FALSE}
## initial settings
knitr::opts_chunk$set(
  comment = NA,
  echo = ", ech, ",
  error = TRUE,
  cache = FALSE,
  message = FALSE,\n
  dpi = 96,
  warning = FALSE", sopts, "
)

## width to use when printing tables etc.
options(
  width = 250,
  scipen = 100,
  max.print = 5000,
  stringsAsFactors = FALSE
)

## make all required libraries available by loading radiant package if needed
if (is.null(shiny::getDefaultReactiveDomain())) library(", lib, ")

## include code to load the data you require
## for interactive use attach the r_data environment
# attach(r_data)
```

<style>
.btn, .form-control, pre, code, pre code {
  border-radius: 4px;
}
.table {
  width: auto;
}
ul, ol {
  padding-left: 18px;
}
code, pre, pre code {
  overflow: auto;
  white-space: pre;
  word-wrap: normal;
}
code {
  color: #c7254e;
  background-color: #f9f2f4;
}
pre {
  background-color: #ffffff;
}
</style>\n\n", report)
  }
}

## Based on http://stackoverflow.com/a/31797947/1974918
## as of 12/30/2017 doesn't seem to work anymore
knit_it_save <- function(report) {
  ## Read input and convert to Markdown
  md <- knitr::knit(text = report, envir = r_data)

  ## Get dependencies from knitr
  deps <- knitr::knit_meta()

  ## Convert script dependencies into data URIs, and stylesheet
  ## dependencies into inline stylesheets
  dep_scripts <-
    lapply(deps, function(x) {
      lapply(x$script, function(script) file.path(x$src$file, script))
    }) %>%
    unlist() %>%
    unique()
  dep_stylesheets <-
    lapply(deps, function(x) {
      lapply(x$stylesheet, function(stylesheet) file.path(x$src$file, stylesheet))
    }) %>%
    unlist() %>%
    unique()
  dep_html <- c(
    sapply(dep_scripts, function(script) {
      sprintf(
        '<script type="text/javascript" src="%s"></script>',
        base64enc::dataURI(file = script)
      )
    }),
    sapply(dep_stylesheets, function(sheet) {
      sprintf(
        "<style>%s</style>",
        paste(sshhr(readLines(sheet)), collapse = "\n")
      )
    })
  )

  ## Extract the <!--html_preserve--> bits
  preserved <- htmltools::extractPreserveChunks(md)

  ## Render the HTML, and then restore the preserved chunks
  markdown::mark_html(
    text = preserved$value,
    header = dep_html,
    options = c("mathjax", "base64_images"),
    meta = list(css = file.path(getOption("radiant.path.data"), "app/www/bootstrap.min.css"))
  ) %>%
    htmltools::restorePreserveChunks(preserved$chunks) %>%
    gsub("<table>", "<table class='table table-condensed table-hover'>", .)
}

report_clean <- function(report) {
  withProgress(message = "Cleaning report", value = 1, {
    report <- gsub("\nr_data\\[\\[\"([^\n]+?)\"\\]\\] \\%>\\%(.*?)\\%>\\%\\s*?store\\(\"(.*?)\", (\".*?\")\\)", "\n\\3 <- \\1 %>%\\2\nregister(\"\\3\", \\4)", report) %>%
      gsub("r_data\\[\\[\"([^\"]+?)\"\\]\\]", "\\1", .) %>%
      gsub("r_data\\$", "", .) %>%
      gsub("\"mean_rm\"", "\"mean\"", .) %>%
      gsub("\"median_rm\"", "\"median\"", .) %>%
      gsub("\"min_rm\"", "\"min\"", .) %>%
      gsub("\"max_rm\"", "\"max\"", .) %>%
      gsub("\"sd_rm\"", "\"sd\"", .) %>%
      gsub("\"var_rm\"", "\"var\"", .) %>%
      gsub("\"sum_rm\"", "\"sum\"", .) %>%
      gsub("\"length\"", "\"n_obs\"", .) %>%
      gsub("tabsort = \"desc\\(n\\)\"", "tabsort = \"desc\\(n_obs\\)\"", .) %>%
      gsub("Search\\(\"(.*?)\",\\s*?.\\)", "search_data(., \"\\1\")", .) %>%
      gsub("toFct\\(\\)", "to_fct()", .) %>%
      gsub("rounddf\\(", "round_df(", .) %>%
      gsub("formatnr\\(", "format_nr(", .) %>%
      gsub("formatdf\\(", "format_df(", .) %>%
      gsub("dataset\\s*=\\s*\"([^\"]+)\",", "\\1,", .) %>%
      gsub("store\\(pred, data\\s*=\\s*\"([^\"]+)\"", "\\1 <- store(\\1, pred", .) %>%
      gsub("pred_data\\s*=\\s*\"([^\"]+)\"", "pred_data = \\1", .) %>%
      gsub("(combinedata\\(\\s*?x\\s*?=\\s*?)\"([^\"]+?)\",(\\s*?y\\s*?=\\s*?)\"([^\"]+?)\",", "\\1\\2,\\3\\4,", .) %>%
      gsub("(combinedata\\((.|\n)*?),\\s*?name\\s*?=\\s*?\"([^\"`]+?)\"([^\\)]+?)\\)", "\\3 <- \\1\\4)\nregister(\"\\3\")", .) %>%
      gsub("combinedata\\(", "combine_data(", .) %>%
      gsub("result\\s*<-\\s*(simulater\\((.|\n)*?),\\s*name+\\s*=\\s*\"([^\"`]*?)\"([^\\)]*?)\\)", "\\3 <- \\1\\4)\nregister(\"\\3\")", .) %>%
      gsub("data\\s*=\\s*\"([^\"]+)\",", "data = \\1,", .) %>%
      gsub("(simulater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\nsummary\\(result", "\\1\\3\nsummary(\\4", .) %>%
      gsub("(simulater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\n(summary.*?)\nplot\\(result", "\\1\\3\n\\5\nplot(\\4", .) %>%
      gsub("result\\s*<-\\s*(repeater\\((.|\n)*?),\\s*name+\\s*=\\s*\"([^\"`]*?)\"([^\\)]*?)\\)", "\\3 <- \\1\\4)\nregister(\"\\3\")", .) %>%
      gsub("(repeater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\nsummary\\(result", "\\1\\3\nsummary(\\4", .) %>%
      gsub("(repeater\\((\n|.)*?)(register\\(\"(.*?)\"\\))\n(summary.*?)\nplot\\(result", "\\1\\3\n\\5\nplot(\\4", .) %>%
      gsub("repeater\\(((.|\n)*?),\\s*sim+\\s*=\\s*\"([^\"`]*?)\"([^\\)]*?)\\)", "repeater(\n  \\3,\\1\\4)", .) %>%
      gsub("(```\\{r.*?\\})(\nresult <- pivotr(\n|.)*?)(\\s*)store\\(result, name = \"(.*?)\"\\)", "\\1\\2\\4\\5 <- result$tab; register(\"\\5\")\\6", .) %>%
      gsub("(```\\{r.*?\\})(\nresult <- explore(\n|.)*?)(\\s*)store\\(result, name = \"(.*?)\"\\)", "\\1\\2\\4\\5 <- result$tab; register(\"\\5\")\\6", .) %>%
      gsub("store\\(result,\\s*name\\s*=\\s*\"(.*?)\",\\s*type\\s*=\\s*\"((P|I)W)\"\\)", "\\1 <- result$\\2; register(\"\\1\")", .)
  })

  # if ("styler" %in% installed.packages()) {
  #   withProgress(message = "Styling report code", value = 1, {
  #     tmp_dir <- tempdir()
  #     tmp_fn <- tempfile(pattern = "report-to-style", tmpdir = tmp_dir, fileext = ".Rmd")
  #     cat(paste(report, "\n"), file = tmp_fn)
  #     ret <- styler::style_file(tmp_fn)
  #     report <- paste0(readLines(tmp_fn), collapse = "\n")
  #   })
  # }
  removeModal()
  fix_smart(report)
}

observeEvent(input$report_clean_r, {
  shinyAce::updateAceEditor(
    session, "r_edit",
    value = report_clean(input$r_edit)
  )
})

observeEvent(input$report_clean_rmd, {
  shinyAce::updateAceEditor(
    session, "rmd_edit",
    value = report_clean(input$rmd_edit)
  )
})

observeEvent(input$report_ignore, {
  r_info[["report_ignore"]] <- TRUE
  removeModal()
})

## Knit for report in Radiant
knit_it <- function(report, type = "rmd") {
  ## may be needed on windows when text has been copy-and-pasted
  ## from a pdf
  report <- gsub("\r\n", "\n", report) %>%
    gsub("\r", "\n", .)

  if (type == "rmd") {
    report <- gsub("\\\\\\\\\\s*\n", "\\\\\\\\\\\\\\\\\n", report)
  }

  if (
    !isTRUE(r_info[["report_ignore"]]) &&
      (grepl("\\s*r_data\\[\\[\".*?\"\\]\\]", report) ||
        grepl("\\s*r_data\\$", report) ||
        grepl("\n(\\#|\\s)*store\\(result,\\s*name", report) ||
        grepl("store\\(pred,\\s*data\\s*=\\s*\"", report) ||
        grepl("\\s+data\\s*=\\s*\".*?\",", report) ||
        grepl("\\s+dataset\\s*=\\s*\".*?\",", report) ||
        grepl("\\s+pred_data\\s*=\\s*\"[^\"]+?\",", report) ||
        grepl("result\\s*<-\\s*simulater\\(", report) ||
        grepl("result\\s*<-\\s*repeater\\(", report) ||
        grepl("combinedata\\(\\s*x\\s*=\\s*\"[^\"]+?\"", report) ||
        grepl("formatnr\\(", report) ||
        grepl("formatdf\\(", report) ||
        grepl("rounddf\\(", report) ||
        grepl("tabsort = \"desc\\(n\\)\"", report) ||
        grepl("(mean_rm|median_rm|min_rm|max_rm|sd_rm|var_rm|sum_rm)", report))
  ) {
    showModal(
      modalDialog(
        title = "The report contains deprecated code",
        span(
          "The use of, e.g., r_data[[...]], dataset = \"...\", etc. in your report is
           deprecated. Click the 'Clean report' button to remove references that are no
           longer needed.", br(), br(), "Warning: It may not be possible to update all code
           to the latest standard automatically. For example, the use of 'store(...)'
           functions has changed and not all forms can be automatically updated. If this
           applies to your report a message should be shown when you Knit the report
           demonstrating how the code should be changed. You can, of course, also use the
           browser interface to recreate the code you need or use the help function in R or
           Rstudio for more information (e.g., ?radiant.model::store.model,
           ?radiant.model::store.model.predict, or ?radiant.model::simulater)", br(), br(),
          "To avoid the code-cleaning step click 'Cancel' or, if you believe the code is
           correct as-is, click the 'Ignore' button and continue to Knit your report"
        ),
        footer = tagList(
          modalButton("Cancel"),
          actionButton("report_ignore", "Ignore", title = "Ignore cleaning popup", class = "btn-primary"),
          actionButton(paste0("report_clean_", type), "Clean report", title = "Clean report", class = "btn-success")
        ),
        size = "m",
        easyClose = TRUE
      )
    )
    return(invisible())
  }

  ## fragment also available with rmarkdown
  ## https://rmarkdown.rstudio.com/html_fragment_format.html

  ## setting the working directory to use
  ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home())
  pdir <- getOption("radiant.project_dir", default = ldir)

  tdir <- tempdir()
  owd <- ifelse(is.empty(pdir), setwd(tdir), setwd(pdir))
  on.exit(setwd(owd))

  ## sizing issue with ggplotly and knitr
  ## see https://github.com/ropensci/plotly/issues/1171
  ## see also below unsuccessful fix setting height to 100%
  # if (grepl("ggplotly\\(\\)", report)) {
  #   message("\n\nHeight of ggplotly objects may not be correct in Preview. The height will be correctly displayed in saved reports however.\n\n")
  # }

  ## remove yaml headers and html comments and convert to md
  report <- sub("^---\n(.*?)\n---", "", report) %>%
    sub("<!--(.*?)-->", "", .)

  if (!grepl("```{r r_setup, include = FALSE}\n", report, fixed = TRUE)) {
    report <- paste0("```{r knit_it_setup, include = FALSE}\noptions(width = 250, scipen = 100, max.print = 5000, stringsAsFactors = FALSE)\n```\n\n", report)
  }

  ## convert to md
  md <- knitr::knit(
    text = report,
    envir = r_data,
    quiet = TRUE
  )

  ## removing fig.caps for unnamed chunks
  md <- gsub("<p class=\"caption\">plot of chunk unnamed-chunk-[0-9]+</p>", "", md)

  ## add basic styling to tables
  paste(
    markdown::mark_html(text = md, template = FALSE, meta = list(css = ""), output = FALSE),
    paste0("<script type='text/javascript' src='", getOption("radiant.mathjax.path"), "/MathJax.js?config=TeX-AMS-MML_HTMLorMML'></script>"),
    "<script>if (window.MathJax) MathJax.Hub.Typeset();</script>",
    sep = "\n"
  ) %>%
    gsub("<table>", "<table class='table table-condensed table-hover'>", .) %>%
    ## makes plots full height of screen (i.e., WAY too big)
    # gsub("style=\"width:100%; height:400px; \" class=\"plotly html-widget",
    # "style=\"width:100%; height:100%; \" class=\"plotly html-widget", ., fixed = TRUE) %>%
    scrub() %>%
    HTML()
}

sans_ext <- function(path) {
  sub(
    "(\\.state\\.rda|\\.rda$|\\.rds$|\\.rmd$|\\.r$|\\.rdata$|\\.html|\\.nb\\.html|\\.pdf|\\.docx|\\.pptx|\\.rmd|\\.zip)", "",
    tolower(path),
    ignore.case = TRUE
  )
}

report_name <- function(type = "rmd", out = "report", full.name = FALSE) {
  ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home())
  pdir <- getOption("radiant.project_dir", default = ldir)

  ## generate report name based on state or project name
  if (input[[paste0(type, "_generate")]] %in% c("To Rmd", "To R")) {
    fn <- r_state[[paste0("radiant_", type, "_name")]]
  } else {
    fn <- ""
  }

  if (is.empty(fn)) {
    fn <- state_name()
    fn <- sans_ext(fn) %>%
      sub("-state", paste0("-", out), .)

    r_state[[paste0("radiant_", type, "_name")]] <<-
      paste(fn, sep = ".", switch(type,
        rmd = "Rmd",
        r = "R"
      ))
  } else {
    fn <- basename(fn) %>%
      sans_ext()
  }

  if (full.name) {
    file.path(pdir, fn)
  } else {
    fn
  }
}

report_save_filename <- function(type = "rmd", full.name = TRUE) {
  req(input[[paste0(type, "_generate")]])

  if (input[[paste0(type, "_generate")]] %in% c("To Rmd", "To R")) {
    cnt <- rstudio_context(type = type)
    if (!is.empty(cnt$path)) {
      if (cnt$path != cnt$rpath) {
        r_state[[paste0("radiant_", type, "_name")]] <<- cnt$rpath
      } else {
        r_state[[paste0("radiant_", type, "_name")]] <<- cnt$path
      }

      if (full.name) {
        fn <- cnt$path
      } else {
        fn <- cnt$base_name
      }
    } else {
      fn <- report_name(type = type, full.name = full.name)
    }
  } else {
    fn <- report_name(type = type, full.name = full.name)
  }

  fn <- sans_ext(fn)

  paste(fn, sep = ".", switch(input[[paste0(type, "_save_type")]],
    Notebook = "nb.html",
    HTML = "html",
    PDF = "pdf",
    Word = "docx",
    Powerpoint = "pptx",
    Rmd = "Rmd",
    `Rmd + Data (zip)` = "zip",
    R = "R",
    `R + Data (zip)` = "zip"
  ))
}

report_save_content <- function(file, type = "rmd") {
  if (isTRUE(getOption("radiant.report"))) {
    isolate({
      ldir <- getOption("radiant.launch_dir", default = radiant.data::find_home())
      pdir <- getOption("radiant.project_dir", default = ldir)

      tdir <- tempdir()
      owd <- ifelse(is.empty(pdir), setwd(tdir), setwd(pdir))
      on.exit(setwd(owd))

      save_type <- input[[paste0(type, "_save_type")]]
      generate <- input[[paste0(type, "_generate")]]

      zip_info <- getOption("radiant.zip")
      if (save_type %in% c("Rmd + Data (zip)", "R + Data (zip)")) {
        if (is.empty(zip_info)) {
          ## No zip warning
          showModal(
            modalDialog(
              title = "ZIP attempt failed",
              span(
                "There is no zip utility in the path on this system. Please install a zip utility (e.g., 7-zip) and try again"
              ),
              footer = modalButton("OK"),
              size = "m",
              easyClose = TRUE
            )
          )
          return(invisible())
        }
      }

      lib <- if ("radiant" %in% installed.packages()) "radiant" else "radiant.data"

      if (generate %in% c("To Rmd", "To R")) {
        cnt <- rstudio_context(type)
        if (is.empty(cnt$path) || !cnt$ext == type) {
          if (generate == "To Rmd") {
            report <- "#### Radiant is set to use an rmarkdown document in Rstudio ('To Rmd').\n#### Please check that you have an .Rmd file open in Rstudio and that the file has been saved to disk.\n#### If you want to use the editor in Radiant instead, change 'To Rmd' to 'Auto paste' or 'Manual paste'."
          } else {
            report <- "#### Radiant is set to use an R-code document in Rstudio ('To R').\n#### Please check that you have an .R file open in Rstudio and that the file has been saved to disk.\n#### If you want to use the editor in Radiant instead, change 'To R' to 'Auto paste' or 'Manual paste'."
          }
        } else {
          report <- cnt$content
        }
      } else {
        report <- input[[paste0(type, "_edit")]]
      }

      if (save_type == "Rmd + Data (zip)") {
        withProgress(message = "Preparing Rmd + Data zip file", value = 1, {
          ## don't want to write to current dir
          currdir <- setwd(tempdir())
          save(list = ls(envir = r_data), envir = r_data, file = "r_data.rda")

          setup_report(report, save_type = "Rmd", lib = lib) %>%
            fix_smart() %>%
            cat(file = "report.Rmd", sep = "\n")

          zip(file, c("report.Rmd", "r_data.rda"),
            flags = zip_info[1], zip = zip_info[2]
          )
          setwd(currdir)
        })
      } else if (save_type == "R + Data (zip)") {
        withProgress(message = "Preparing R + Data zip file", value = 1, {
          ## don't want to write to current dir
          currdir <- setwd(tempdir())
          save(list = ls(envir = r_data), envir = r_data, file = "r_data.rda")

          cat(report, file = "report.R", sep = "\n")

          zip(file, c("report.R", "r_data.rda"),
            flags = zip_info[1], zip = zip_info[2]
          )
          setwd(currdir)
        })
      } else if (save_type == "Rmd") {
        setup_report(report, save_type = "Rmd", lib = lib) %>%
          fix_smart() %>%
          cat(file = file, sep = "\n")
      } else if (save_type == "R") {
        cat(report, file = file, sep = "\n")
      } else {
        if (file.access(getwd(), mode = 2) == -1) {
          ## A writable working directory is required to save reports
          showModal(
            modalDialog(
              title = "Working directory is not writable",
              HTML(
                paste0(
                  "<span>
                    The working directory used by radiant (\"", getwd(), "\") is not writable. This is required to save a report.
                    To save reports, restart radiant from a writable directory. Preferaby by setting up an Rstudio
                    project folder. See <a href='https://support.posit.co/hc/en-us/articles/200526207-Using-Projects' target='_blank'>
                    https://support.posit.co/hc/en-us/articles/200526207-Using-Projects</a> for more information
                  </span>"
                )
              ),
              footer = modalButton("OK"),
              size = "m",
              easyClose = TRUE
            )
          )
          return(invisible())
        }

        ## hack for rmarkdown from Report > Rmd and Report > R
        options(radiant.rmarkdown = TRUE)

        if (type == "r") {
          report <- paste0("\n```{r echo = TRUE}\n", report, "\n```\n")
        }

        init <- setup_report(report, save_type = save_type, lib = lib) %>%
          fix_smart()

        ## on linux ensure you have you have pandoc > 1.14 installed
        ## you may need to use http://pandoc.org/installing.html#installing-from-source
        ## also check the logs to make sure its not complaining about missing files
        withProgress(message = paste0("Saving report to ", save_type), value = 1, {
          if (isTRUE(rmarkdown::pandoc_available())) {
            ## have to use current dir so (relative) paths work properly
            tmp_fn <- tempfile(pattern = "report-", tmpdir = ".", fileext = ".Rmd")
            cat(init, file = tmp_fn, sep = "\n")

            if (!save_type %in% c("Notebook", "HTML")) {
              oop <- knitr::opts_chunk$get()$screenshot.force
              knitr::opts_chunk$set(screenshot.force = TRUE)
              on.exit(knitr::opts_chunk$set(screenshot.force = oop))
            }

            out <- rmarkdown::render(
              tmp_fn,
              switch(save_type,
                Notebook = rmarkdown::html_notebook(highlight = "zenburn", theme = "cosmo", code_folding = "hide"),
                HTML = rmarkdown::html_document(highlight = "zenburn", theme = "cosmo", code_download = TRUE, df_print = "paged"),
                PDF = rmarkdown::pdf_document(),
                Word = rmarkdown::word_document(
                  reference_docx = getOption("radiant.word_style", default = file.path(system.file(package = "radiant.data"), "app/www/style.docx")),
                ),
                Powerpoint = rmarkdown::powerpoint_presentation(
                  reference_doc = getOption("radiant.powerpoint_style", default = file.path(system.file(package = "radiant.data"), "app/www/style.potx"))
                )
              ),
              envir = r_data, quiet = TRUE, encoding = "UTF-8",
              output_options = list(pandoc_args = "--quiet")
            )
            ## no using file.rename as it may fail to overwrite even if confirmed by the users
            file.copy(out, file, overwrite = TRUE)
            file.remove(out, tmp_fn)
          } else {
            ## still needed because rmarkdown requires pandoc
            setup_report(report, add_yml = FALSE, type = save_type, lib = lib) %>%
              fix_smart() %>%
              knit_it_save() %>%
              cat(file = file, sep = "\n")
          }
        })

        ## hack for rmarkdown from Report > Rmd and Report > R
        options(radiant.rmarkdown = FALSE)
      }
    })
  }
}

## updating the report when called
update_report <- function(inp_main = "", fun_name = "", inp_out = list("", ""),
                          cmd = "", pre_cmd = "result <- ", post_cmd = "",
                          xcmd = "", outputs = c("summary", "plot"), inp = "result",
                          wrap, figs = TRUE, fig.width = 7, fig.height = 7) {
  ## determine number of characters for main command for wrapping
  if (missing(wrap)) {
    lng <- nchar(pre_cmd) + nchar(fun_name) + nchar(post_cmd) + 2
    if (!is.empty(inp_main)) {
      lng <- lng + sum(nchar(inp_main)) +
        sum(nchar(names(inp_main))) +
        length(inp_main) * 5 - 1
    }
    wrap <- ifelse(lng > 70, TRUE, FALSE)
  }

  dctrl <- getOption("dctrl")

  ## wrapping similar to styler
  depr <- function(x, wrap = FALSE) {
    cutoff <- ifelse(wrap, 20L, 55L)
    for (i in names(x)) {
      tmp <- x[[i]]
      wco <- ifelse(max(nchar(tmp)) > cutoff, cutoff, 55L)
      if (inherits(tmp, "fractions")) {
        if (length(tmp) > 1) {
          tmp <- paste0("c(", paste(tmp, collapse = ", "), ")")
        } else {
          tmp <- as.character(tmp)
        }
      } else {
        tmp <- deparse(tmp, control = dctrl, width.cutoff = wco)
      }
      if ((nchar(i) + sum(nchar(tmp)) < 70) | (length(tmp) == 2 & tmp[2] == ")")) {
        tmp <- paste0(tmp, collapse = "")
      }
      if (length(tmp) > 1) {
        if (grepl("^c\\(", tmp[1])) {
          tmp <- c("c(", sub("^c\\(", "", tmp))
        } else {
          tmp <- c("list(", sub("^list\\(", "", tmp))
        }
        if (tail(tmp, 1) != ")") {
          tmp <- c(sub("\\)$", "", tmp), ")")
        }
      }
      x[[i]] <- sub("^\\s+", "", tmp) %>%
        paste0(collapse = "\n    ") %>%
        sub("[ ]+\\)", "  \\)", .)
    }

    if (wrap) {
      x <- paste0(paste0(paste0("\n  ", names(x)), " = ", x), collapse = ", ")
      x <- paste0("list(", x, "\n)")
    } else {
      x <- paste0(paste0(names(x), " = ", x), collapse = ", ")
      x <- paste0("list(", x, ")")
    }
    x
  }

  if (inp_main[1] != "") {
    cmd <- depr(inp_main, wrap = wrap) %>%
      sub("list", fun_name, .) %>%
      paste0(pre_cmd, .) %>%
      paste0(., post_cmd) %>%
      sub("dataset = \"([^\"]+)\"", "\\1", .)
  }

  lout <- length(outputs)
  if (lout > 0) {
    for (i in seq_len(lout)) {
      if (inp %in% names(inp_out[[i]])) {
        inp_rep <- inp
        inp <- inp_out[[i]][[inp]]
        inp_out[[i]][inp_rep] <- NULL
      }
      if (!is.empty(outputs[i])) {
        if (inp_out[i] != "" && length(inp_out[[i]]) > 0) {
          if (sum(nchar(inp_out[[i]])) > 40L) {
            cmd <- depr(inp_out[[i]], wrap = TRUE) %>%
              sub("list\\(", paste0(outputs[i], "\\(\n  ", inp, ", "), .) %>%
              paste0(cmd, "\n", .)
          } else {
            cmd <- deparse(inp_out[[i]], control = dctrl, width.cutoff = 500L) %>%
              sub("list\\(", paste0(outputs[i], "\\(", inp, ", "), .) %>%
              paste0(cmd, "\n", .)
          }
        } else {
          cmd <- paste0(cmd, "\n", outputs[i], "(", inp, ")")
        }
      }
    }
  }

  if (xcmd != "") cmd <- paste0(cmd, "\n", xcmd)

  ## make into chunks if needed
  if (length(input$rmd_generate) == 0) {
    type <- ifelse(state_init("r_generate", "Use Rmd") == "Use Rmd", "rmd", "r")
  } else {
    type <- ifelse(state_init("rmd_generate", "auto") == "Use R", "r", "rmd")
  }

  if (type == "r") {
    update_report_fun(cmd, type = "r")
  } else {
    if (figs) {
      cmd <- paste0("\n```{r fig.width = ", round(7 * fig.width / 650, 2), ", fig.height = ", round(7 * fig.height / 650, 2), ", dpi = 96}\n", cmd, "\n```\n")
    } else {
      cmd <- paste0("\n```{r}\n", cmd, "\n```\n")
    }
    if (!is.empty(r_info[["latest_screenshot"]])) {
      cmd <- paste0(r_info[["latest_screenshot"]], "\n", cmd)
    }
    update_report_fun(cmd, type = "rmd")
  }
}

update_report_fun <- function(cmd, type = "rmd", rfiles = FALSE) {
  isolate({
    generate <- paste0(type, "_generate")
    sinit <- state_init(generate, "auto")
    editor <- paste0(type, "_edit")
    sel <- ifelse(type == "rmd", "Rmd", "R")
    if (sinit == "manual") {
      os_type <- Sys.info()["sysname"]
      if (os_type == "Windows") {
        withProgress(message = "Putting command in clipboard", value = 1, {
          cat(cmd, file = "clipboard")
        })
      } else if (os_type == "Darwin") {
        withProgress(message = "Putting command in clipboard", value = 1, {
          out <- pipe("pbcopy")
          cat(cmd, file = out)
          close(out)
        })
      } else if (os_type == "Linux") {
        showModal(
          modalDialog(
            title = "Copy-and-paste the code shown below",
            pre(cmd),
            footer = modalButton("Cancel"),
            size = "m",
            easyClose = TRUE
          )
        )
      }
    } else if (sinit == "To Rmd") {
      withProgress(message = "Putting code chunk in Rstudio", value = 1, {
        rstudioapi::insertText(Inf, fix_smart(cmd))
      })
    } else if (sinit == "To R") {
      withProgress(message = "Putting R-code in Rstudio", value = 1, {
        gsub("(```\\{.*\\}\n)|(```\n)", "", fix_smart(paste0("\n", cmd, "\n"))) %>%
          rstudioapi::insertText(Inf, .)
      })
    } else {
      if (is.empty(r_state[[editor]])) {
        r_state[[editor]] <<- paste0("## Your report title\n\n", cmd)
      } else {
        r_state[[editor]] <<- paste0(fix_smart(r_state[[editor]]), "\n", cmd)
      }
      withProgress(message = paste0("Updating Report > ", sel), value = 1, {
        shinyAce::updateAceEditor(
          session, editor,
          value = fix_smart(r_state[[editor]])
        )
      })
    }

    if (!rfiles) {
      if (state_init(paste0(type, "_switch"), "switch") == "switch") {
        updateTabsetPanel(session, "nav_radiant", selected = sel)
      }
    }
  })
}