R/utils.R

In agpknitweardesign/festotuAPIs:

#' getMethodProperties
#' @title festotuAPIs utils
#' @description Utils for building http requests for festotu APIs, using the package configuration.
#' @param methodName Name of the API method
#' @param api Name of the API
#' @param params Additional parameters. Typically a named list of resources identifiers.
#' @param body Named list representing the body of a PUT/POST request.
#'
#' @return \code{getMethodProperties} returns a \code{data.frame} of method properties, to be used when building http requests.
#'
#' @examples
#' festotuAPIs:::getMethodProperties("findAllListingActive", "etsy")
#' updateApiReference("etsy")
#'  
getMethodProperties <- function(methodName, api) {
  switch(api,
         etsy = c("uri", "visibility", "http_method") %>%
           subset(etsy$methods, name == methodName, select = ., drop = TRUE) %T>%
           lapply(function(x) assert_that(length(x) == 1)))
}

#' buildURL
#'
#' @describeIn getMethodProperties  Build a URL pointing to the resource described by the parameters provided.
#' @return \code{buildURI} returns a URL pointing to the resource described by the parameters provided.
buildURL <- function(api, methodProperties, params){
  switch(api,
         etsy = 
           with(methodProperties,
                if (grepl(":", uri)) {
                  strsplit(uri, "/") %>% unlist %>%
                    lapply(function(part) {
                      if (grepl("^:[^:]*", part)) {
                        # this part of the uri represents a parameter
                        uri_param <- sub(":", "", part)
                        if (!uri_param %in% names(params)) {
                          message(sprintf("Error: missing parameter %s in the method call", uri_param))
                          return()
                        }
                        part <- params[[uri_param]]
                        params[[uri_param]] <<- NULL
                      }
                      part}) %>%
                    paste0(collapse = "/")
                } else {
                  uri
                }) %>%
           paste0(etsy$base_url, .)
  )
}

#' buildQuery
#'
#' @describeIn getMethodProperties Build a curl query for a GET request
#' @return \code{buildQuery} returns a named list containing a curl query for a GET request
buildQuery <- function(api, properties, params) {
  switch(api,
         etsy = 
           if (properties$visibility == "public") {
             c(params, api_key = etsy$api_key)
           } else {
             params
           }   
  )
}

#' urlEncodeBody
#'
#' @describeIn urlEncodeBody Encode a named list (body) in URL format, as required by etsy PUT/POST requests
#' @return \code{urlEncodeBody} returns a serialized string representing the body content in URL format.
urlEncodeBody <- function(body){
  assert_that(length(names(body)) == length(body))
  names(body) %>% 
    paste0("=", 
           sapply(., function(name) paste0(body[[name]], collapse = ",") %>% URLencode()),
           collapse = "&") %>%
    paste0("?", .)
}


#' getMethodsInfo
#'
#' @description Get information of the methods of some API
#'
#' @param pattern Character string containing a regular expression to be matched in the methods names of \code{api}.
#' @param http_method Character string. Optional parameter to filter response to certain http methods (eg: GET). Regular expression.
#' @param visibility  Character string. Optional parameter to filter response to public/private methods.
#' @param attributes Character vector, names of the attributes to return. If \code{NULL} (default), return only method names.
#' \code{ALL} returns all available attributes.
#' For example, the following attributes are available for the Etsy API:
#' \itemize{
#' \item{description}
#' \item{uri}
#' \item{params}
#' \item{defaults}
#' \item{type}
#' \item{visibility}
#' \item{http_method}
#' }
#' @param api Name of the API to explore
#' @param ... Additional parameters to be passed to grepl for matching argument \code{pattern} to methods names.
#'  
#' @return Data frame containing the methods names matchning pattern, and the attributes requested.
#' @export
#'
#' @examples
#' getMethodsInfo()
#' getMethodsInfo("listings", ignore.case = TRUE)
#' getMethodsInfo("findAllFeaturedListings", attributes = "ALL")
#' getMethodsInfo("findAllFeaturedListings", attributes = c("description", "params"))
#' getMethodsInfo("Listings", http_method = "GET", visibility = "public")
#' 
getMethodsInfo <- function(pattern = ".", http_method = ".", visibility = ".", attributes = NULL, api = "etsy", ...){
  
  methodsTable <- get("etsy", envir = .GlobalEnv)[["methods"]]
  .filter <- grepl(http_method, methodsTable$http_method) &
    grepl(visibility, methodsTable$visibility)
  methodsTable <- methodsTable[.filter,]
  
  if (any(attributes == "ALL")) attributes <- names(methodsTable)
  attributes <- setdiff(attributes, "name")
  assert_that(all(attributes %in% names(methodsTable)))
  dataFrameAttrs <- attributes[sapply(attributes, function(a) is.data.frame(methodsTable[[a]]))]
  
  methodsAttributes <- methodsTable[grepl(pattern, methodsTable$name, ...), c("name", attributes)]
  for (dfa in dataFrameAttrs) {
    meaningfulColumns <- sapply(methodsAttributes[[dfa]], function(x) !all(is.na(x)))
    methodsAttributes[[dfa]] %<>% extract(meaningfulColumns)
  }
  methodsAttributes
}

#' updateApiReference
#'
#' @describeIn getMethodProperties Creates a new API reference configuration file
#' @details updateApiReference creates a new API reference configuration file
#' @export
updateApiReference <- function(api){
  switch(api,
         etsy = 
           write(toJSON(eGET("getMethodTable"), pretty = TRUE), file = "etsyApiReference.json")
  )
}


#' toTibble
#' 
#' @description turns an existing object into a tibble. Wrapper to as_tibble, controling for null values before calling as_tibble.
#'
#' @param .data the data to turn into a tibble
#'
#' @return \code{.data} in tibble format. \code{NULL} values are turned into \code{NA}. List-columns are handled.
#' @importFrom tibble as_tibble
toTibble <- function(.data){
  lapply(.data, function(x){
    if (is.null(x)) x <- NA
    if (is.list(x)) x <- list(unlist(x))
    x
  }) %>%
    tibble::as_tibble(.)
}