parse dates on first upload

seroanalytics · Sep 16, 2024 · 92cb94a · 92cb94a
1 parent 2e0b656
commit 92cb94a
Show file tree

Hide file tree

Showing 4 changed files with 28 additions and 14 deletions.
diff --git a/R/api.R b/R/api.R
@@ -46,10 +46,25 @@ target_post_dataset <- function(req, res) {
     return(bad_request_response(msg))
   }
 
+  if (suppressWarnings(all(is.na(as.numeric(file_body[, xcol]))))) {
+    xtype <- "date"
+    file_body[, xcol] <- parse_date(file_body[, xcol])
+    if (suppressWarnings(all(is.na(file_body[, xcol])))) {
+      msg <- paste("Invalid x column values:",
+                   "these should be numbers or dates in a standard format")
+      return(bad_request_response(msg))
+    }
+    logger::log_info("Detected date values in x column")
+  } else {
+    logger::log_info("Detected numeric values in x column")
+    xtype <- "number"
+  }
+
   logger::log_info(paste("Saving dataset", filename, "to disk"))
   dir.create(path, recursive = TRUE)
   utils::write.csv(file_body, file.path(path, "data"), row.names = FALSE)
   write(xcol, file.path(path, "xcol"))
+  write(xtype, file.path(path, "xtype"))
   response_success(jsonlite::unbox(filename))
 }
 
@@ -160,20 +175,10 @@ read_dataset <- function(req, name, scale) {
     dat$value <- log2(dat$value)
   }
   xcol <- readLines(file.path(path, "xcol"))
+  xtype <- readLines(file.path(path, "xtype"))
   logger::log_info("Parsing x column values")
-  if (suppressWarnings(all(is.na(as.numeric(dat[, xcol]))))) {
-    xtype <- "date"
-    dat[, xcol] <- as.Date(lubridate::parse_date_time(dat[, xcol],
-                                              c("dmy", "mdy", "ymd", "ydm")))
-    if (suppressWarnings(all(is.na(dat[, xcol])))) {
-      msg <- paste("Invalid x column values:",
-                   "these should be numbers or dates in a standard format")
-      porcelain::porcelain_stop(msg)
-    }
-    logger::log_info("Detected date values in x column")
-  } else {
-    logger::log_info("Deteced numeric values in x column")
-    xtype <- "number"
+  if (xtype == "date") {
+    dat[, xcol] <- as.Date(dat[, xcol], origin = "1970-01-01")
   }
   list(data = dat, xcol = xcol, xtype = xtype)
 }

diff --git a/R/utils.R b/R/utils.R
@@ -22,3 +22,8 @@ validate_scale <- function(scale) {
     )
   }
 }
+
+parse_date <- function(dat) {
+  as.Date(lubridate::parse_date_time(dat,
+                                     c("dmy", "mdy", "ymd", "ydm")))
+}
diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
@@ -22,6 +22,7 @@ local_add_dataset <- function(dat, name, session = session_id, env = parent.fram
   dir.create(filepath, recursive = TRUE)
   write.csv(dat, file.path(filepath, "data"), row.names = FALSE)
   write("day", file.path(filepath, "xcol"))
+  write("number", file.path(filepath, "xtype"))
   withr::defer(fs::dir_delete(filepath), envir = env)
   name
 }

diff --git a/tests/testthat/test-read.R b/tests/testthat/test-read.R
@@ -296,7 +296,10 @@ test_that("can get dataset with dates", {
                     value = 1:5,
                     day = dates)
   router <- build_routes(cookie_key)
-  local_add_dataset(dat, name = "testdataset")
+  post_request <- local_POST_dataset_request(dat,
+                                             "testdataset",
+                                             cookie = cookie)
+  expect_equal(router$call(post_request)$status, 200)
   res <- router$call(make_req("GET",
                               "/dataset/testdataset/trace/ab/",
                               HTTP_COOKIE = cookie))