Updated docker launch

DESCRIPTION

@@ -2,6 +2,8 @@ Package: MetaShARK
 Title: metashark
 Version: 0.0.0.9000
 Authors@R: person('Elie', 'ARNAUD', email = '[email protected]', role = c('cre', 'aut'))
+Author: Elie ARNAUD ([aut,cre])
+Maintainer: Elie ARNAUD <[email protected]>
 Description: MetaShARK is a Shiny application allowing its
                     user to fill metadata for a given ecological
                     dataset of his owns. The data description relies
@@ -34,6 +36,7 @@ Imports:
   RCurl,
   readtext,
   RefManageR,
+  rmarkdown,
   rorcid,
   shinyAce,
   shinyBS,
@@ -52,7 +55,8 @@ Imports:
   tippy,
   tagsinput,
   taxonomyCleanr,
-  utils
+  utils,
+  xml2
 Remotes:
     ThinkR-open/tagsinput,
     ropenscilabs/emldown
@@ -62,8 +66,7 @@ URL: https://github.com/earnaud/MetaShARK-v2.git
 BugReports: https://github.com/earnaud/MetaShARK-v2.git/issues
 Suggests: 
     testthat (>= 3.0.0),
-    knitr,
-    rmarkdown
+    knitr
 VignetteBuilder: knitr
 Depends: 
     R (>= 2.10)

Dockerfile

@@ -76,7 +76,7 @@ RUN Rscript -e 'remotes::install_github("ThinkR-open/tagsinput@9aa70ec34c6fa60ef
 RUN Rscript -e 'remotes::install_github("ropenscilabs/emldown@8d98c8fc708dc1f2ecc8eec3d23a66e4f487e658")'
 RUN Rscript -e 'remotes::install_github("earnaud/cedarr@dece7479cac3689e36283df74fe0514748e67f18")'
 RUN Rscript -e 'remotes::install_github("trestletech/shinyAce@6f8f7c9976b44246e91bb5dbaef1b87d6bbb7b77")'
-RUN Rscript -e 'remotes::install_github("EDIorg/EMLassemblyline@f05ef748feed7242c9eae0a794a98e163524dd48")'
+RUN Rscript -e 'remotes::install_github("EDIorg/EMLassemblyline@6c3247cb950b334b1f125ed485fa778bc80ec05f")'
 RUN Rscript -e 'remotes::install_github("LukasK13/SummeRnote@7c404e1578ab3567fdb331716ca831913ccf645a")'
 
 RUN mkdir /build_zone

MetaShARK.Rproj

@@ -15,3 +15,4 @@ LaTeX: pdfLaTeX
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageCheckArgs: --no-examples

R/eal_3_Attributes.R

@@ -665,11 +665,11 @@ Attributes <- function(id, main.env) {
         input,
         "missingValueCode",
         type = if(identical(
-          isContentTruthy(.value), isContentTruthy(input$missingValueCodeExplanation)
+          isContentTruthy(.value) || .value == "", 
+          isContentTruthy(input$missingValueCodeExplanation)
         )) "warning" else "danger"
       )
 
-      checkFeedback(input, "missingValueCode", type = "warning")
       if(isContentTruthy(input$missingValueCode))
         checkFeedback(input, "missingValueCodeExplanation", type = "danger") else
           checkFeedback(input, "missingValueCodeExplanation", type = "warning")
@@ -696,7 +696,17 @@ Attributes <- function(id, main.env) {
         input,
         "missingValueCodeExplanation",
         type = if(identical(
-          isContentTruthy(.value), isContentTruthy(input$missingValueCode)
+          isContentTruthy(.value),
+          isContentTruthy(input$missingValueCode) || input$missingValueCode == ""
+        )) "warning" else "danger"
+      )
+
+      checkFeedback(
+        input,
+        "missingValueCode",
+        type = if(identical(
+          isContentTruthy(.value),
+          isContentTruthy(input$missingValueCode) || input$missingValueCode == ""
         )) "warning" else "danger"
       )
     })
@@ -756,11 +766,10 @@ Attributes <- function(id, main.env) {
             } else TRUE
           } && 
           {
-            if(isFALSE(input$missingValueCode == "" &&
-                       input$missingValueCodeExplanation == "")) {
-              isContentTruthy(input$missingValueCode) &&
+            if(input$missingValueCodeExplanation != "") {
+              (isContentTruthy(input$missingValueCode) || input$missingValueCode == "") &&
                 isContentTruthy(input$missingValueCodeExplanation)
-            } else TRUE
+            } else (input$missingValueCode == "")
           }
       )
 

R/eal_4_CatVars.R

