diff --git a/.Rbuildignore b/.Rbuildignore index 23f5539..fc61361 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -6,4 +6,5 @@ ^docker$ ^\.github$ ^\.idea$ -^\uploads$ \ No newline at end of file +^\uploads$ +^.lintr diff --git a/.lintr b/.lintr new file mode 100644 index 0000000..e3a0f44 --- /dev/null +++ b/.lintr @@ -0,0 +1,2 @@ +linters: linters_with_defaults(object_usage_linter = NULL, indentation_linter = NULL, commented_code_linter = NULL) +encoding: "UTF-8" diff --git a/R/api.R b/R/api.R index 5fa1694..1fbbc3e 100644 --- a/R/api.R +++ b/R/api.R @@ -3,19 +3,23 @@ target_get_root <- function() { } target_get_version <- function() { - jsonlite::toJSON(as.character(utils::packageVersion("serovizr")), auto_unbox = TRUE) + jsonlite::toJSON(as.character(utils::packageVersion("serovizr")), + auto_unbox = TRUE) } target_post_dataset <- function(req, res) { parsed <- Rook::Multipart$parse(req) file_body <- utils::read.csv(parsed$file$tempfile) filename <- parsed$file$filename - filename <- stringr::str_remove_all(filename, paste0(".", tools::file_ext(filename))) + filename <- stringr::str_remove_all(filename, + paste0(".", tools::file_ext(filename))) path <- file.path("uploads", filename) if (file.exists(path)) { res$status <- 400L - error <- list(error = "BAD_REQUEST", detail = paste("A dataset called", filename, - "already exists. Please choose a unique name for this dataset.")) + msg <- paste(filename, "already exists.", + "Please choose a unique name for this dataset.") + error <- list(error = "BAD_REQUEST", + detail = msg) return(list(status = "failure", errors = list(error), data = NULL)) } required_cols <- c("value", "biomarker") @@ -23,7 +27,8 @@ target_post_dataset <- function(req, res) { if (length(missing_cols) > 0) { res$status <- 400L error <- list(error = "BAD_REQUEST", - detail = paste("Missing required columns:", paste(missing_cols, collapse = ", "))) + detail = paste("Missing required columns:", + paste(missing_cols, collapse = ", "))) return(list(status = "failure", errors = list(error), data = NULL)) } @@ -51,7 +56,8 @@ target_get_datasets <- function() { } target_get_trace <- function(name, biomarker, facet = NULL, trace = NULL) { - logger::log_info(paste("Requesting data from", name, "with biomarker", biomarker)) + logger::log_info(paste("Requesting data from", name, + "with biomarker", biomarker)) logger::log_info(paste("Filtering by facet variables", facet)) dat <- read_dataset(name) cols <- colnames(dat) @@ -63,7 +69,7 @@ target_get_trace <- function(name, biomarker, facet = NULL, trace = NULL) { # code = "BAD_REQUEST", status_code = 400L) # } # dat <- dat[dat[facet_var] == facet_level & dat["biomarker"] == biomarker,] - dat <- dat[dat["biomarker"] == biomarker,] + dat <- dat[dat["biomarker"] == biomarker, ] dat$value <- log(dat$value) if (length(trace) > 0) { logger::log_info(paste("Disaggregating by trace variables", trace)) diff --git a/R/router.R b/R/router.R index de14b33..c547c7c 100644 --- a/R/router.R +++ b/R/router.R @@ -7,7 +7,8 @@ build_routes <- function() { pr$handle(get_root()) pr$handle(get_version()) - pr$handle("POST", "/dataset/", function(req, res) target_post_dataset(req, res), + pr$handle("POST", "/dataset/", + function(req, res) target_post_dataset(req, res), serializer = plumber::serializer_unboxed_json()) pr$handle(get_dataset()) pr$handle(get_datasets()) @@ -16,17 +17,19 @@ build_routes <- function() { get_root <- function() { - porcelain::porcelain_endpoint$new("GET", - "/", - target_get_root, - returning = porcelain::porcelain_returning_json()) + porcelain::porcelain_endpoint$new( + "GET", + "/", + target_get_root, + returning = porcelain::porcelain_returning_json()) } get_version <- function() { - porcelain::porcelain_endpoint$new("GET", - "/version", - target_get_version, - returning = porcelain::porcelain_returning_json("Version")) + porcelain::porcelain_endpoint$new( + "GET", + "/version", + target_get_version, + returning = porcelain::porcelain_returning_json("Version")) } get_dataset <- function() { @@ -38,14 +41,16 @@ get_dataset <- function() { get_datasets <- function() { porcelain::porcelain_endpoint$new( - "GET", "/datasets/", + "GET", + "/datasets/", target_get_datasets, returning = porcelain::porcelain_returning_json("Datasets")) } get_trace <- function() { porcelain::porcelain_endpoint$new( - "GET", "/dataset///", + "GET", + "/dataset///", target_get_trace, porcelain::porcelain_input_query(facet = "string", trace = "string"), returning = porcelain::porcelain_returning_json()) diff --git a/README.md b/README.md index 832616f..ca968a5 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,8 @@ [![Project Status: Concept – Minimal or no implementation has been done yet, or the repository is only intended to be a limited example, demo, or proof-of-concept.](https://www.repostatus.org/badges/latest/concept.svg)](https://www.repostatus.org/#concept) -[![R-CMD-check.yaml](https://github.com/seroanalytics/serovizr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/seroanalytics/serovizr/actions/workflows/R-CMD-check.yaml)[![Codecov test coverage](https://codecov.io/gh/seroanalytics/serovizr/branch/master/graph/badge.svg)](https://codecov.io/gh/seroanalytics/serovizr?branch=master) +[![R-CMD-check.yaml](https://github.com/seroanalytics/serovizr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/seroanalytics/serovizr/actions/workflows/R-CMD-check.yaml) +[![Codecov test coverage](https://codecov.io/gh/seroanalytics/serovizr/branch/master/graph/badge.svg)](https://codecov.io/gh/seroanalytics/serovizr?branch=master) R API for the SeroViz app. Based on the [porcelain](https://github.com/reside-ic/porcelain) framework.