[ARVADOS] updated: 1.1.2-189-g6f1b9ff
Git user
git at public.curoverse.com
Tue Jan 23 11:20:09 EST 2018
Summary of changes:
sdk/R/R/Arvados.R | 6 +--
sdk/R/R/ArvadosFile.R | 15 +++---
sdk/R/R/HttpRequest.R | 100 +++++++++++++++++----------------------
sdk/R/R/Subcollection.R | 16 ++++---
sdk/R/R/util.R | 38 +++++++++++++++
sdk/R/tests/testthat/test-util.R | 44 +++++++++++++++++
6 files changed, 147 insertions(+), 72 deletions(-)
via 6f1b9ffa9cf4abe9f08455346c917f66b8c5e9a5 (commit)
from 64aee8cfd4164f3c0dae26fe62cc9ee22b16782b (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
commit 6f1b9ffa9cf4abe9f08455346c917f66b8c5e9a5
Author: Fuad Muhic <fmuhic at capeannenterprises.com>
Date: Tue Jan 23 17:16:50 2018 +0100
Fixed ArvadosFile/Subcollection move bug and improved http query
generation logic.
Arvados-DCO-1.1-Signed-off-by: Fuad Muhic <fmuhic at capeannenterprises.com>
diff --git a/sdk/R/R/Arvados.R b/sdk/R/R/Arvados.R
index a22ff73..18b42f6 100644
--- a/sdk/R/R/Arvados.R
+++ b/sdk/R/R/Arvados.R
@@ -158,9 +158,9 @@ Arvados <- R6::R6Class(
private = list(
- token = NULL,
- host = NULL,
- REST = NULL
+ token = NULL,
+ host = NULL,
+ REST = NULL
),
cloneable = FALSE
diff --git a/sdk/R/R/ArvadosFile.R b/sdk/R/R/ArvadosFile.R
index cab7850..8ca818b 100644
--- a/sdk/R/R/ArvadosFile.R
+++ b/sdk/R/R/ArvadosFile.R
@@ -124,34 +124,37 @@ ArvadosFile <- R6::R6Class(
writeResult
},
- move = function(newLocationInCollection)
+ move = function(newLocation)
{
if(is.null(private$collection))
stop("ArvadosFile doesn't belong to any collection")
- newLocationInCollection <- trimFromEnd(newLocationInCollection, "/")
- newParentLocation <- trimFromEnd(newLocationInCollection, private$name)
- newParent <- private$collection$get(newParentLocation)
+ newLocation <- trimFromEnd(newLocation, "/")
+ nameAndPath <- splitToPathAndName(newLocation)
+
+ newParent <- private$collection$get(nameAndPath$path)
if(is.null(newParent))
{
stop("Unable to get destination subcollection")
}
- childWithSameName <- newParent$get(private$name)
+ childWithSameName <- newParent$get(nameAndPath$name)
if(!is.null(childWithSameName))
stop("Destination already contains content with same name.")
REST <- private$collection$getRESTService()
REST$move(self$getRelativePath(),
- paste0(newParent$getRelativePath(), "/", self$getName()),
+ paste0(newParent$getRelativePath(), "/", nameAndPath$name),
private$collection$uuid)
private$dettachFromCurrentParent()
private$attachToNewParent(newParent)
+ private$name <- nameAndPath$name
+
"Content moved successfully."
}
),
diff --git a/sdk/R/R/HttpRequest.R b/sdk/R/R/HttpRequest.R
index 5cee567..11616bd 100644
--- a/sdk/R/R/HttpRequest.R
+++ b/sdk/R/R/HttpRequest.R
@@ -1,3 +1,5 @@
+source("./R/util.R")
+
HttpRequest <- R6::R6Class(
"HttrRequest",
@@ -14,7 +16,7 @@ HttpRequest <- R6::R6Class(
GET = function(url, headers = NULL, queryFilters = NULL, limit = NULL, offset = NULL)
{
headers <- httr::add_headers(unlist(headers))
- query <- private$createQuery(queryFilters, limit, offset)
+ query <- self$createQuery(queryFilters, limit, offset)
url <- paste0(url, query)
serverResponse <- httr::GET(url = url, config = headers)
@@ -24,7 +26,7 @@ HttpRequest <- R6::R6Class(
queryFilters = NULL, limit = NULL, offset = NULL)
{
headers <- httr::add_headers(unlist(headers))
- query <- private$createQuery(queryFilters, limit, offset)
+ query <- self$createQuery(queryFilters, limit, offset)
url <- paste0(url, query)
serverResponse <- httr::PUT(url = url, config = headers, body = body)
@@ -34,7 +36,7 @@ HttpRequest <- R6::R6Class(
queryFilters = NULL, limit = NULL, offset = NULL)
{
headers <- httr::add_headers(unlist(headers))
- query <- private$createQuery(queryFilters, limit, offset)
+ query <- self$createQuery(queryFilters, limit, offset)
url <- paste0(url, query)
serverResponse <- httr::POST(url = url, config = headers, body = body)
@@ -44,7 +46,7 @@ HttpRequest <- R6::R6Class(
queryFilters = NULL, limit = NULL, offset = NULL)
{
headers <- httr::add_headers(unlist(headers))
- query <- private$createQuery(queryFilters, limit, offset)
+ query <- self$createQuery(queryFilters, limit, offset)
url <- paste0(url, query)
serverResponse <- httr::DELETE(url = url, config = headers)
@@ -56,7 +58,7 @@ HttpRequest <- R6::R6Class(
curl::handle_setopt(h, customrequest = "PROPFIND")
curl::handle_setheaders(h, .list = headers)
- propfindResponse <- curl::curl_fetch_memory(url, h)
+ propfindResponse <- curl::curl_fetch_memory(url, h)
},
MOVE = function(url, headers = NULL)
@@ -66,85 +68,71 @@ HttpRequest <- R6::R6Class(
curl::handle_setheaders(h, .list = headers)
propfindResponse <- curl::curl_fetch_memory(url, h)
- }
- ),
-
- private = list(
+ },
createQuery = function(filters, limit, offset)
{
finalQuery <- NULL
- if(!is.null(filters))
- {
- filters <- sapply(filters, function(filter)
- {
- if(length(filter) != 3)
- stop("Filter list must have exactly 3 elements.")
-
- attributeAndOperator = filter[c(1, 2)]
- filterList = filter[[3]]
- filterListIsPrimitive = TRUE
- if(length(filterList) > 1)
- filterListIsPrimitive = FALSE
+ finalQuery <- c(finalQuery, private$createFiltersQuery(filters))
+ finalQuery <- c(finalQuery, private$createLimitQuery(limit))
+ finalQuery <- c(finalQuery, private$createOffsetQuery(offset))
- attributeAndOperator <- sapply(attributeAndOperator, function(component) {
- component <- paste0("\"", component, "\"")
- })
+ finalQuery <- finalQuery[!is.null(finalQuery)]
+ finalQuery <- paste0(finalQuery, collapse = "&")
- filterList <- sapply(unlist(filterList), function(filter) {
- filter <- paste0("\"", filter, "\"")
- })
-
- filterList <- paste(filterList, collapse = ",+")
-
- if(!filterListIsPrimitive)
- filterList <- paste0("[", filterList, "]")
+ if(finalQuery != "")
+ finalQuery <- paste0("/?", finalQuery)
- filter <- c(attributeAndOperator, filterList)
+ finalQuery
+ }
+ ),
- queryParameter <- paste(filter, collapse = ",+")
- queryParameter <- paste0("[", queryParameter, "]")
-
- })
+ private = list(
- filters <- paste(filters, collapse = ",+")
- filters <- paste0("[", filters, "]")
+ createFiltersQuery = function(filters)
+ {
+ if(!is.null(filters))
+ {
+ filters <- RListToPythonList(filters, ",+")
encodedQuery <- URLencode(filters, reserved = T, repeated = T)
-
encodedQuery <- stringr::str_replace_all(encodedQuery, "%2B", "+")
- finalQuery <- c(finalQuery, paste0("filters=", encodedQuery))
-
- finalQuery
+ return(paste0("filters=", encodedQuery))
}
+ return(NULL)
+ },
+
+ createLimitQuery = function(limit)
+ {
if(!is.null(limit))
{
- if(!is.numeric(limit))
+ limit <- suppressWarnings(as.numeric(limit))
+
+ if(is.na(limit))
stop("Limit must be a numeric type.")
- finalQuery <- c(finalQuery, paste0("limit=", limit))
+ return(paste0("limit=", limit))
}
+ return(NULL)
+ },
+
+ createOffsetQuery = function(offset)
+ {
if(!is.null(offset))
{
- if(!is.numeric(offset))
+ offset <- suppressWarnings(as.numeric(offset))
+
+ if(is.na(offset))
stop("Offset must be a numeric type.")
- finalQuery <- c(finalQuery, paste0("offset=", offset))
- }
-
- if(length(finalQuery) > 1)
- {
- finalQuery <- paste0(finalQuery, collapse = "&")
+ return(paste0("offset=", offset))
}
- if(!is.null(finalQuery))
- finalQuery <- paste0("/?", finalQuery)
-
- finalQuery
+ return(NULL)
}
),
diff --git a/sdk/R/R/Subcollection.R b/sdk/R/R/Subcollection.R
index 801cf69..c42e7e5 100644
--- a/sdk/R/R/Subcollection.R
+++ b/sdk/R/R/Subcollection.R
@@ -132,35 +132,37 @@ Subcollection <- R6::R6Class(
return(sum(fileSizes))
},
- move = function(newLocationInCollection)
+ move = function(newLocation)
{
if(is.null(private$collection))
stop("Subcollection doesn't belong to any collection")
- newLocationInCollection <- trimFromEnd(newLocationInCollection, "/")
- newParentLocation <- trimFromEnd(newLocationInCollection, private$name)
+ newLocation <- trimFromEnd(newLocation, "/")
+ nameAndPath <- splitToPathAndName(newLocation)
- newParent <- private$collection$get(newParentLocation)
+ newParent <- private$collection$get(nameAndPath$path)
if(is.null(newParent))
{
stop("Unable to get destination subcollection")
}
- childWithSameName <- newParent$get(private$name)
+ childWithSameName <- newParent$get(nameAndPath$name)
if(!is.null(childWithSameName))
stop("Destination already contains content with same name.")
REST <- private$collection$getRESTService()
REST$move(self$getRelativePath(),
- paste0(newParent$getRelativePath(), "/", self$getName()),
+ paste0(newParent$getRelativePath(), "/", nameAndPath$name),
private$collection$uuid)
private$dettachFromCurrentParent()
private$attachToNewParent(newParent)
- "Content moved successfully"
+ private$name <- nameAndPath$name
+
+ "Content moved successfully."
},
get = function(name)
diff --git a/sdk/R/R/util.R b/sdk/R/R/util.R
index 8d4bcc0..f6a582f 100644
--- a/sdk/R/R/util.R
+++ b/sdk/R/R/util.R
@@ -13,3 +13,41 @@ trimFromEnd <- function(sample, trimCharacters)
sample
}
+
+RListToPythonList <- function(sample, separator = ", ")
+{
+ pythonArrayContent <- sapply(sample, function(sampleUnit)
+ {
+ if((is.vector(sampleUnit) || is.list(sampleUnit)) &&
+ length(sampleUnit) > 1)
+ {
+ return(RListToPythonList(sampleUnit, separator))
+ }
+ else
+ {
+ return(paste0("\"", sampleUnit, "\""))
+ }
+ })
+
+ return(paste0("[", paste0(pythonArrayContent, collapse = separator), "]"))
+}
+
+appendToStartIfNotExist <- function(sample, characters)
+{
+ if(!startsWith(sample, characters))
+ sample <- paste0(characters, sample)
+
+ sample
+}
+
+splitToPathAndName = function(path)
+{
+ path <- appendToStartIfNotExist(path, "/")
+ components <- unlist(stringr::str_split(path, "/"))
+ nameAndPath <- list()
+ nameAndPath$name <- components[length(components)]
+ nameAndPath$path <- trimFromStart(paste0(components[-length(components)], collapse = "/"),
+ "/")
+
+ nameAndPath
+}
diff --git a/sdk/R/tests/testthat/test-util.R b/sdk/R/tests/testthat/test-util.R
index a897860..62065f8 100644
--- a/sdk/R/tests/testthat/test-util.R
+++ b/sdk/R/tests/testthat/test-util.R
@@ -39,3 +39,47 @@ test_that("trimFromEnd returns original string if string doesn't end with trimCh
expect_that(result, equals("./something/random"))
})
+
+test_that("RListToPythonList converts nested R list to char representation of Python list", {
+
+ sample <- list("insert", list("random", list("text")), list("here"))
+
+ result <- RListToPythonList(sample)
+ resultWithSeparator <- RListToPythonList(sample, separator = ",+")
+
+ expect_that(result, equals("[\"insert\", [\"random\", \"text\"], \"here\"]"))
+ expect_that(resultWithSeparator,
+ equals("[\"insert\",+[\"random\",+\"text\"],+\"here\"]"))
+})
+
+test_that("appendToStartIfNotExist appends characters to beginning of a string", {
+
+ sample <- "New Year"
+ charactersToAppend <- "Happy "
+
+ result <- appendToStartIfNotExist(sample, charactersToAppend)
+
+ expect_that(result, equals("Happy New Year"))
+})
+
+test_that(paste("appendToStartIfNotExist returns original string if string",
+ "doesn't start with specified characters"), {
+
+ sample <- "Happy New Year"
+ charactersToAppend <- "Happy"
+
+ result <- appendToStartIfNotExist(sample, charactersToAppend)
+
+ expect_that(result, equals("Happy New Year"))
+})
+
+test_that(paste("splitToPathAndName splits relative path to file/folder",
+ "name and rest of the path"), {
+
+ relativePath <- "path/to/my/file.exe"
+
+ result <- splitToPathAndName( relativePath)
+
+ expect_that(result$name, equals("file.exe"))
+ expect_that(result$path, equals("path/to/my"))
+})
-----------------------------------------------------------------------
hooks/post-receive
--
More information about the arvados-commits
mailing list