Dropbox

.Rbuildignore

@@ -13,3 +13,4 @@ psychTestR.pdf
 ^vignettes/output$
 ^docs$
 ^tests/testthat/output$
+^\.httr-oauth$

.gitignore

@@ -7,3 +7,5 @@ closed.txt
 output
 docs
 vignettes/output
+.DS_Store
+.httr-oauth

DESCRIPTION

@@ -34,9 +34,12 @@ Imports:
     htm2txt,
     shinytest,
     testthat (>= 2.0.0),
-    stringr (>= 1.4.0)
+    stringr (>= 1.4.0),
+    withr,
+    uuid,
+    rdrop2 (>= 0.8.1)
 Depends: R (>= 3.4.0)
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1
 Suggests: 
     knitr,
     rmarkdown

NAMESPACE

@@ -17,7 +17,9 @@ export("answer<-")
 export("error<-")
 export("results<-")
 export(AppTester)
+export(DropboxRepository)
 export(I18N_STATE)
+export(LocalRespository)
 export(NAFC_page)
 export(answer)
 export(as.timeline)
@@ -50,7 +52,6 @@ export(get_local)
 export(get_p_id)
 export(get_results)
 export(get_session_info)
-export(get_supplementary_results_dir)
 export(get_url_params)
 export(i18n)
 export(i18n_dict)

NEWS.md

@@ -1,3 +1,5 @@
+- Removed `supplementary_results_dir`.
+
 # psychTestR 2.19.1
 
 - Adding an input check for conditional().

R/admin-panel.R

