Merge branch '41-fix-queryserver-gor-query-exception-message' into 'm…

…aster'

Resolve "Fix queryserver GOR query exception message"

Closes #41

See merge request wuxi-nextcode/wxnc-plat/gorr!58

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: gorr
 Title: Genuity Science service API for R
-Version: 1.6.2
+Version: 1.6.3
 Authors@R: c(
     person("Genuity", "Science", role = c("aut", "cre","cph"), email = "[email protected]"),
     person("Edvald", "Gislason", role = "aut", email = ""),

NEWS.md

@@ -1,8 +1,12 @@
+# gorr 1.6.3
+
+* `queryserver` as default query service
+* Bugfix
+
 # gorr 1.6.2
 
 * Default query service reverted to `queryservice`
 
-
 # gorr 1.6.1
 
 * `queryserver` Improved exception handling 

R/aaa.R

@@ -1,3 +1,3 @@
 utils::globalVariables(c(
-    "iss", "scheme", "hostname", "path", "knit_engines", "query", "getDTthreads", "_fn", "_out", "."
+    "iss", "scheme", "hostname", "path", "knit_engines", "query", "getDTthreads", "_fn", "_out", ".", "name", "string", "code", "..count.."
 ))

R/gor_create.R

@@ -23,7 +23,7 @@
 #' query("nor [air] | map -c Month [months]")
 #' }
 #' @export
-gor_create <- function(..., defs = NULL, conn = NULL, replace = NULL, query.service = "queryservice") {
+gor_create <- function(..., defs = NULL, conn = NULL, replace = NULL, query.service = "queryserver") {
     defs <- gor_define(defs)
 
     dots <- rlang::dots_list(...)

R/gor_query.R

@@ -58,7 +58,7 @@ gorr__api_request <- function(request.fun = c("POST", "GET", "DELETE", "PATCH"),
 #' "gor #dbsnp# | top 100" %>%
 #'     gor_query(conn)
 #' }
-gor_query <- function(query, conn, timeout = 0, page_size = 100e3, parse = T, relations = NULL, persist = NULL, query.service = "queryservice") {
+gor_query <- function(query, conn, timeout = 0, page_size = 100e3, parse = T, relations = NULL, persist = NULL, query.service = "queryserver") {
     assertthat::assert_that(is.string(query))
     assertthat::assert_that(class(conn) == "platform_connection")
 

R/gor_queryserver.R

@@ -73,26 +73,31 @@ gorr__kill_stream <- function() {
 # Process status messages from stream
 gorr__process_msg <- function(stream, spinner, elapsed, msg) {
     # Process last message from stream
+    tryCatch({
     parsed_msg <- gorr__extract_msg(stream) %>%
         dplyr::last() %>%
         stringr::str_match(pattern="^\\s?([\\w]+)\\s(.*)") %>% #Get ([STATUS]) ([REST])
         as.character()
-
-    status <- parsed_msg[2]
-    tryCatch({
-        if (status == "EXCEPTION") {
-            gorr__failure("Query Failure", detail = parsed_msg[3])
-        } else if (status == "GOR") {
-            msg <- list(status = "RUNNING", info = paste0(msg$info, "."))
-        } else if (status == "DONE") {
-            stats <- jsonlite::fromJSON(parsed_msg[3])
-
-            msg <- list(status = status, info = paste0(" ", " \n Result details: ",
-                                                       stats$lineCount, " rows, total size: ",
-                                                       fs::fs_bytes(stats$bytesCount), "bytes \n"))
-        } else {
-            msg <- list(status="UNKOWN", info = parsed_msg[1])
-        }
     }, error = function(x) gorr__failure("Unprocessable Message", detail = stream))
+    status <- parsed_msg[2]
+    if (status == "EXCEPTION") {
+        gorr__failure("FAILED", detail = gorr__get_error_msg(parsed_msg[3]))
+    } else if (status == "GOR") {
+        msg <- list(status = "RUNNING", info = paste0(msg$info, "."))
+    } else if (status == "DONE") {
+        stats <- jsonlite::fromJSON(parsed_msg[3])
+
+        msg <- list(status = status, info = paste0(" ", " \n Result details: ",
+                                                   stats$lineCount, " rows, total size: ",
+                                                   fs::fs_bytes(stats$bytesCount), "bytes \n"))
+    } else {
+        msg <- list(status="UNKOWN", info = parsed_msg[1])
+
+    }
     msg
 }
+
+gorr__get_error_msg <- purrr::compose(~ purrr::pluck(.x, 1, 1),
+                                      purrr::partial(stringr::str_split, pattern = "Stack Trace"),
+                                      ~ purrr::pluck(.x, "gorMessage"),
+                                      jsonlite::fromJSON)

R/phenotype_get_data.R

@@ -21,13 +21,13 @@
 #' phenotype_data <- get_data(phenotype_mat, conn)
 #' }
 get_data <- function(pheno_obj, ...) {
-    UseMethod("get_data", pheno_obj)
+    UseMethod("get_data")
 }
 
 #' @describeIn get_data Get phenotype data
 #' @param conn platform connection structure, create it using \code{\link{platform_connect}}
 #' @export
-get_data.phenotype <- function(pheno_obj, conn = NULL) {
+get_data.phenotype <- function(pheno_obj, conn = NULL, ...) {
     if (!missing(conn)) {
         warning("phenotype structure provided - conn argument ignored")
     }
@@ -44,7 +44,7 @@ get_data.phenotype <- function(pheno_obj, conn = NULL) {
 #' @describeIn get_data Get data for phenotypes in phenotype matrix
 #' @param conn platform connection structure, create it using \code{\link{platform_connect}}
 #' @export
-get_data.phenotype_matrix <- function(pheno_obj, conn = NULL) {
+get_data.phenotype_matrix <- function(pheno_obj, conn = NULL, ...) {
     assertthat::assert_that(!is.null(conn) || !is.null( attr(pheno_obj, which = "conn") ))
 
     conn_obj <- attr(pheno_obj, which = "conn") %||% conn
@@ -67,7 +67,7 @@ get_data.phenotype_matrix <- function(pheno_obj, conn = NULL) {
 #' @param missing_value The string to substitute for a missing value in the data
 #' @param base Optional name of base set
 #' @export
-get_data.playlist <- function(pheno_obj, missing_value = NULL, base = NULL) {
+get_data.playlist <- function(pheno_obj, missing_value = NULL, base = NULL, ...) {
     content <- list(base = base,
                     phenotypes = purrr::map(names(pheno_obj$phenotypes), ~list(name = .x, missing_value = missing_value))
                     )
@@ -79,7 +79,7 @@ get_data.playlist <- function(pheno_obj, missing_value = NULL, base = NULL) {
 #' @param missing_value The string to substitute for a missing value in the data
 #' @param base Optional name of base set
 #' @export
-get_data.phenotype_list <- function(pheno_obj, missing_value = NULL, base = NULL) {
+get_data.phenotype_list <- function(pheno_obj, missing_value = NULL, base = NULL, ...) {
     conn = attr(pheno_obj[[1]], which = "conn")
     pheno_names = names(pheno_obj)
     get_data(pheno_names, missing_value=missing_value, base=base, conn=conn)
@@ -91,7 +91,7 @@ get_data.phenotype_list <- function(pheno_obj, missing_value = NULL, base = NULL
 #' @param missing_value The string to substitute for a missing value in the data
 #' @param base Optional name of base set
 #' @export
-get_data.default <- function(pheno_obj, conn, missing_value = NA, base = NULL) {
+get_data.default <- function(pheno_obj, conn, missing_value = NA, base = NULL, ...) {
     assertthat::assert_that(is.list(pheno_obj) | is.character(pheno_obj))
 
     # Handle if provided pheno_obj is an element from an phenotype_list structure

R/phenotype_plot.R

@@ -35,7 +35,8 @@ phenotype_plot <- function(phenotype, title=NULL, y=NULL, x=NULL) {
 #'
 #' @return ggplot2 object
 plot__qt <- function(df, colname, fill) {
-    p <- ggplot2::ggplot(df, ggplot2::aes_string(x=colname)) +
+    p <- ggplot2::ggplot(df,
+                         ggplot2::aes_string(x=colname)) +
         ggplot2::geom_histogram(fill=fill, binwidth = 3)
 }
 
@@ -52,8 +53,9 @@ plot__category <- function(df, colname, fill) {
         dplyr::mutate_at(2, factor) %>%
         dplyr::group_by_at(2) %>%
         dplyr::summarise(count=dplyr::n())
-    p <- ggplot2::ggplot(data=df, ggplot2::aes_string(x=colname, y="count")) +
-                ggplot2::geom_bar(stat="identity", fill=fill)
+    p <- ggplot2::ggplot(data=df,
+                         ggplot2::aes_string(x=colname, y="count")) +
+        ggplot2::geom_bar(stat="identity", fill=fill)
 }
 
 

R/phenotype_services.R

@@ -484,7 +484,7 @@ deprecated_argument_msg <- function(arg, custom=NULL) {
 #' project <- Sys.getenv("GOR_PROJECT")
 #' conn <- platform_connect(api_key, project)
 #' phenotype <- get_phenotype(name="height", conn)
-#' tags <- phenotype_get_errors(phenotype)
+#' phenotype_get_errors(phenotype)
 #' }
 phenotype_get_errors <- function(phenotype) {
     assertthat::assert_that(class(phenotype) == "phenotype")
@@ -505,11 +505,11 @@ phenotype_get_errors <- function(phenotype) {
 #' project <- Sys.getenv("GOR_PROJECT")
 #' conn <- platform_connect(api_key, project)
 #' phenotype <- get_phenotype(name="height", conn)
-#' tags <- phenotype_get_error(phenotype)
+#' phenotype_get_error(phenotype)
 #' }
 phenotype_get_error <- function(phenotype) {
     assertthat::assert_that(class(phenotype) == "phenotype")
-    format_error <- purrr::compose(capture_output,
+    format_error <- purrr::compose(purrr::partial(utils::capture.output, split=TRUE),
                                    cat,
                                    purrr::partial(gsub, pattern = "\\\\n", replacement = "\\\n", ... =),
                                    purrr::partial(gsub, pattern = "\\\\t", replacement = "\\\t", ... =)