Merge pull request #114 from ThinkR-open/107-rebased

Fix handling of HTTP parameter arrays - 107 rebased

.github/workflows/test-coverage.yaml

@@ -11,6 +11,7 @@ name: test-coverage
 jobs:
   test-coverage:
     runs-on: ubuntu-latest
+    concurrency: testor.coverage
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       GITLABR_TEST_LOGIN: ${{ secrets.GITLABR_TEST_LOGIN }}

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gitlabr
 Title: Access to the 'Gitlab' API
-Version: 2.0.1.9003
+Version: 2.0.1.9004
 Authors@R: c(
     person("Jirka", "Lewandowski", , "[email protected]", role = "aut"),
     person("Sébastien", "Rochette", , "[email protected]", role = c("aut", "cre"),

NEWS.md

@@ -10,6 +10,7 @@
 * `gl_new_group()`, `gl_edit_group()`, `gl_delete_group()`, `gl_list_groups()`, `gl_list_sub_groups()` to deal with groups on a GitLab instance (@mpolano)
 * `gl_delete_file()` to delete a file in a repository
 * `gl_list_project_members()` and `gl_list_group_members` to retrieve members of a project or a group (#61, @datawookie)
+* `gitlab()` queries allow for a vector of parameters to be passed to the API. This is needed when the API asks for an array (@klmr)
 
 ## Minor changes
 

R/gitlab_api.R

@@ -116,9 +116,9 @@ gitlab <- function(req,
     private_token_header <- httr::add_headers("PRIVATE-TOKEN" = private_token)
 
     (if (page == "all") {
-      l
+      flattenbody(l)
     } else {
-      c(page = page, l)
+      c(page = page, flattenbody(l))
     }) %>%
       pipe_into(argname_verb, verb, url = url, private_token_header) %>%
       http_error_or_content() -> resp
@@ -168,7 +168,10 @@ gitlab <- function(req,
     if (!missing(max_page)) {
       dot_args <- c(dot_args, max_page = max_page)
     }
-    do.call(gitlab_con, c(dot_args, gitlab_con = "self", ...)) %>%
+    do.call(gitlab_con, c(dot_args,
+      gitlab_con = "self",
+      list(...)
+    )) %>%
       iff(debug, print)
   }
 }
@@ -241,22 +244,6 @@ is_single_row <- function(l) {
   }
 }
 
-# is_single_row <- function(l) {
-#   if (length(l) == 1 || !any(lapply(l, is.list) %>% unlist())) {
-#     return(TRUE)
-#   } else {
-#     the_lengths <- lapply(l, length) %>% unlist()
-#     u_length <- unique(the_lengths)
-#     if (length(u_length) == 1) {
-#       return(u_length == 1)
-#     } else {
-#       multi_cols <- which(the_lengths > 1) %>% unlist()
-#       return(all(lapply(l[multi_cols], is_named) %>% unlist() &
-#                    !(lapply(l[multi_cols], is.nested.list) %>% unlist())))
-#     }
-#   }
-# }
-
 format_row <- function(row, ...) {
   row %>%
     lapply(unlist, use.names = FALSE, ...) %>%
@@ -284,3 +271,32 @@ call_filter_dots <- function(fun,
                              ...) {
   do.call(fun, args = c(list(...), .dots[intersect(.dots_allowed, names(.dots))]))
 }
+
+#' Flatten a list as duplicate names list
+#' for httr requests
+#'
+#' @param x a list
+#' @return a list
+#'
+#' @noRd
+flattenbody <- function(x) {
+  # issued from https://stackoverflow.com/a/72532186
+  # A form/query can only have one value per name, so take
+  # any values that contain vectors length >1 and
+  # split them up
+  # list(x=1:2, y="a") becomes list(x=1, x=2, y="a")
+  if (all(lengths(x) <= 1)) {
+    return(x)
+  }
+  do.call("c", mapply(function(name, val) {
+    if (length(val) == 1 || any(c("form_file", "form_data") %in% class(val))) {
+      x <- list(val)
+      names(x) <- name
+      x
+    } else {
+      x <- as.list(val)
+      names(x) <- rep(name, length(val))
+      x
+    }
+  }, names(x), x, USE.NAMES = FALSE, SIMPLIFY = FALSE))
+}