diff --git a/DESCRIPTION b/DESCRIPTION index 6410655..436db34 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,6 +17,7 @@ Imports: R6 (>= 2.5.1) Suggests: covr, + httptest2, knitr, rmarkdown, testthat diff --git a/NAMESPACE b/NAMESPACE index be3a39a..fe1f6b0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,7 @@ export(Dhis2r) import(R6) import(httr2) +importFrom(attempt,message_if_not) importFrom(attempt,stop_if_any) importFrom(attempt,stop_if_not) importFrom(curl,has_internet) diff --git a/NEWS.md b/NEWS.md index 4ff9af9..4aea05b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,13 @@ +# dhis2r 0.3.0 + +## Improvements + +* Updated the package to fail gracefully with an informative message if the resource is not available or has changed and doesn't give a check warning nor error + +* Now API calls function print a massage "No internet connection!" if there is no internet connection instead of an error + +* The url is of the queried API endpoint is printed using `message()` instead of `print()` + # dhis2r 0.2.1 ## Bug fix diff --git a/R/connect.R b/R/connect.R index 9035ad1..de47024 100644 --- a/R/connect.R +++ b/R/connect.R @@ -9,7 +9,8 @@ #' #' @export #' -#' @examples +#' @examplesIf interactive() && curl::has_internet() +#' #' # Load dhis2r #' library(dhis2r) #' # connect to the DHIS2 instance @@ -115,7 +116,7 @@ Dhis2r <- R6::R6Class( self$request_sent <- self$request_sent |> # req_url_query(paging = "false") |> req_headers("Accept" = "application/json") |> - httr2::req_user_agent("dhis2r (http://www.amanyiraho.com/dhis2r/") |> + httr2::req_user_agent("dhis2r (http://www.dhis2r.amanyiraho.com/") |> httr2::req_retry(max_tries = 5) }, @@ -129,26 +130,31 @@ Dhis2r <- R6::R6Class( #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ get_user_info = function() { # Check for internet - check_internet() + if(has_internet()){ + + response_object <- self$request_sent |> + req_url_path_append("me") |> + # req_error(body = dhis2_error_message) |> + req_perform() - response_object <- self$request_sent |> - req_url_path_append("me") |> - req_perform() + message(response_object$url) - print(response_object$url) + response_data <- response_object |> + resp_body_json(simplifyVector = TRUE) - response_data <- response_object |> - resp_body_json(simplifyVector = TRUE) + self$access_rights <- unlist(response_data[["access"]]) - self$access_rights <- unlist(response_data[["access"]]) + self$account_info <- unlist(list(response_data[["userCredentials"]][["createdBy"]][c("name", "username")], response_data["created"])) - self$account_info <- unlist(list(response_data[["userCredentials"]][["createdBy"]][c("name", "username")], response_data["created"])) + unlist( list( response_data["name"], + response_data["phoneNumber"], + response_data["email"])) - unlist( list( response_data["name"], - response_data["phoneNumber"], - response_data["email"])) - }, + }else{ + message("No internet connection!") + } + }, #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #' @description @@ -163,44 +169,46 @@ Dhis2r <- R6::R6Class( #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ get_metadata = function(endpoint = NULL, fields = c("name","id")) { - # Check for internet - check_internet() - if(is.null(endpoint)){ + if(has_internet()){ - response_object <- self$request_sent |> - req_url_path_append("resources") |> - req_perform() + if(is.null(endpoint)){ - print(response_object$url) + response_object <- self$request_sent |> + req_url_path_append("resources") |> + req_perform() - response_data <- response_object |> - resp_body_json(simplifyVector = TRUE) + message(response_object$url) - tibble::tibble(response_data$resources) + response_data <- response_object |> + resp_body_json(simplifyVector = TRUE) - }else{ + tibble::tibble(response_data$resources) + }else{ - attempt::stop_if_not(endpoint, is.character, "endpoint should be type character") - response_object <- self$request_sent |> - req_url_path_append(endpoint) |> - req_url_query(fields = paste0(fields, collapse = ",")) |> - req_perform() + attempt::stop_if_not(endpoint, is.character, "endpoint should be type character") - print(response_object$url) + response_object <- self$request_sent |> + req_url_path_append(endpoint) |> + req_url_query(fields = paste0(fields, collapse = ",")) |> + req_perform() + message(response_object$url) - response_data <- response_object |> - resp_body_json(simplifyVector = TRUE) + response_data <- response_object |> + resp_body_json(simplifyVector = TRUE) - tibble::tibble( response_data[[1]]) + tibble::tibble( response_data[[endpoint]]) - } + } - }, + }else{ + message("No internet connection!") + } + }, #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #' @description Get all possible fields for a specific metadata resource from a DHIS2 instance @@ -212,25 +220,29 @@ Dhis2r <- R6::R6Class( #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ get_metadata_fields = function(endpoint) { # Check for internet - check_internet() - attempt::stop_if(endpoint, is.null, "endpoint shouldnot be NULL") - attempt::stop_if_not(endpoint, is.character, "endpoint should be type character") - response_object <- self$request_sent |> - req_url_path_append(endpoint) |> - req_url_query(fields = ":all") |> - req_url_query(paging = "true") |> - req_url_query(pageSize = "1") |> - req_perform() + if(has_internet()){ + + attempt::stop_if(endpoint, is.null, "endpoint shouldnot be NULL") + attempt::stop_if_not(endpoint, is.character, "endpoint should be type character") - print(response_object$url) + response_object <- self$request_sent |> + req_url_path_append(endpoint) |> + req_url_query(fields = ":all") |> + req_url_query(paging = "true") |> + req_url_query(pageSize = "1") |> + req_perform() - response_data <- response_object |> - resp_body_json(simplifyVector = TRUE) + message(response_object$url) + response_data <- response_object |> + resp_body_json(simplifyVector = TRUE) - sort(names(response_data[[2]])) - }, + sort(names(response_data[[endpoint]])) + }else{ + message("No internet connection!") + } + }, #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #' @description Get all possible analytics resources from a DHIS2 instance i.e #' @@ -244,48 +256,52 @@ Dhis2r <- R6::R6Class( #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ get_analytics= function(analytic,org_unit ,period, output_scheme= c("UID", "NAME")) { - # Check for internet - check_internet() - args <- list(analytic = analytic,org_unit= org_unit ,period = period, output_scheme = output_scheme) - #Check that at least one argument is not null - attempt::stop_if_any(args, is.null,"You need to specify all arguements") - attempt::stop_if_none(args, is.character, "All arguements should be type character") + if(has_internet()){ - output_scheme <- match.arg(output_scheme) + # Check for internet - analytic <- paste0("dx:", paste0(analytic,collapse = ";")) - org_unit <- paste0("dimension=ou:", paste0(org_unit,collapse = ";")) - period <- paste0("dimension=pe:", paste0(period,collapse = ";")) + args <- list(analytic = analytic,org_unit= org_unit ,period = period, output_scheme = output_scheme) + #Check that at least one argument is not null - response_object <- self$request_sent |> - req_url_path_append("analytics") |> - req_url_query(dimension= I(paste(analytic, org_unit, period, sep = "&"))) |> - req_url_query(outputIdScheme = output_scheme) |> - req_perform() + attempt::stop_if_any(args, is.null,"You need to specify all arguements") + attempt::stop_if_none(args, is.character, "All arguements should be type character") - print(response_object$url) + output_scheme <- match.arg(output_scheme) + analytic <- paste0("dx:", paste0(analytic,collapse = ";")) + org_unit <- paste0("dimension=ou:", paste0(org_unit,collapse = ";")) + period <- paste0("dimension=pe:", paste0(period,collapse = ";")) - response_data <- response_object |> - resp_body_json(simplifyVector = TRUE, flatten = TRUE) + response_object <- self$request_sent |> + req_url_path_append("analytics") |> + req_url_query(dimension= I(paste(analytic, org_unit, period, sep = "&"))) |> + req_url_query(outputIdScheme = output_scheme) |> + req_perform() - if(length(response_data$rows) == 0){ + message(response_object$url) - as.data.frame(response_data$rows) - }else{ - as.data.frame(response_data$rows) |> - setNames(c("analytic", "org_unit", "period", "value")) |> - tibble::as_tibble() |> - dplyr::mutate(analytic = as.factor(analytic), - org_unit = as.factor(org_unit), - value = as.numeric(value)) - } + response_data <- response_object |> + resp_body_json(simplifyVector = TRUE, flatten = TRUE) + if(length(response_data$rows) == 0){ + as.data.frame(response_data$rows) - }, + }else{ + as.data.frame(response_data$rows) |> + setNames(c("analytic", "org_unit", "period", "value")) |> + tibble::as_tibble() |> + dplyr::mutate(analytic = as.factor(analytic), + org_unit = as.factor(org_unit), + value = as.numeric(value)) + } + + }else{ + message("No internet connection!") + } + }, #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #' @description Get all any analytics resource from a DHIS2 instance to cater for long DHIS2 favorites @@ -297,32 +313,37 @@ Dhis2r <- R6::R6Class( #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ get_any_analytic = function(endpoint_url) { - # Check for internet - check_internet() - args <- list(endpoint_url = endpoint_url) - #Check that at least one argument is not null - attempt::stop_if_any(args, is.null,"You need to specify all arguements") - attempt::stop_if_none(args, is.character, "All arguements should be type character") + + if(has_internet()){ + + args <- list(endpoint_url = endpoint_url) + #Check that at least one argument is not null + + attempt::stop_if_any(args, is.null,"You need to specify all arguements") + attempt::stop_if_none(args, is.character, "All arguements should be type character") - response_object <- self$request_sent |> - req_url_path_append(endpoint_url) |> - req_perform() + response_object <- self$request_sent |> + req_url_path_append(endpoint_url) |> + req_perform() - print(response_object$url) + message(response_object$url) + response_data <- response_object |> + resp_body_json(simplifyVector = TRUE, flatten = TRUE) - response_data <- response_object |> - resp_body_json(simplifyVector = TRUE, flatten = TRUE) + if(length(response_data$rows) == 0){ - if(length(response_data$rows) == 0){ + as.data.frame(response_data$rows) - as.data.frame(response_data$rows) + }else{ + as.data.frame(response_data$rows) |> + tibble::as_tibble() + } }else{ - as.data.frame(response_data$rows) |> - tibble::as_tibble() + message("No internet connection!") } } ) diff --git a/R/utils.R b/R/utils.R index a3bd5df..71fcdc3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,8 +1,15 @@ -#' @importFrom attempt stop_if_not +#' @importFrom attempt stop_if_not message_if_not #' @importFrom curl has_internet #' @import httr2 #' @import R6 check_internet <- function(){ - stop_if_not(.x = has_internet(), msg = "Please check your internet connetion") + attempt::message_if_not(.x = has_internet(), msg = "Please check your internet connection") } +#' Provide additional error information +#' @param resp response to be captured +#' @return An error character vector +#' +dhis2_error_message <- function(resp) { + resp_status_desc(resp) +} diff --git a/README.Rmd b/README.Rmd index 6bcbeeb..8a51fc4 100644 --- a/README.Rmd +++ b/README.Rmd @@ -22,6 +22,9 @@ knitr::opts_chunk$set( [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![R-CMD-check](https://github.com/amanyiraho/dhis2r/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/amanyiraho/dhis2r/actions/workflows/R-CMD-check.yaml) [![CRAN status](https://www.r-pkg.org/badges/version/dhis2r)](https://CRAN.R-project.org/package=dhis2r) +[![](https://cranlogs.r-pkg.org/badges/grand-total/dhis2r)](https://cranlogs.r-pkg.org/badges/grand-total/dhis2r) +[![](https://cranlogs.r-pkg.org/badges/dhis2r)](https://cran.r-project.org/package=dhis2r) + ## Overview diff --git a/README.md b/README.md index 6a0e8b3..970d04a 100644 --- a/README.md +++ b/README.md @@ -12,6 +12,9 @@ stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https:// [![R-CMD-check](https://github.com/amanyiraho/dhis2r/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/amanyiraho/dhis2r/actions/workflows/R-CMD-check.yaml) [![CRAN status](https://www.r-pkg.org/badges/version/dhis2r)](https://CRAN.R-project.org/package=dhis2r) +[![](https://cranlogs.r-pkg.org/badges/grand-total/dhis2r)](https://cranlogs.r-pkg.org/badges/grand-total/dhis2r) +[![](https://cranlogs.r-pkg.org/badges/dhis2r)](https://cran.r-project.org/package=dhis2r) + ## Overview diff --git a/cran-comments.md b/cran-comments.md index 0c72a81..768f43b 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -2,7 +2,15 @@ This is a resubmission. In this version I have: -* Updated the vignette to username and password instead of PAT since the public server is regularly updated +Updated the package to fail gracefully with an informative message if the resource is not available or has changed and doesn't give a check warning nor error. I have achieved this by making sure; + + * API call functions print a massage "No internet connection!" if there is no internet connection instead of an error + + * All examples run the if the environment is interactive and has internet + + * All the tests are skipped on CRAN and are only run if there is an internet connection (Tests are always run during CI using github Actions) + + * The vignettes are built using a mock up directory to that they can run without internet connection and when resources are unavailable * I have tested the package on GITHUB actions and all past using these OSs diff --git a/man/Dhis2r.Rd b/man/Dhis2r.Rd index c36cbec..b6704ee 100644 --- a/man/Dhis2r.Rd +++ b/man/Dhis2r.Rd @@ -14,6 +14,8 @@ The R6 Class called `Dhis2r` representing a DHIS2 instance connection You can use a DHIS2 instance connection to get data several times without needing to manually supply your user credentials on each API call. } \examples{ +\dontshow{if (interactive() && curl::has_internet()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} + # Load dhis2r library(dhis2r) # connect to the DHIS2 instance @@ -41,7 +43,7 @@ org_unit = c("O6uvpzGd5pu", "fdc6uOvgoji"), period = "LAST_12_MONTHS", output_scheme = "NAME") - +\dontshow{\}) # examplesIf} } \section{Public fields}{ \if{html}{\out{
}} diff --git a/man/dhis2_error_message.Rd b/man/dhis2_error_message.Rd new file mode 100644 index 0000000..828c9fa --- /dev/null +++ b/man/dhis2_error_message.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{dhis2_error_message} +\alias{dhis2_error_message} +\title{Provide additional error information} +\usage{ +dhis2_error_message(resp) +} +\arguments{ +\item{resp}{response to be captured} +} +\value{ +An error character vector +} +\description{ +Provide additional error information +} diff --git a/renv.lock b/renv.lock index 6e520c6..de7c6fd 100644 --- a/renv.lock +++ b/renv.lock @@ -52,13 +52,13 @@ }, "curl": { "Package": "curl", - "Version": "5.2.3", + "Version": "6.0.1", "Source": "Repository", "Repository": "CRAN", "Requirements": [ "R" ], - "Hash": "d91263322a58af798f6cf3b13fd56dde" + "Hash": "e8ba62486230951fcd2b881c5be23f96" }, "dplyr": { "Package": "dplyr", @@ -119,7 +119,7 @@ }, "httr2": { "Package": "httr2", - "Version": "1.0.0", + "Version": "1.0.6", "Source": "Repository", "Repository": "CRAN", "Requirements": [ @@ -136,7 +136,7 @@ "vctrs", "withr" ], - "Hash": "e2b30f1fc039a0bab047dd52bb20ef71" + "Hash": "3ef5d07ec78803475a94367d71b40c41" }, "lifecycle": { "Package": "lifecycle", diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R new file mode 100644 index 0000000..4c9cf1d --- /dev/null +++ b/tests/testthat/setup.R @@ -0,0 +1 @@ +library(httptest2) diff --git a/tests/testthat/test-connect.R b/tests/testthat/test-connect.R index ebe3079..ad7669f 100644 --- a/tests/testthat/test-connect.R +++ b/tests/testthat/test-connect.R @@ -1,35 +1,47 @@ -dhis2_play_connection <- Dhis2r$new(base_url = "https://play.im.dhis2.org/stable-2-40-5", +dhis2_play_connection <- Dhis2r$new(base_url = "https://play.im.dhis2.org/stable-2-40-5/", username = "admin", password = "district" # api_version = "2.39.0.1", # api_version_position = "before" ) + test_that("Can connect to DHIS2 instance", { + skip_on_cran() + skip_if_offline() expect_equal(dhis2_play_connection$request_sent |> req_perform() |> resp_status(), 200) }) test_that("user information is a charater vector", { - #expect_vector(dhis2_play_connection$get_user_info()) + skip_on_cran() + skip_if_offline() expect_equal(names(dhis2_play_connection$get_user_info()), c("name", "email")) }) + test_that('Resource(s) "displayName","singular","plural","href" are return', { - expect_equal(names(dhis2_play_connection$get_metadata()), c("displayName","singular","plural","href" )) + skip_on_cran() + skip_if_offline() +expect_equal(names(dhis2_play_connection$get_metadata()), c("displayName","singular","plural","href" )) }) test_that("Type of result of a specific resouce is list", { + skip_on_cran() + skip_if_offline() expect_type(dhis2_play_connection$get_metadata(endpoint = "dataElements"), "list") }) + test_that("Type of result of possible fields is a character vector", { + skip_on_cran() + skip_if_offline() expect_type(dhis2_play_connection$get_metadata_fields(endpoint = "dataElements"), "character") }) @@ -37,6 +49,9 @@ test_that("Type of result of possible fields is a character vector", { test_that('Wrong analytic ID returns an error', { + + skip_on_cran() + skip_if_offline() expect_error(dhis2_play_connection$get_analytics(analytic = c("random_id"), org_unit = c("O6uvpzGd5pu", "fdc6uOvgoji"), period = "202302", diff --git a/vignettes/dhis2r.Rmd b/vignettes/dhis2r.Rmd index 4f9e8e5..15037cb 100644 --- a/vignettes/dhis2r.Rmd +++ b/vignettes/dhis2r.Rmd @@ -8,10 +8,14 @@ vignette: > --- ```{r, include = FALSE} + knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) + +library(httptest2) +start_vignette("dhis2r") ``` ```{r setup} @@ -129,18 +133,22 @@ dhis2_play_connection$get_metadata(endpoint = "indicators") ### Get analtyics ```{r} -# dhis2_play_connection$get_analytics(analytic = "s46m5MS0hxu", -# org_unit = c("O6uvpzGd5pu", "fdc6uOvgoji"), -# period = "202101", -# output_scheme = "NAME") +dhis2_play_connection$get_analytics(analytic = "s46m5MS0hxu", + org_unit = c("O6uvpzGd5pu", "fdc6uOvgoji"), + period = "202101", + output_scheme = "NAME") ``` ```{r} -# dhis2_play_connection$get_analytics(analytic = "FTRrcoaog83", #Accute Flaccid Paralysis (Deaths < 5 yrs) -# org_unit = c("ImspTQPwCqd"), #Sierra Leone (National level) -# period = "LAST_12_MONTHS", -# output_scheme = "NAME") +dhis2_play_connection$get_analytics(analytic = "FTRrcoaog83", #Accute Flaccid Paralysis (Deaths < 5 yrs) + org_unit = c("ImspTQPwCqd"), #Sierra Leone (National level) + period = "LAST_12_MONTHS", + output_scheme = "NAME") ``` +```{r, include = FALSE} +end_vignette() +``` +