Typos fix and export tests

DESCRIPTION

@@ -37,6 +37,7 @@ Imports:
     tools,
     utils,
     waiter,
+    zip,
     yaml
 Suggests:
     spelling,

NEWS.md

@@ -1,5 +1,6 @@
 ## Version 0.4
 
+* Fixed several typos ✍️. 
 * Updated with further description and suggested edits by experts.
 * Updated and shortened preface description page.
 

R/app_server.R

@@ -14,8 +14,8 @@ app_server <- function(input, output, session) {
   shiny::observeEvent(input$bookmark, {
     # session$doBookmark()
     # Use manuall bookmarking instead owing to the complexity
-    shiny::showNotification("Export the current protocol as yaml. Then import later...",
-                            duration = 5,closeButton = TRUE, type = "message")
+    shiny::showNotification("Save the current protocol as csv or yaml. Then import later...",
+                            duration = 5, closeButton = TRUE, type = "message")
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Export")
   })
 

R/misc.R

@@ -0,0 +1,56 @@
+#' Parse spatial data and convert to [`sf`] format
+#'
+#' @description
+#' This is a small helper function that converts any type of spatial
+#' format to a [`sf`] object.
+#' @param file A [`character`] file path
+#' @param make_valid A [`logical`] on whether \code{'file'} should be ensured to
+#' be a valid geometry (Default: \code{FALSE}).
+#' @keywords internal
+#' @noRd
+spatial_to_sf <- function(file, make_valid = FALSE){
+  assertthat::assert_that(is.character(file),
+                          is.logical(make_valid))
+
+  # Get file extension
+  ext <- tolower( tools::file_ext(file) )
+
+  # Found vector
+  if(ext %in% c("shp","gpkg")){
+    out <- sf::st_read(file, quiet = TRUE)
+  } else if( ext %in% c("tif","geotiff")){
+    out <- terra::rast(file)
+    out[out>0] <- 1 # Replace all with 1
+    # If there are 0 assume those should be NA
+    out[out==0] <- NA
+    out <- out |> terra::as.polygons() |> sf::st_as_sf()
+  } else {
+    return( NULL )
+  }
+  # --- #
+  # Check for empty crs
+  if(is.na(sf::st_crs(out))){
+    # Assume long-lat
+    out <- sf::st_set_crs(out, value = sf::st_crs(4326))
+  }
+
+  # Check for empty geometries
+  if(all( sf::st_is_empty(out) )) return( NULL )
+
+  if(make_valid){
+    if(!all( sf::st_is_valid(out) )){
+      out <- sf::st_make_valid(out)
+    }
+  }
+
+  # Convert to MULTIPOLYGON
+  out <- out |> sf::st_cast("MULTIPOLYGON")
+
+  # Transform
+  out <- out |> sf::st_transform(crs = sf::st_crs(4326))
+
+  # Rename geometry name to be sure
+  sf::st_geometry(out) <- "geometry" # rename
+
+  return(out)
+}

R/mod_Export.R

@@ -44,7 +44,7 @@ mod_Export_ui <- function(id){
               size = "lg",
               status = "info",
               choices = c('docx', 'pdf', 'csv', 'yaml'),
-              selected = 'yaml',
+              selected = 'csv',
               checkIcon = list(
                 yes = shiny::icon("circle-down"),
                 no = NULL
@@ -95,7 +95,13 @@ mod_Export_ui <- function(id){
                        shiny::textOutput(outputId = ns("missingtext"))),
             shiny::br(),
             # Button
-            shiny::downloadButton(ns("downloadData"), "Download the protocol")
+            shiny::p(
+              shiny::downloadButton(ns("downloadData"), "Download the selection option",
+                                    class = "btn-primary"),
+              shiny::downloadButton(ns("downloadEverything"), "Download everything",
+                                    icon = shiny::icon("file-zipper"),
+                                    class = "btn-secondary")
+            )
           )
         ),
         shiny::tabPanel(
@@ -176,7 +182,7 @@ mod_Export_server <- function(id, results){
         } else if(oftype() == "docx"){
           # Create document from results, everything handled by function
           protocol <- format_protocol(results, format = "list")
-          # saveRDS(protocol, "test.rds")
+          # saveRDS(results, "test.rds")
           protocol_to_document(protocol, file = file, format = "docx")
         } else if(oftype() == "pdf"){
           # Create document from results
@@ -186,6 +192,44 @@ mod_Export_server <- function(id, results){
       }
     )
 
+    # Download everything button
+    output$downloadEverything <- shiny::downloadHandler(
+      filename = function() {
+        # Compose output file
+        paste0(
+          "ODPSCP__",
+          format(Sys.Date(), "%Y_%m_%d"),
+          ".zip"
+        )
+      },
+      content = function(file) {
+        # Create outputs from results
+        shiny::showNotification("Preparing zipped outputs which can take a little while...",
+                                duration = 3, type = "message")
+        # First csv
+        protocol <- format_protocol(results, format = "data.frame")
+        ofname1 <- file.path(tempdir(), "ODPSCP_protocol.csv")
+        readr::write_csv(protocol, file = ofname1)
+
+        # Create document from results, everything handled by function
+        protocol <- format_protocol(results, format = "list")
+        ofname2 <- file.path(tempdir(), "ODPSCP_protocol.docx")
+        protocol_to_document(protocol, file = ofname2,
+                             format = "docx")
+
+        # Create PDF document from results
+        protocol <- format_protocol(results, format = "list")
+        ofname3 <- file.path(tempdir(), "ODPSCP_protocol.pdf")
+        protocol_to_document(protocol, file = ofname3,
+                             format = "pdf")
+
+        # Zip everything together
+        zip::zip(file,
+                 files = c(ofname1, ofname2, ofname3),
+                 mode = "cherry-pick")
+      }
+    )
+
   })
 }
 

