🔥 Updated minor fixes

.gitignore

@@ -19,3 +19,5 @@ deploy/
 # Shiny bookmarks
 shiny_bookmarks/
 
+# Log files
+logs/*.rds

R/app_server.R

@@ -7,13 +7,33 @@ app_server <- function(input, output, session) {
   # Your application server logic
   sever::sever()
 
+  # --- #
   # Add bookmark button to top
   # NOTE: For URL see also https://stackoverflow.com/questions/58396680/how-to-extract-the-url-from-the-shiny-bookmark-button-and-create-my-own-action-b
-  shiny::enableBookmarking(store = "url")
+  # shiny::enableBookmarking(store = "url")
   shiny::observeEvent(input$bookmark, {
-    session$doBookmark()
+    # 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")
+    bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Export")
+  })
+
+  # Save bookmark time too
+  shiny::onBookmark(function(state) {
+    savedTime <- as.character(Sys.time())
+    cat("Last saved at", savedTime, "\n")
+    # state is a mutable reference object, and we can add arbitrary values to
+    # it.
+    state$values$time <- savedTime
   })
 
+  # On restore
+  shiny::onRestore(function(state) {
+    cat("Restoring from state bookmarked at", state$values$time, "\n")
+  })
+  # --- #
+
   # Enable shinylogs
   # shinylogs::read_rds_logs("logs")
   shinylogs::track_usage(what = c("session", "input", "output", "error"),
@@ -30,49 +50,51 @@ app_server <- function(input, output, session) {
   results <- shiny::reactiveValues()
 
   # Bottom page buttons -------------------------------------------------------
+  # Javascript to be rendered with shinyjs
+  jscode <- "function() {document.body.scrollTop = 0;}"
   shiny::observeEvent(input$start_new_protocol, {
     bs4Dash::updateTabItems(session,
                             inputId = "sidebarmenu", selected = "Overview")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
 
   # Final observer events for continue buttons
   shiny::observeEvent(input$go_home, {
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Home")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
   shiny::observeEvent(input$go_overview, {
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Overview")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
   shiny::observeEvent(input$go_design, {
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Design")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
   shiny::observeEvent(input$go_specification, {
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Specification")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
   shiny::observeEvent(input$go_context, {
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Context")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
   shiny::observeEvent(input$go_prioritization, {
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Prioritization")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
   shiny::observeEvent(input$go_export, {
     bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Export")
+    # Jump to top
+    shinyjs::runjs(jscode)
   })
-  # ---------------------------------------------------------------------------
-
-  # Add Help popups for every entry
-  # Add Tooltips for each element
-  # for(n in names(protocol)){
-  #   sub <- protocol[[n]]
-  #   bs4Dash::addPopover(
-  #     id = sub['render-id'],
-  #     options = list(
-  #       content = sub$popexample,
-  #       title = sub$question,
-  #       placement = "auto",
-  #       trigger = "hover"
-  #     )
-  #   )
-  # }
 
   # title page ----------------------------------------------------------------
   # Adding module server code

R/mod_Context.R

@@ -83,6 +83,7 @@ mod_Context_ui <- function(id){
                                                           "Current conditions",
                                                           "Future conditions",
                                                           "Fully dynamic"),
+                                              selected = "Current conditions",
                                               multiple = TRUE,
                                               options = list(create = FALSE,
                                                              placeholder = "Choose single or multiple from list"))

R/mod_Design.R

@@ -77,9 +77,9 @@ mod_Design_ui <- function(id){
                        work? This could for example also be a specific planning protocol or established
                        approaches such as structure decision making or adaptive management."),
                      shiny::p("Example framework references:"),
-                     shiny::p("Pressey, R. L., & Bottrill, M. C. (2009). Approaches to landscape-and seascape-scale conservation planning: convergence, contrasts and challenges. Oryx, 43(4), 464-475."),
-                     shiny::p("Alvarez-Romero, J. G., Adams, V. M., Pressey, R. L., Douglas, M., Dale, A. P., Auge, A. A., ... & Perdrisat, I. (2015). Integrated cross-realm planning: A decision-makers' perspective. Biological Conservation, 191, 799-808."),
-                     shiny::p("Niemiec, R. M., Gruby, R., Quartuch, M., Cavaliere, C. T., Teel, T. L., Crooks, K., ... & Manfredo, M. (2021). Integrating social science into conservation planning. Biological Conservation, 262, 109298."),
+                     shiny::p("Pressey, R. L., & Bottrill, M. C. (2009). Approaches to landscape-and seascape-scale conservation planning: convergence, contrasts and challenges. Oryx, 43(4), 464-475. DOI: https://doi.org/10.1017/S0030605309990500"),
+                     shiny::p("Alvarez-Romero, J. G., Adams, V. M., Pressey, R. L., Douglas, M., Dale, A. P., Auge, A. A., ... & Perdrisat, I. (2015). Integrated cross-realm planning: A decision-makers' perspective. Biological Conservation, 191, 799-808. DOI: https://doi.org/10.1016/j.biocon.2015.07.003"),
+                     shiny::p("Niemiec, R. M., Gruby, R., Quartuch, M., Cavaliere, C. T., Teel, T. L., Crooks, K., ... & Manfredo, M. (2021). Integrating social science into conservation planning. Biological Conservation, 262, 109298. DOI: https://doi.org/10.1016/j.biocon.2021.109298"),
                      shinyWidgets::pickerInput(
                        inputId = ns("studyframework"),
                        label = "Analytical Framework",
@@ -303,7 +303,8 @@ mod_Design_ui <- function(id){
                                                           "Property owners"),
                                               multiple = TRUE,
                                               options = list(create = TRUE,
-                                                             placeholder = "Choose from list, or type and click to add new option."))
+                                                             placeholder = "Choose from list, or type and click to add new option.")
+                                              )
                       ),
                       shiny::br(),
                       bs4Dash::box(

R/mod_Export.R

@@ -30,8 +30,8 @@ mod_Export_ui <- function(id){
             shiny::p(
               "All protocol entries can be exported in a range of different formats
               for further use such as appending them to a manuscript.
-              It should be noted that only 'rData', 'csv' and 'yaml' are
-              machine-readable formats and be imported again by ODPSCP.
+              It should be noted that only 'csv' and 'yaml' are
+              machine-readable formats and can be imported again by ODPSCP.
               "
             ),
             shiny::br(),
@@ -44,7 +44,7 @@ mod_Export_ui <- function(id){
               size = "lg",
               status = "info",
               choices = c('docx', 'pdf', 'csv', 'yaml'),
-              selected = 'rData',
+              selected = 'yaml',
               checkIcon = list(
                 yes = shiny::icon("circle-down"),
                 no = NULL
@@ -109,9 +109,6 @@ mod_Export_ui <- function(id){
             collapsible = FALSE,
             DT::DTOutput(outputId = ns("results_table"))
           )
-          # shiny::textOutput(
-          #   outputId = ns("protocolmarkdown")
-          # )
         ) # End Tab panel
        ) # End Tabset panel
     )
@@ -135,21 +132,13 @@ mod_Export_server <- function(id, results){
                     editable = FALSE)
     })
 
-    # Get mandatory protocol entries
-    mand <- get_protocol_mandatory()
-
-    # # Check for mandatory outputs and highlight them in text
-    # test <- shiny::reactive({
-    #   req(results)
-    #   results
-    # })
-    #
-    # # Check the value of all mandatory fields
-    # shiny::observeEvent(test(), {
-    #   # miss <- check_protocol_mandatory(file, mand)
-    #   # output$missingtext <- shiny::renderText({
-    #   #   paste0("No entry found for mandatory fields:", miss)
-    #   # })
+    # --- #
+    # Check for mandatory outputs and highlight them in text
+    # shiny::observe(results, {
+    #   miss <- check_protocol_mandatory(results)
+    #   output$missingtext <- shiny::renderText({
+    #     paste0("No entry found for mandatory fields:", miss)
+    #   })
     #   print("test")
     #   shinyjs::toggle("downloadData")
     # })
@@ -162,8 +151,9 @@ mod_Export_server <- function(id, results){
       filename = function() {
         # Compose output file
         paste0(
+          "ODPSCP__",
           format(Sys.Date(), "%Y_%m_%d"),
-          "__ODPSCP.",
+          ".",
           oftype()
         )
       },
@@ -186,12 +176,12 @@ mod_Export_server <- function(id, results){
         } else if(oftype() == "docx"){
           # Create document from results, everything handled by function
           protocol <- format_protocol(results, format = "list")
-          protocol_to_document(protocol, file = file, format = "docx")
           # saveRDS(protocol, "test.rds")
+          protocol_to_document(protocol, file = file, format = "docx")
         } else if(oftype() == "pdf"){
           # Create document from results
           protocol <- format_protocol(results, format = "list")
-          protocol_to_document(protocol, file = file,format = "pdf")
+          protocol_to_document(protocol, file = file, format = "pdf")
         }
       }
     )

R/mod_Import.R

@@ -15,57 +15,38 @@ mod_Import_ui <- function(id){
   # TODO:
   # Import existing Marxan / Zonation / Prioritizr configuration files?
   bs4Dash::tabItem(tabName = "Import",
-          # https://shiny.posit.co/r/gallery/widgets/file-upload/
           shiny::fluidPage(
             bs4Dash::box(
-              title = "Not yet implemented",
+              title = shiny::tagList(shiny::icon("upload"), "Import a previously saved protocol"),
               closable = FALSE,
-              width = 12,status = "danger",
+              width = 12,
               solidHeader = TRUE,
+              status = "primary",
+              collapsed = FALSE,
               collapsible = FALSE,
-              "To be added..."
-            )
-            # fileInput(
-            #   inputId = ns("file1"),
-            #   width = "100%",
-            #   label = "Load your database",
-            #   accept = c(
-            #     "text/csv",
-            #     "text/comma-separated-values",
-            #     "text/tab-separated-values",
-            #     "text/plain",
-            #     ".csv",
-            #     ".tsv", "xlsx"
-            #   )
-            # ),
-            # helpText("Default max. file size is 100MB"),
-            # box(
-            #   title = tagList(shiny::icon("upload"), "Source"),
-            #   solidHeader = FALSE,
-            #   status = "success",
-            #   maximizable = F,
-            #   closable = F,
-            #   width = 12,
-            #   shinyWidgets::radioGroupButtons(
-            #     inputId = ns("Id004"),
-            #     choices = c("Example Data" = 1, "Import Data" = 2, "BrAPI" = 3),
-            #     status = "success",
-            #     selected = 1
-            #   ),
-            #   shiny::conditionalPanel(
-            #     condition = "input.Id004==1",
-            #     h6("Use example data"),
-            #     ns = ns
-            #   ),
-            #   shiny::conditionalPanel(
-            #     condition = "input.Id004==2",
-            #     h6("Import external data preferably csv/txt files."),
-            #     ns = ns
-            #   )
-            # )
+            shiny::p("Here you can upload a previously saved protocol file. This
+                     file needs to be either in yaml or csv format. After uploading,
+                     the various entries in the protocol will be filled with the previous version."),
+            shiny::br(),
+            shiny::div("Please note:"),
+            shiny::helpText("> Non accepted fields will not be parsed."),shiny::br(),
+            shiny::helpText("> Reexporting the protocol resets internally the version and date."),
+            shiny::br(),
+            shiny::hr(),
+            shiny::fileInput(
+              inputId = ns("protocolFile"),
+              width = "100%",
+              label = "Load a previously exported protocol",
+              accept = c(
+                "text/csv",
+                "text/comma-separated-values",
+                ".yaml"
+              )
+            ),
+            shiny::helpText("Default max. file size is 30MB")
+            ) # End of box
           ) # End fluid page
-  )
-
+    ) # End of tab box
 }
 
 #' Import Server Functions
@@ -75,6 +56,57 @@ mod_Import_server <- function(id){
  shiny::moduleServer( id, function(input, output, session){
     ns <- session$ns
 
+    # Parse the results
+    imports <- shiny::reactive({
+      file <- input$protocolFile$datapath
+      # Request the file
+      shiny::req(file)
+
+      if(is.null(input$protocolFile)){
+        return(NULL)
+      }
+      # Get extension
+      ext <- tools::file_ext(file)
+      # Different processing depending on upload type
+      out <- tryCatch({
+        switch(ext,
+               csv = utils::read.csv(file, sep = ","),
+               yaml = yaml::read_yaml(file),
+               shiny::validate("Invalid file; Please upload a .csv or .yaml file!")
+              )
+        },
+        error = function(e) {
+          # return a safeError if a parsing error occurs
+          stop(shiny::safeError(e))
+        }
+      )
+      # Checks
+      if(inherits(out, "try-error")){
+        shiny::showNotification("File not valid!", duration = 2, type = "error")
+        return(NULL)
+      } else if(is.data.frame(out)){
+        shiny::validate(
+          shiny::need(nrow(out)>10, "Uploaded dataframe seems to small?")
+        )
+      } else if(is.list(out)){
+        shiny::validate(
+          shiny::need(length(out)>=5, "Uploaded data requires 5 entry groups.")
+        )
+      }
+      return(out)
+    })
+
+    # Validate the protocol and import protocol
+    shiny::observeEvent(imports(), {
+      if(!is.null(imports())){
+        check <- validate_protocol_results(imports())
+        if(!is.null(check)){
+          shiny::showNotification(check, duration = 5,closeButton = TRUE, type = "error")
+        }
+      }
+      # Insert protocol
+      bs4Dash::updateTabItems(session, inputId = "sidebarmenu", selected = "Overview")
+    })
   })
 }