Skip to content

Commit

Permalink
update for amcat4 v4.0.14
Browse files Browse the repository at this point in the history
  • Loading branch information
JBGruber committed May 28, 2024
1 parent 3943ef5 commit 017b5d1
Show file tree
Hide file tree
Showing 9 changed files with 61 additions and 22 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down
32 changes: 25 additions & 7 deletions R/index.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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"))
}
Expand Down Expand Up @@ -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)))
}


Expand All @@ -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()
}

6 changes: 5 additions & 1 deletion R/lib.R
Original file line number Diff line number Diff line change
Expand Up @@ -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]])
})
Expand Down
2 changes: 1 addition & 1 deletion R/query.R
Original file line number Diff line number Diff line change
Expand Up @@ -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 = ";",
Expand Down
4 changes: 3 additions & 1 deletion R/users.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#' information.
#'
#' @export
list_users <- function(credentials=NULL) {
list_users <- function(credentials = NULL) {
request(credentials, c("users")) |> dplyr::bind_rows()
}

Expand All @@ -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
)
Expand All @@ -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
Expand Down
6 changes: 6 additions & 0 deletions README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -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")
```
6 changes: 6 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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")
```
16 changes: 8 additions & 8 deletions tests/testthat/test-index.R
Original file line number Diff line number Diff line change
Expand Up @@ -55,23 +55,23 @@ 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"
)
})

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({
Expand All @@ -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")
})

})
Expand All @@ -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"))

})

Expand Down
9 changes: 6 additions & 3 deletions tests/testthat/test-query.R
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand Down Expand Up @@ -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",
Expand All @@ -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({
Expand Down

0 comments on commit 017b5d1

Please sign in to comment.