R/mod_Overview.R

@@ -63,6 +63,8 @@ mod_Overview_ui <- function(id){
             collapsible = TRUE,
             shiny::p("Add each author of the study to the table below. If a ORCID is not
                      known or available, leave blank."),
+            shiny::helpText("If the number of authors is extensive it might also be ok to
+                            simply add the lead author's name."),
             DT::DTOutput(outputId = ns("authors_table")),
             shiny::actionButton(inputId = ns("add_author"), label = "Add a new author row",
                                 icon = shiny::icon("plus")),
@@ -507,16 +509,17 @@ mod_Overview_server <- function(id, results, parentsession){
       shiny::req(file)
 
       if(!is.null(input$studyregion)){
-        # Found vector
-        if(tolower( tools::file_ext(file)) %in% c("shp","gpkg")){
-          out <- sf::st_read(file, quiet = TRUE) |>
-            sf::st_transform(crs = sf::st_crs(4326))
-        } else if(tolower( tools::file_ext(file)) %in% c("tif","geotiff")){
-          out <- terra::rast(file)
-          out[out>0] <- 1 # Replace all with 1
-          out <- out |> terra::as.polygons() |> sf::st_as_sf() |>
-            sf::st_cast("MULTIPOLYGON") |>
-            sf::st_transform(crs = sf::st_crs(4326))
+        # Check file size in MB
+        ss <- (file.size(file) / 1048576)
+        if(ss > 3){
+          shiny::showNotification("Uploaded file over 3 MB. Loading can take a while...",
+                                  duration = 5, type = "message")
+        }
+        # Load spatial file
+        out <- spatial_to_sf(file, make_valid = FALSE)
+        if(is.null(out)){
+          shiny::showNotification("Layer could not be loaded!",
+                                  duration = 2, type = "warning")
         }
         return(out)
       } else {

R/utils_format_protocol.R

@@ -80,22 +80,22 @@ format_protocol <- function(results, format = "data.frame",
 
 #' Small helper for spatial conversion to wkt
 #' @param val A [`list`] with the datapath for the spatial file
+#' @return A [`character`] with a WKT.
 #' @noRd
 format_studyregion_to_text <- function(val){
   assertthat::assert_that(utils::hasName(val, "datapath"))
-  # Assume as sf and load as such
+  # Load from data path
   val <- try({
-    sf::st_as_sfc(
-      sf::st_read(val$datapath,quiet = TRUE)
-    )
-  },silent = TRUE)
+    spatial_to_sf(val$datapath, make_valid = FALSE)
+  }, silent = TRUE)
   if(inherits(val,"try-error")){
     val <- "Studyregion could not be loaded?"
   } else {
+    # Convert to sfc
+    val <- val |> sf::st_as_sfc()
     val <- paste0(
       # Also append SRID in front
-      sf::st_crs(val) |> sf::st_as_text(),";",
-      sf::st_as_text(val)
+      sf::st_crs(val) |> sf::st_as_text(),";", sf::st_as_text(val)
     )
   }
   return(val)
@@ -230,13 +230,25 @@ protocol_to_document <- function(results, file, format = "docx", path_protocol =
       if(el == "studyregion"){
         # Render studyregion
         sp <- strsplit(res,";") # Split SRID off
-        sp <- sp[[1]][2] |> sf::st_as_sfc() |> sf::st_sf(crs = sp[[1]][1])
-        gg <- ggplot2::ggplot() +
-          ggplot2::geom_sf(data = sp) +
-          ggplot2::labs(title = "Outline of studyregion")
-        # Add to document
-        doc <- doc |> officer::body_add_gg(value = gg)
-        try({ rm(gg, sp) },silent = TRUE)
+        # Catch error in case region could not be loaded
+        if(is.na(sp[[1]][2])){
+          # Add to body
+          fpar <- officer::fpar(
+            officer::ftext(text = sp[[1]][1],
+                           prop = officer::fp_text(font.size = 12,italic = FALSE))
+          )
+          doc <- doc |> officer::body_add_fpar(value = fpar)
+        } else {
+          # Correctly parsed geometry
+          sp <- sp[[1]][2] |> sf::st_as_sfc() |> sf::st_sf(crs = sp[[1]][1])
+          gg <- ggplot2::ggplot() +
+            ggplot2::geom_sf(data = sp) +
+            ggplot2::labs(title = "Outline of studyregion")
+          # Add to document
+          doc <- doc |> officer::body_add_gg(value = gg)
+          try({ rm(gg)},silent = TRUE)
+        }
+        try({ rm(sp) },silent = TRUE)
       } else if(el %in% c("authors_table","featurelist",
                           "evalidentification","specificzones")) {