Fix download by not using processx

app.R

@@ -103,14 +103,14 @@ ui <- dashboardPage(
             ),
             tags$p(
               style = "font-size: 12pt",
-              "The tool provides a mapping using a Continuous Gaussian Bayesian Belief Network from the 
+              "The tool provides a mapping using a Continuous Gaussian Bayesian Belief Network from the
-               Anthropogenic Pressures through the biotopes and to the output processes and ultimately the 
+               Anthropogenic Pressures through the biotopes and to the output processes and ultimately the
               Ecosystem services, to which the habitat supports."
             ),
             tags$p(
               style = "font-size: 12pt",
-              "By selecting combinations of pressures on the left hand side bar, the impact on biotopes and functions of the 
+              "By selecting combinations of pressures on the left hand side bar, the impact on biotopes and functions of the
-                     habitat can be estimated on the graphs shown on the Pressure test page.  
+                     habitat can be estimated on the graphs shown on the Pressure test page.
               The Bayesian Network page shows the structure of the Bayesian Network itself.              "
             ),
             tags$p(
@@ -203,9 +203,9 @@ server <- function(input, output, session) {
   print("Loading data")
 
   dataStorage <- "data/"
-  
+
   palette <- c("firebrick", "coral", "rosybrown", "tan", "salmon",  "olivedrab", "seagreen", "aquamarine",  "darkcyan",  "dodgerblue",  "steelblue",   "royalblue")
-  
+
 
   models <- NULL
   pressures <- NULL
@@ -382,7 +382,7 @@ server <- function(input, output, session) {
     #isolate({
     if (!is.null(modelList[[.selections$model]]$p_es$nodes)) {
       pressCodes <- which(startsWith(modelList[[.selections$model]]$p_es$nodes$code, "p"))
-      
+
       #if (is.null(.selections$pressStatus)) status <- rep("Off", length(pressCodes)) else status <- .selections$pressStatus$status
       pressures <- data.frame(
         code = modelList[[.selections$model]]$p_es$nodes$code[pressCodes],
@@ -392,7 +392,7 @@ server <- function(input, output, session) {
       )
       print(pressures)
       #This assumes all pressures are the same...
-      
+
       setPressures(pressures)
       btnList <- apply(pressures, 1, makeRadioButtons)
     }
@@ -503,7 +503,7 @@ server <- function(input, output, session) {
 
     nodeSpacing <- ifelse(.selections$bbnNames, 600, 150)
 
-    
+
     nodes <- data.frame(
       id = rownames(nodes),
       label = labels,
@@ -540,8 +540,8 @@ server <- function(input, output, session) {
     } else {
       edgeNet <- edges
     }
-    
+
-    
+
 
     legendDF <- data.frame(
       id = 1:nrow(model$legend),
@@ -549,7 +549,7 @@ server <- function(input, output, session) {
       color = palette,
       stringsAsFactors = FALSE
     )
-    
+
     print(legendDF)
 
     visNetwork(nodeNet, edgeNet, width = "100%", main = "Bayesian Belief Network", submain = input$modelSelect) %>%
@@ -575,13 +575,13 @@ server <- function(input, output, session) {
 
   genPlot <- function(boxPlot, title, paletteLength) {
     if (nrow(boxPlot) > 0) {
-      
+
       #print(paste('Palette length', paletteLength))
 
       #palette <- brewer.pal(paletteLength,  "Set3")
-      
+
       #palette <- c("red", "sienna3", "plum2", "rosybrown4",  "sandybrown", "yellow", "seashell3", "palegreen", "springgreen4",  "steelblue",   "azure")
-      
+
       names(palette) <- 1:length(palette)
 
       #print(paste("Box plot, colours", nrow(boxPlot), length(colours)))
@@ -621,13 +621,51 @@ server <- function(input, output, session) {
   })
 
 
-  export <- function(model, fPath) {
 
-    
+  exportOrca <- function (p, file = "plot.png", format = tools::file_ext(file),
-    return(zipFile)
+    scale = NULL, width = NULL, height = NULL,
+    verbose = FALSE, debug = FALSE, safe = FALSE)
+  {
+      if (Sys.which("orca") == "") {
+          stop("The orca command-line utility is required to use the `orca()` function.\n\n",
+              "Follow the installation instructions here -- https://github.com/plotly/orca#installation",
+              call. = FALSE)
+      }
+
+      b <- plotly_build(p)
+
+      plotlyjs <- b$dependencies[sapply(b$dependencies, function(d) { d$name == "plotly-main" })][[1]]
+      plotlyjs_file <- file.path(plotlyjs$src$file, plotlyjs$script)
+
+      args <- c(
+        "graph", shQuote(jsonlite::toJSON(
+          b$x[c("data", "layout")],
+          digits = 50,
+          auto_unbox = TRUE,
+          force = TRUE,
+          null = "null",
+          na = "null"
+        )),
+        "-o", file,
+        "--format", format,
+        "--plotlyjs", plotlyjs_file
+      )
+      if (debug)
+          args <- c(args, "--debug")
+      if (verbose)
+          args <- c(args, "--verbose")
+      if (safe)
+          args <- c(args, "--safe-mode")
+      if (!is.null(scale))
+          args <- c(args, "--scale", scale)
+      if (!is.null(width))
+          args <- c(args, "--width", width)
+      if (!is.null(height))
+          args <- c(args, "--height", height)
+
+      invisible(system2("orca", args))
   }
 
-
   output$linkBackgroundData <- downloadHandler(
     filename = getModelName(),
     content = function(file) {
@@ -637,32 +675,28 @@ server <- function(input, output, session) {
   )
 
   output$download <- downloadHandler(
-    filename = function() {paste0("MESO-", format(Sys.time(), "%m%d_%H%M"), ".zip")},
+    filename = function() { paste0("MESO-", format(Sys.time(), "%m%d_%H%M"), ".zip") },
     content = function(file) {
       showModal(
         modalDialog(
           fluidRow(
             column(width = 12) %>% withSpinner(type = 5, proxy.height = "200px")
-          ), 
+          ),
           footer=div()
         )
       )
-      
+
       oldDir <- getwd()
-      
+
       tmp <- tempfile("")
-      
-      print(tmp)
       dir.create(tmp)
-      
       setwd(tmp)
-  
+
       #Get the network graph
-      l1 <- orca(prepPlot("ba", "Bio-Assemblage"), "layer1.png")
+      l1 <- exportOrca(prepPlot("ba", "Bio-Assemblage"), "layer1.png")
-      l2 <- orca(prepPlot("op", "Output Processes"),"layer2.png")
+      l2 <- exportOrca(prepPlot("op", "Output Processes"),"layer2.png")
-      l3 <- orca(prepPlot("es", "Ecosystem Services"),"layer3.png")
+      l3 <- exportOrca(prepPlot("es", "Ecosystem Services"),"layer3.png")
-      
+
-      
       #Save pressure list, confidence levels, node and edge tables in xlsx
       l <- list(
         pressures = .selections$pressStatus,
@@ -671,14 +705,14 @@ server <- function(input, output, session) {
         settings = as.data.frame(cbind(names(.resistanceScores), .resistanceScores), stringsAsFactors = FALSE)
       )
       xl <- write.xlsx(l,  "dataset.xlsx")
-    
+
       zipFile <- zipr(file, c("layer1.png", "layer2.png", "layer3.png", "dataset.xlsx"))
-      
+
       print(paste("zip file complete", zipFile))
 
       setwd(oldDir)
       unlink(tmp)
-      
+
       removeModal()
     },
     contentType = "application/zip"