@@ -6,6 +6,7 @@ CatVarsUI <- function(id) {
 
   return(
     fluidPage(
+      wipRow("This step might take some minutes to setup. (To be improved soon)"),
       fluidRow(
         uiOutput(NS(id, "edit_catvar")) %>%
           shinycssloaders::withSpinner()

R/eal_4_CatVars_helpers.R

@@ -20,7 +20,6 @@ CatVarsInputUI <- function(id, attribute, table.name, main.env) {
     ... = tagList(
       lapply(unlist(codes), function(.code) {
         # Correct value for NAs
-        browser()
         .value <- .tables[[table.name]] %>%
           dplyr::filter(attributeName == attribute & identical(code, .code)) %>%
           dplyr::select(definition) %>%

R/eal_6_TaxCov.R

@@ -5,7 +5,11 @@ TaxCovUI <- function(id) {
   return(
     fluidPage(
       fluidRow(
-        column(4, uiOutput(NS(id, "taxa.table")) ),
+        column(
+          4,
+          uiOutput(NS(id, "taxa.table")),
+          tableOutput(NS(id, "preview"))
+        ),
         column(4, uiOutput(NS(id, "taxa.name.type")) ),
         column(4, uiOutput(NS(id, "taxa.authority")) )
       )
@@ -37,7 +41,7 @@ TaxCov <- function(id, main.env) {
     output$taxa.table <- renderUI({
       isolate({
         # Set choices for selectInput -- reuse & filter Attributes
-        .att <- main.env$save.variable$Attributes
+        .att <- main.env$save.variable$Attributes$content
         .choice <- main.env$local.rv$.taxa.choices <- list()
         sapply(names(.att), function(.md.file) {
           .data.file <- main.env$save.variable$DataFiles %>%
@@ -47,6 +51,7 @@ TaxCov <- function(id, main.env) {
             basename
           # Set sites
           .choice[[.data.file]] <<- .att[[.md.file]] %>% 
+            as.data.frame %>%
             dplyr::filter(class %in% c("character", "categorical")) %>% 
             dplyr::select(attributeName) %>%
             unlist
@@ -72,7 +77,26 @@ TaxCov <- function(id, main.env) {
         multiple = FALSE
       )
     })
-
+
+    output$preview <- renderTable({
+      validate(
+        need(isTruthy(main.env$local.rv$taxa.table), "invalid taxa selection"),
+        need(isTruthy(main.env$local.rv$taxa.col), "invalid taxa selection")
+      )
+
+      file <- main.env$save.variable$DataFiles$datapath %>%
+        as.data.frame %>%
+        dplyr::filter(grepl(main.env$local.rv$taxa.table, .)) %>%
+        unlist
+      data <- data.table::fread(
+        file, 
+        nrows = 5,
+        data.table = FALSE
+      )[main.env$local.rv$taxa.col]
+
+      return(data)
+    })
+
     # * taxa.name.type ----
     output$taxa.name.type <- renderUI({
       isolate({
@@ -119,7 +143,8 @@ TaxCov <- function(id, main.env) {
     observeEvent(input$taxa.table, 
       {
         # save
-        .tmp <- strsplit(input$taxa.table, split = "/", fixed = TRUE) %>%
+        .tmp <- input$taxa.table %>% 
+          strsplit(., split = "/", fixed = TRUE) %>%
           unlist
         main.env$local.rv$taxa.table <- .tmp[1]
         main.env$local.rv$taxa.col <- .tmp[2]

R/runMetashark.R

@@ -27,9 +27,16 @@
 #' Elie Arnaud <[email protected]>
 #'
 #' @examples
+#' 
+#' ## Not run:
+#' 
+#' library(MetaShARK)
+#' 
 #' # run this to launch MetaShARK
 #' runMetashark()
 #' 
+#' ## End (Not run)
+#' 
 #' @import shiny
 #' 
 #' @export
@@ -39,8 +46,8 @@ runMetashark <- function(...) {
   args <- list(...)
   args$dev <- isTRUE(args$dev)
   args$wip <- isTRUE(args$wip)
+  args$launch.browser <- isTRUE(args$launch.browser)
   args$reactlog <- isTRUE(args$reactlog) || isTRUE(args$dev)
-  args$test <- isTRUE(args$test)
   assign("metashark.args", args, envir = .GlobalEnv)
   on.exit(rm("metashark.args", envir = .GlobalEnv))
 
@@ -66,13 +73,5 @@ runMetashark <- function(...) {
   options(encoding = 'UTF-8')
   Sys.setlocale("LC_ALL", "en_US.utf8") 
 
-  if(args$test){
-    browser()
-    shinytest::recordTest(
-      shinytest::ShinyDriver$new(
-        "R/"
-      )
-    )
-  }
-  runApp(shinyApp(ui = ui, server = server))
+  runApp(shinyApp(ui = ui, server = server), launch.browser = args$launch.browser)
 }

R/savevariable_functions.R

@@ -532,14 +532,13 @@ setLocalRV <- function(main.env){
   # * GeoCov ----
   if(main.env$EAL$page == 5) {
     # Set choices for selectInput -- reuse Attributes
-    .att <- main.env$save.variable$Attributes
+    .att <- main.env$save.variable$Attributes$content
     .site <- main.env$local.rv$columns$choices$sites <- list()
     .col <- main.env$local.rv$columns$choices$coords <- list()
     sapply(names(.att), function(.md.file) {
-      browser()
       .data.file <- main.env$save.variable$DataFiles %>%
-        filter(grepl(.md.file, metadatapath)) %>%
-        select(datapath) %>%
+        filter(grepl(.md.file, metadatapath)) %>% # full metadata path of attributes
+        select(datapath) %>% # full matching data path
         unlist %>%
         basename
       # Set sites

R/template_functions.R

@@ -148,7 +148,7 @@ templateModules <- function(main.env, page){
         data.path = main.env$save.variable$SelectDP$dp.data.path
       )
     }
-browser()
+    
     # Check for EAL issues
     if(exists("template_issues")) 
       stop("EAL template issues - CatVar")
@@ -161,7 +161,7 @@ browser()
     )
 
     # Check for EAL issues
-    if(exists("template_issues")) 
+    if(exists("template_issues"))
       stop("EAL template issues - GeoCov")
 
     return("done")