################################################################
# Create dynamic reports using Radiant and the shinyAce editor
################################################################
rmd_switch <- c("Switch tab", "Don't switch tab")
rmd_manual <- c("Manual paste", "Auto paste")
rmd_report_choices <- c("HTML","Rmd")
if (rstudioapi::isAvailable() || (!isTRUE(getOption("radiant.local")) && !is.null(session$user))) {
  rmd_manual <- c(rmd_manual, "To Rmd", "To R")
  rmd_report_choices <- c("HTML","PDF","Word","Rmd")
}

rmd_report_choices %<>% c(.,"Rmd & Data (zip)")
rmd_example <- "## Sample report

This is an example of the type of report you can write in Radiant.

* You can create
* bullet lists

1. And numbered
2. lists

### Math

You can even include math if you want:

$$y_t = \\alpha + \\beta x_t + \\epsilon_t.$$

To show the output press the `Knit report` button.

### Documenting analysis results in Radiant

The report feature in Radiant should be used in conjunction with the <i title='Report results' class='fa fa-edit'></i> icons shown at the bottom of the side bar on (almost) all pages. When that icon is clicked the command used to create the ouput is copied into the editor in the _R > Report_ tab. By default Radiant will paste the code generated for the analysis you just completed at the bottom of the report (i.e., `Auto paste`). However, you can turn off that feature by selecting `Manual paste` from the dropown. With manual paste on, the code is put in the clipboard when you click a report icon and you can paste it where you want in the _R > Report_ editor window.

By clicking the `Knit report` button or pressing CTRL-return (CMD-return on Mac), the output from the analysis will be recreated. You can add text, bullets, headers, etc. around the code blocks to describe and explain the results using <a href='http://rmarkdown.rstudio.com/authoring_pandoc_markdown.html' target='_blank'>markdown</a>. You can also select part of the report you want to render.

Below is some code generated by Radiant to produce a scatterplot / heatmap of the price of diamonds versus carats. The colors in the plot reflect the clarity of the diamond.

```{r fig.width=7, fig.height=7, dpi = 72}
visualize(dataset = 'diamonds', xvar = 'carat', yvar = 'price',
          type = 'scatter', color = 'clarity')
```

> **Put your own code here or delete this sample report and create your own**
"

output$ui_rmd_manual <- renderUI({
  selectInput(inputId = "rmd_manual", label = NULL,
    choices = rmd_manual,
    selected = state_init("rmd_manual", "Auto paste"),
    multiple = FALSE, selectize = FALSE,
    width = "120px")
})

output$ui_rmd_switch <- renderUI({
  req(input$rmd_manual)
  if (!input$rmd_manual %in% c("Manual paste","Auto paste"))
    init <- "Don't switch tab"
  else
    init <- "Switch tab"
  selectInput(inputId = "rmd_switch", label = NULL,
    choices = rmd_switch,
    selected = state_init("rmd_switch", init),
    multiple = FALSE, selectize = FALSE,
    width = "140px")
})

observeEvent(input$rmd_manual, {
  if(!input$rmd_manual %in% c("Manual paste","Auto paste"))
    updateSelectInput(session, "rmd_switch", select = "Don't switch tab")
})

output$ui_rmd_save_report <- renderUI({
  local <- getOption("radiant.local")
  if (isTRUE(local) || (!isTRUE(local) && !is.null(session$user))) {
    selectInput(inputId = "rmd_save_report", label = NULL,
      choices = rmd_report_choices,
      selected = state_init("rmd_save_report", "HTML"),
      multiple = FALSE, selectize = FALSE,
      width = "105px")
  } else {
    invisible()
  }
})

output$ui_saveReport <- renderUI({
  local <- getOption("radiant.local")
  if (isTRUE(local) || (!isTRUE(local) && !is.null(session$user))) {
    downloadButton("saveReport", "Save report")
  } else {
    invisible()
  }
})