@@ -238,7 +238,7 @@ admin_panel.statistics.num_participants <- function(input, output, opt) {
     input$admin_panel.statistics.refresh
     input$admin_panel.statistics.open
     shiny::showNotification("Refreshing statistics...")
-    df <- tabulate_results(opt, include_pilot = FALSE)
+    df <- opt$repository$tabulate_results(include_pilot = FALSE)
     n_complete <- sum(df$complete)
     n_part_complete <- sum(!df$complete)
     shiny::p(
@@ -258,11 +258,10 @@ admin_panel.statistics.latest_results <- function(input, output, opt) {
   output$admin_panel.statistics.latest_results <- shiny::renderUI({
     input$admin_panel.statistics.refresh
     input$admin_panel.statistics.open
-    files <- tabulate_results(opt, include_pilot = FALSE)
-    if (nrow(files) > 0L) {
-      latest_file <- files$file[[which.max(files$id)]]
-      latest_path <- file.path(opt$results_dir, latest_file)
-      latest_data <- readRDS(latest_path)
+    results_table <- opt$repository$tabulate_results(include_pilot = FALSE)
+    if (nrow(results_table) > 0L) {
+      latest_key <- results_table$key[[which.max(results_table$id)]]
+      latest_data <- opt$repository$load_results(latest_key)
       latest_time <- as.list(latest_data)$session$current_time
       if (!is.null(latest_time)) {
         time_diff <- Sys.time() - latest_time
@@ -281,11 +280,10 @@ admin_panel.statistics.average_time <- function(input, output, opt) {
   output$admin_panel.statistics.average_time <- shiny::renderUI({
     input$admin_panel.statistics.refresh
     input$admin_panel.statistics.open
-    files <- tabulate_results(opt, include_pilot = FALSE)
-    files <- files[files$complete, ]
-    if (nrow(files) > 0L) {
-      data <- lapply(files$full_file, readRDS)
-      time_taken <- vapply(data, function(x) {
+    results <- opt$repository$load_all_results(include_pilot = FALSE)
+    results <- results[results$complete, ]
+    if (nrow(results) > 0L) {
+      time_taken <- vapply(results$data, function(x) {
         difftime(x$session$current_time, x$session$time_started, units = "mins")
       }, numeric(1))
       M <- mean(time_taken)
@@ -317,20 +315,26 @@ admin_panel.clear_sessions.observers <- function(state, input, opt) {
 }
 
 admin_panel.delete_results.actual <- function(opt) {
-  dir <- opt$results_archive_dir
-  R.utils::mkdirs(dir)
-  file <- paste0(format(Sys.time(),
-                        format = "date=%Y-%m-%d&time=%H-%M-%S&tz=%Z"),
-                 ".zip")
-  path <- file.path(dir, file)
+  # "deleted-results"
+  zip_key <- paste0(
+    format(Sys.time(), format = "date=%Y-%m-%d&time=%H-%M-%S&tz=%Z"),
+    ".zip"
+  )
   shiny::showNotification("Creating results backup...")
-  zip_dir(dir = opt$results_dir, output_file = path)
-  if (file.exists(path)) {
+
+  tmp_results_dir <- tempfile("dir")
+  opt$repository$download_results_dir(tmp_results_dir)
+
+  tmp_zip_file <- tempfile(fileext = ".zip")
+
+  zip_dir(dir = tmp_results_dir, output_file = tmp_zip_file)
+  opt$repository$deposit_file(tmp_zip_file, "deleted-results", zip_key)
+
+  if (opt$repository$file_exists("deleted-results", zip_key)) {
     shiny::showNotification("Backup created.")
-    unlink(opt$results_dir, recursive = TRUE)
+    opt$repository$delete_folder("results")
     Sys.sleep(0.01)
-    dir.create(opt$results_dir)
-    dir.create(opt$supplementary_results_dir)
+    opt$repository$create_folder("results")
     shiny::showNotification("Deleted results.")
   } else {
     shiny::showNotification(
@@ -444,7 +448,7 @@ admin_panel.handle_downloads.all_results.csv <- function(state, output, opt) {
     filename = "results.csv",
     content = function(file) {
       df <- tryCatch({
-        df_all_results(opt$results_dir) %>%
+        df_all_results(opt) %>%
           list_cols_to_json()
       }, error = function(e) {
         print(e)
@@ -484,8 +488,8 @@ zip_dir <- function(dir, output_file) {
   )
 }
 
-df_all_results <- function(results_dir) {
-  files <- list_results_files(results_dir, full.names = TRUE)
+df_all_results <- function(opt) {
+  files <- get_results_files(opt, full.names = TRUE)
   if (length(files) == 0L) return(data.frame())
   data <- lapply(files, readRDS)
   data_df <- lapply(data, as.data.frame)

R/app_tester.R

@@ -75,7 +75,6 @@ AppTester <- R6::R6Class(
   "AppTester",
   inherit = shinytest::ShinyDriver,
   public = list(
-
     get_ui = function() {
       self$getAllValues(input = FALSE, output = FALSE, export = TRUE)$export$ui
     },

R/make-test.R

@@ -24,10 +24,13 @@ make_test <- function(elts, opt = demo_options(),
   if (is.list(elts)) elts <- new_timeline(elts)
   check_elts(elts)
   check_opt(opt, elts)
-  shiny::shinyApp(
+  app <- shiny::shinyApp(
     ui = ui(opt = opt),
     server = server(elts = elts, opt = opt,
                     custom_admin_panel = custom_admin_panel))
+  app$opt <- opt
+  app$opt$repository$check()
+  app
 }
 
 check_opt <- function(opt, elts) {

R/options.R

@@ -109,7 +109,8 @@ test_options <- function(title, admin_password,
                          logo_height = NULL,
                          display = display_options(),
                          allow_url_rewrite = TRUE,
-                         advance_delay = 0) {
+                         advance_delay = 0,
+                         repository = LocalRespository$new(output_dir)) {
   stopifnot(is.character(title),
             is.scalar.character(admin_password),
             is.null.or(researcher_email, is.scalar.character),
@@ -139,7 +140,8 @@ test_options <- function(title, admin_password,
               (is.scalar.character(logo_width) && is.scalar.character(logo_height)),
             is.list(display),
             is.scalar.logical(allow_url_rewrite),
-            is.scalar.numeric(advance_delay))
+            is.scalar.numeric(advance_delay),
+            is(repository, "Repository"))
   # if (is.null(session_dir)) session_dir <- get_default_session_dir()
 
   if (!allow_url_rewrite && enable_resume_session) {
@@ -191,10 +193,7 @@ test_options <- function(title, admin_password,
   }
   server_closed_msg <- enc2utf8(server_closed_msg)
 
-  results_dir <- file.path(output_dir, "results")
-  supplementary_results_dir <- file.path(results_dir, "supplementary")
   session_dir <- file.path(output_dir, "sessions")
-  results_archive_dir <- file.path(output_dir, "deleted-results")
   error_dir <- file.path(output_dir, "errors")
 
   list(title = title,
@@ -218,11 +217,9 @@ test_options <- function(title, admin_password,
        allow_any_p_id_url = allow_any_p_id_url,
        force_p_id_from_url = force_p_id_from_url,
        enable_admin_panel = enable_admin_panel,
+       repository = repository,
        output_dir = output_dir,
-       results_dir = results_dir,
-       supplementary_results_dir = supplementary_results_dir,
        session_dir = session_dir,
-       results_archive_dir = results_archive_dir,
        error_dir = error_dir,
        closed_file = file.path(output_dir, "closed.txt"),
        session_timeout_min = session_timeout_min,
@@ -379,8 +376,7 @@ test_permissions <- function(dir) {
   success
 }
 
-OUTPUT_DIRS <- c("output_dir", "results_dir", "session_dir",
-                 "results_archive_dir", "error_dir")
+OUTPUT_DIRS <- c("output_dir", "session_dir", "error_dir")
 
 #' Check directories
 #'