diff --git a/DESCRIPTION b/DESCRIPTION index 65c1628..75f4bc7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,7 +3,7 @@ Type: Package Title: Controlling amcat4 from R Description: More about what it does (maybe more than one line) Use four spaces when indenting paragraphs within the Description. -Version: 4.0.12.9000 +Version: 4.0.14.9000 Authors@R: c(person(given = "Wouter", family = "van Atteveldt", diff --git a/R/index.R b/R/index.R index e82cbb0..2ef155c 100644 --- a/R/index.R +++ b/R/index.R @@ -38,6 +38,7 @@ delete_index <- function(index, credentials = NULL) { #' @param name optional more descriptive name of the index to create (all #' characters are allowed here) #' @param description optional description of the index to create +#' @param create_fields create fields in the new index. #' @param guest_role Role for unauthorized users. Options are "admin", "writer", #' "reader" and "metareader". #' @param credentials The credentials to use. If not given, uses last login @@ -59,17 +60,26 @@ delete_index <- function(index, credentials = NULL) { #' } #' #' @export -create_index <- function(index, name = index, description = NULL, guest_role = NULL, credentials = NULL) { - if (!is.null(guest_role)) guest_role <- tolower(guest_role) +create_index <- function(index, + name = index, + description = NULL, + create_fields = list(title = "text", date = "date", text = "text"), + guest_role = NULL, + credentials = NULL) { + if (!is.null(guest_role)) guest_role <- toupper(guest_role) body <- list(id = index, name = name, description = description, guest_role = guest_role) - invisible(request(credentials, "index/", body = body, "POST")) + resp <- request(credentials, "index/", body = body, "POST") + if (!is.null(create_fields)) { + set_fields(index, create_fields) + } + invisible(resp) } #' @describeIn create_index Modify an index #' @export modify_index <- function(index, name = index, description = NULL, guest_role = NULL, credentials = NULL) { - if (!is.null(guest_role)) guest_role <- tolower(guest_role) + if (!is.null(guest_role)) guest_role <- toupper(guest_role) body <- list(name = name, description = description, guest_role = guest_role) invisible(request(credentials, c("index/", index), body = body, "PUT")) } @@ -236,7 +246,7 @@ refresh_index <- function(index, credentials = NULL) { #' @param credentials The credentials to use. If not given, uses last login information #' @export set_fields <- function(index, fields, credentials = NULL) { - invisible(request(credentials, c("index", index, "fields"), "POST", body = fields)) + invisible(request(credentials, c("index", index, "fields"), "POST", body = as.list(fields))) } @@ -246,7 +256,15 @@ set_fields <- function(index, fields, credentials = NULL) { #' @param credentials The credentials to use. If not given, uses last login information #' @export get_fields <- function(index, credentials = NULL) { - request(credentials, c("index", index, "fields")) |> - purrr::map_df(function(t) tibble::tibble(name = t$name, type = t$type)) + res <- request(credentials, c("index", index, "fields")) + purrr::map(names(res), function(f) { + tibble::tibble(name = f, + type = purrr::pluck(res[[f]], "type"), + elastic_type = purrr::pluck(res[[f]], "elastic_type"), + identifier = purrr::pluck(res[[f]], "identifier"), + metareader = list(purrr::pluck(res[[f]], "metareader")), + client_settings = list(purrr::pluck(res[[f]], "client_settings"))) + }) |> + purrr::list_rbind() } diff --git a/R/lib.R b/R/lib.R index 01c74fc..d27ae6c 100644 --- a/R/lib.R +++ b/R/lib.R @@ -91,7 +91,11 @@ amcat_error_body <- function(resp) { if (grepl("json", httr2::resp_content_type(resp), fixed = TRUE)) { ebody <- httr2::resp_body_json(resp) - if (is.list(ebody$detail$body$error)) { + if (purrr::pluck_exists(ebody, "message")) { + return(purrr::pluck(ebody, "message")) + } else if (purrr::pluck_exists(ebody, "detail")) { + return(purrr::pluck(ebody, "detail")) + } else if (is.list(ebody$detail$body$error)) { error <- purrr::map_chr(names(ebody$detail$body$error), function(n) { paste0(tools::toTitleCase(n), ": ", ebody$detail$body$error[[n]]) }) diff --git a/R/query.R b/R/query.R index 291732c..02bd6e2 100644 --- a/R/query.R +++ b/R/query.R @@ -78,7 +78,7 @@ query_documents <- function(index, queries = NULL, fields = c("date", "title"), filters = NULL, - per_page = 1000, + per_page = 200, max_pages = 1, page = NULL, merge_tags = ";", diff --git a/R/users.R b/R/users.R index 8f1c656..b721ed7 100644 --- a/R/users.R +++ b/R/users.R @@ -4,7 +4,7 @@ #' information. #' #' @export -list_users <- function(credentials=NULL) { +list_users <- function(credentials = NULL) { request(credentials, c("users")) |> dplyr::bind_rows() } @@ -21,6 +21,7 @@ list_users <- function(credentials=NULL) { modify_user <- function(email, role = "writer", credentials = NULL) { + if (!is.null(role)) role <- toupper(role) body = list( role = role ) @@ -42,6 +43,7 @@ create_user <- function(email, role = "writer", index_access = NULL, credentials = NULL) { + if (!is.null(role)) role <- toupper(role) body <- list( email = email, role = role, index_access = index_access diff --git a/README.Rmd b/README.Rmd index aae8d67..588f0d9 100644 --- a/README.Rmd +++ b/README.Rmd @@ -31,3 +31,9 @@ You can install the development version of amcat4r from [GitHub](https://github. # install.packages("devtools") remotes::install_github("ccs-amsterdam/amcat4r") ``` + +Note: if you have an amcat4 instance older than 4.0.14, you can use this version of the package: + +``` r +remotes::install_github("ccs-amsterdam/amcat4r", ref = "3943ef527315e76205f258b34a3b9d14a67b5f72") +``` diff --git a/README.md b/README.md index 30b73e3..586cede 100644 --- a/README.md +++ b/README.md @@ -23,3 +23,9 @@ You can install the development version of amcat4r from # install.packages("devtools") remotes::install_github("ccs-amsterdam/amcat4r") ``` + +Note: if you have an amcat4 instance older than 4.0.14, you can use this version of the package: + +``` r +remotes::install_github("ccs-amsterdam/amcat4r", ref = "3943ef527315e76205f258b34a3b9d14a67b5f72") +``` diff --git a/tests/testthat/test-index.R b/tests/testthat/test-index.R index eab20b7..0f2e710 100644 --- a/tests/testthat/test-index.R +++ b/tests/testthat/test-index.R @@ -55,15 +55,15 @@ test_that("date conversion", { upload_documents("amcat4r-test", documents = test_doc) Sys.sleep(2) # seems to take a second expect_equivalent( - query_documents("amcat4r-test", queries = NULL, fields = NULL)$date, - strptime("2022-01-01", format = "%Y-%m-%d") + as.character(query_documents("amcat4r-test", queries = NULL, fields = NULL)$date), + "2022-01-01" ) update_documents("amcat4r-test", ids = "1", documents = data.frame(date = "2022-01-01T00:00:01")) Sys.sleep(2) # seems to take a second expect_equivalent( - query_documents("amcat4r-test", queries = NULL, fields = NULL)$date, - strptime("2022-01-01T00:00:01", format = "%Y-%m-%dT%H:%M:%S") + as.character(query_documents("amcat4r-test", queries = NULL, fields = NULL)$date), + "2022-01-01 00:00:01" ) }) @@ -71,7 +71,7 @@ test_that("users", { skip_if(as.logical(Sys.getenv("amcat_offline"))) expect_false( - "test" %in% list_index_users("amcat4r-test")$email + "test" %in% purrr::pluck(list_index_users("amcat4r-test"), "email") ) expect_true({ @@ -86,7 +86,7 @@ test_that("users", { expect_false({ delete_index_user("amcat4r-test", email = "test") - "test" %in% list_index_users("amcat4r-test")$email + "test" %in% purrr::pluck(list_index_users("amcat4r-test"), "email") }) }) @@ -96,14 +96,14 @@ test_that("fields", { expect_equal( dim(get_fields("amcat4r-test")), - c(4, 2) + c(3, 6) ) expect_equal({ set_fields("amcat4r-test", list(test = "keyword")) out <- get_fields("amcat4r-test") c(dim(out), out[out$name == "test", "type"]) - }, list(5L, 2L, type = "keyword")) + }, list(4L, 6L, type = "keyword")) }) diff --git a/tests/testthat/test-query.R b/tests/testthat/test-query.R index bf906ca..d1fa1da 100644 --- a/tests/testthat/test-query.R +++ b/tests/testthat/test-query.R @@ -4,7 +4,8 @@ if (!as.logical(Sys.getenv("amcat_offline"))) test_that("query", { skip_if(as.logical(Sys.getenv("amcat_offline"))) create_index("amcat4r-test") - set_fields("amcat4r-test", list(keyword = "keyword")) + set_fields("amcat4r-test", list(keyword = "keyword", + cats = "keyword")) test_doc <- data.frame( .id = 1:10, title = "test", @@ -72,11 +73,13 @@ test_that("query", { queries = "test", filters = list(cats = "cute", date = list(gte = "2023-01-01")))$n, - 4 + 5L ) expect_equal({ set_fields("amcat4r-test", list(test = "tag")) + # TODO: remove, admin should have automatic access + add_index_user("amcat4r-test", email = "_admin", role = "ADMIN") update_tags( index = "amcat4r-test", action = "add", @@ -87,7 +90,7 @@ test_that("query", { ) Sys.sleep(2) # seems to take a second to work sum(is.na(query_documents("amcat4r-test", queries = NULL, fields = c("test", "title"), scroll = "1m")))}, - 6L + 5L ) expect_equal({