esc_slash <- function(x) gsub("([^\\])\\\\([^\\\\$])","\\1\\\\\\\\\\2",x)

## Thanks to @timelyportfolio for this comment/fix
## https://github.com/timelyportfolio/functionplotR/issues/1#issuecomment-224369431
getdeps <- function() {
  htmltools::attachDependencies(
    htmltools::tagList(),
    c(
      htmlwidgets:::getDependency("DiagrammeR","DiagrammeR"),
      htmlwidgets:::getDependency("datatables","DT")
    )
  )
}

output$report <- renderUI({
  init <- isolate(if (is_empty(input$rmd_report)) rmd_example else esc_slash(input$rmd_report))
  tagList(
    with(tags,
      table(
        td(help_modal('Report','report_help',
           inclMD(file.path(getOption("radiant.path.data"),"app/tools/help/report.md")))),
        td(HTML("&nbsp;&nbsp;")),
        td(actionButton("evalRmd", "Knit report"), style= "padding-top:5px;"),
        td(uiOutput("ui_rmd_manual")),
        td(uiOutput("ui_rmd_switch")),
        td(uiOutput("ui_rmd_save_report")),
        td(uiOutput("ui_saveReport"), style= "padding-top:5px;"),
        td(HTML("<div class='form-group shiny-input-container'>
            <input id='load_rmd' name='load_rmd' type='file' accept='.rmd,.Rmd,.md'/>
          </div>"))
      )
    ),
    shinyAce::aceEditor("rmd_report", mode = "markdown",
      vimKeyBinding = getOption("radiant.vim.keys", default = FALSE),
      wordWrap = TRUE, height = "auto", selectionId = "rmd_selection",
      value = state_init("rmd_report", init) %>% esc_slash,
      hotkeys = list(runKeyRmd = list(win = "CTRL-ENTER", mac = "CMD-ENTER"))),
    htmlOutput("rmd_knitted"),
    getdeps()
  )
})

valsRmd <- reactiveValues(knit = 0)
observe({
  input$runKeyRmd
  if (!is.null(input$evalRmd)) isolate(valsRmd$knit <- valsRmd$knit + 1)
})

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

## cleanout widgets not needed outside shiny apps
# cleanout <- function(x) {
#   gsub("%>%\\s*render\\(\\.\\)", "", x) %>%
#   gsub("%>%\\s*render", "", .) %>%
#   gsub("[^A-Za-z]render\\((.*)\\)", "\\1", .) %>%
#   gsub("^render\\((.*)\\)", "\\1", .)
# }
# "test = render(lklklk)" %>% cleanout
# "%>% render" %>% cleanout
# "%>% render(.)" %>% cleanout
# "render(lklklk)" %>% cleanout

cleanout <- . %>%
  gsub("DiagrammeR::renderDiagrammeR", "", .) %>% ## leave for legacy reasons
  gsub("DT::renderDataTable", "", .) %>%          ## leave for legacy reasons
  gsub("render(", "(", ., fixed = TRUE)

## Based on http://stackoverflow.com/a/31797947/1974918
knitItSave <- function(text) {

  ## Read input and convert to Markdown
  md <- knitr::knit(text = paste0("\n`r options(width = 250)`\n",cleanout(text)), envir = r_environment)

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

  ## not sure how to use knit_meta_add for bootstrap
  # knit_meta_add(list(rmarkdown::html_dependency_bootstrap('bootstrap')))
  # deps <- c(list(rmarkdown::html_dependency_bootstrap('bootstrap')), 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::markdownToHTML(text = gsub("\\\\\\\\","\\\\",preserved$value),
                           header = dep_html,
                           options = c("mathjax", "base64_images"),
                           stylesheet = file.path(getOption("radiant.path.data"),"app/www/bootstrap.min.css")) %>%
  htmltools::restorePreserveChunks(preserved$chunks)
}

## Knit for report in Radiant
knitIt <- function(text) {
  ## fragment also available with rmarkdown
  ## http://rmarkdown.rstudio.com/html_fragment_format.html
  md <- knitr::knit(text = paste0("\n`r options(width = 250)`\n",text), envir = r_environment)
  paste(markdown::markdownToHTML(text = md, fragment.only = TRUE, stylesheet = ""),
        # "<script type='text/javascript' src='https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML'></script>",
        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') %>% scrub %>% HTML
}

output$rmd_knitted <- renderUI({
  req(valsRmd$knit != 1)
  isolate({
    if (!isTRUE(getOption("radiant.local")) && is.null(session$user)) {
      HTML("<h2>Rmd file is not evaluated when running Radiant on open-source Shiny Server</h2>")
    } else if (input$rmd_report != "") {
      withProgress(message = "Knitting report", value = 0.5, {
        if (is_empty(input$rmd_selection))
          knitIt(input$rmd_report)
        else
          knitIt(input$rmd_selection)
      })
    }
  })
})

## based on http://shiny.rstudio.com/gallery/download-knitr-reports.html
output$saveReport <- downloadHandler(
  filename = function() {
    paste("report", sep = ".", switch(
      input$rmd_save_report, HTML = "html", PDF = "pdf", Word = "docx", Rmd = "Rmd", `Rmd & Data (zip)` = "zip"
    ))
  },
  content = function(file) {
    local <- getOption("radiant.local")
    if (isTRUE(local) || (!isTRUE(local) && !is.null(session$user))) {
      isolate({
        ## temporarily switch to the temp dir, in case you do not have write
        ## permission to the current working directory
        owd <- setwd(tempdir())
        on.exit(setwd(owd))

        report <-
          ifelse (is_empty(input$rmd_selection), input$rmd_report, input$rmd_selection) %>%
          gsub("\\\\\\\\","\\\\",.) %>% cleanout(.)

        if (input$rmd_save_report == "Rmd & Data (zip)") {
          r_data <- toList(r_data)
          save(r_data, file = "r_data.rda")
          paste0("```{r echo = FALSE}\nknitr::opts_chunk$set(comment=NA, echo=FALSE, error = TRUE, cache=FALSE, message=FALSE, warning=FALSE)\noptions(width = 250)\nsuppressWarnings(suppressMessages(library(radiant)))\nload(\"r_data.rda\")\n```\n\n", report) %>%
            cat(file = "report.Rmd", sep = "\n")

          zip_util = Sys.getenv("R_ZIPCMD", "zip")
          flags = "-r9X"
          os_type <- Sys.info()["sysname"]
          if (os_type == 'Windows') {
            wz <- suppressWarnings(system("where zip", intern = TRUE))
            if (!grepl("zip", wz)) {
              wz <- suppressWarnings(system("where 7z", intern = TRUE))
              if (grepl("7z", wz)) {
                zip_util = "7z"
                flags = "a"
              }
            }
          }

          zip(file, c("report.Rmd", "r_data.rda"), flags = flags, zip = zip_util)

        } else if (input$rmd_save_report == "Rmd") {
          paste0("```{r echo = FALSE}\nknitr::opts_chunk$set(comment=NA, echo=FALSE, error = TRUE, cache=FALSE, message=FALSE, warning=FALSE)\noptions(width = 250)\nsuppressWarnings(suppressMessages(library(radiant)))\n```\n\n", report) %>%
            cat(file = file, sep = "\n")
        } else {
          ## 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
          if (rstudioapi::isAvailable() || !isTRUE(local)) {
            cat(paste0("\n`r options(width = 250)`\n\n",report), file = "report.Rmd", sep = "\n")
            out <- rmarkdown::render("report.Rmd", switch(input$rmd_save_report,
              PDF = rmarkdown::pdf_document(), HTML = rmarkdown::html_document(),
              Word = rmarkdown::word_document(reference_docx = file.path(system.file(package = "radiant.data"),"app/www/style.docx"))
            ), envir = r_environment)
            file.rename(out, file)
          } else {
            knitItSave(report) %>% cat(file = file, sep = "\n")
          }
        }
      })
    }
  }
)

observeEvent(input$load_rmd, {
  ## loading rmd report from disk
  inFile <- input$load_rmd
  rmdfile <- paste0(readLines(inFile$datapath), collapse = "\n")
  shinyAce::updateAceEditor(session, "rmd_report", value = rmdfile)
})

## updating the report when called
update_report <- function(inp_main = "", fun_name = "", inp_out = list("",""),
                          pre_cmd = "result <- ", post_cmd = "", xcmd = "",
                          outputs = c("summary", "plot"),
                          figs = TRUE, fig.width = 7, fig.height = 7) {

  cmd <- ""
  if (inp_main[1] != "") {
    cmd <- deparse(inp_main, control = c("keepNA"), width.cutoff = 500L) %>%
             paste(collapse="") %>%
             sub("list", fun_name, .) %>%
             paste0(pre_cmd, .) %>%
             paste0(., post_cmd)
  }

  lout <- length(outputs)
  if (lout > 0) {
    for (i in 1:lout) {
      inp <- "result"
      if ("result" %in% names(inp_out[[i]])) {
        inp <- inp_out[[i]]["result"]
        inp_out[[i]]["result"] <- NULL
      }
      if (inp_out[i] != "" && length(inp_out[[i]]) > 0) {
        cmd <- deparse(inp_out[[i]], control = c("keepNA"), 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)

  if (figs)
    # cmd <- paste0("\n```{r fig.width=",fig.width,", fig.height=",fig.height,", dpi = 72}\n",cmd,"\n```\n")
    cmd <- paste0("\n```{r fig.width=", round(7*fig.width/650,2),", fig.height=",round(6*fig.height/650,2),", dpi = 72}\n",cmd,"\n```\n")
  else
    cmd <- paste0("\n```{r}\n",cmd,"\n```\n")

  update_report_fun(cmd)
}

observeEvent(input$rmd_report, {
  if (input$rmd_report != rmd_example)
    r_state$rmd_report <<- esc_slash(input$rmd_report)
})

update_report_fun <- function(cmd) {
  isolate({
    if (state_init("rmd_manual", "Auto paste") == "Manual paste") {
      os_type <- Sys.info()["sysname"]
      if (os_type == 'Windows') {
        cat(cmd, file = "clipboard")
      } else if (os_type == "Darwin") {
        out <- pipe("pbcopy")
        cat(cmd, file = out)
        close(out)
      } else if (os_type == "Linux") {
        cat("Clipboard not supported on linux")
      }
      withProgress(message = 'Putting command in clipboard', value = 0.5,
        cat("")
      )
    } else if (state_init("rmd_manual", "Auto paste") == "To Rmd") {
      withProgress(message = 'Putting Rmd chunk in Rstudio', value = 0.5,
        cleanout(cmd) %>%
        rstudioapi::insertText(.)
      )
    } else if (state_init("rmd_manual", "Auto paste") == "To R") {
      withProgress(message = 'Putting R-command in Rstudio', value = 0.5,
        gsub("(```\\{.*\\}\n)|(```\n)","",cmd) %>% cleanout(.) %>%
        rstudioapi::insertText(.)
      )
    } else {
      if (is_empty(r_state$rmd_report)) {
        r_state$rmd_report <<- paste0("## Your report title\n", cmd)
      } else {
        r_state$rmd_report <<- paste0(esc_slash(r_state$rmd_report),"\n",cmd)
      }
      withProgress(message = 'Updating report', value = 0.5,
        shinyAce::updateAceEditor(session, "rmd_report",
                                  value = esc_slash(r_state$rmd_report))
      )
    }

    if (state_init("rmd_switch", "Switch tab") == "Switch tab")
      updateTabsetPanel(session, "nav_radiant", selected = "Report")
  })
}
