R/generate_code.R

In samterfa/googlePackageMaker: Generate R Packages for Google APIs

# Formerly googleAuthR::gar_create_api_skeleton()
#' Create a Google API package
#' 
#' This function will generate a package of Google API functions.
#' 
#' @param api_id The api to fetch. Run \code{\link{api_list}} for options.
#' @param output_dir Directory path to write the package to.
#' @param package_name Name of the package to create. NOTE: output_dir/package_name cannot be pre-existing.
#' 
#' @return TRUE if successful, side effect will write package directory output_dir/package_name.
#' @note You will still need to run devtools::document(your_package_directory) and install your package for testing.
#' @family API Discovery Service
#' @export
package_make <- function(api_id,
                         output_dir,
                         package_name){
   
   ############ Create package file structure ############
   final_package_path <- glue::glue('{output_dir}/{package_name}') %>% sub(pattern = '//', replacement = '/')
   
   # Avoid unfortunate accidents involving file systems.
   assertthat::assert_that(!dir.exists(final_package_path), msg = glue::glue('Package path {final_package_path} cannot be pre-existing.'))
   
   if(!dir.exists(output_dir)) dir.create(output_dir)
   
   if(!dir.exists(tempdir())) dir.create(tempdir())
   
   temp_package_dir <- file.path(tempdir(), package_name)
   if(dir.exists(temp_package_dir)) unlink(temp_package_dir, recursive = T, force = T)
   dir.create(temp_package_dir)
   
   temp_script_dir <- glue::glue('{temp_package_dir}/R')
   
   temp_data_raw_dir <- glue::glue('{temp_package_dir}/data-raw')
   dir.create(temp_data_raw_dir)
   
   # Load API info
   suppressMessages(
      discovery_docs <- preprocess_methods(api_id, temp_data_raw_dir)
   )
   api_info <- discovery_docs[[1]]
   methods <- discovery_docs[[2]]
   
   # Remove extra characters from endpoint paths.
   for(method in names(methods)){methods[[method]]$path <- methods[[method]]$path %>% stringr::str_remove_all(stringr::fixed('+'))}
   
   ############ ADD usethis function calls for package generation here. ############
   usethis::create_package(temp_package_dir, open = F, fields = list(Title = glue::glue("Consume Google's {api_info$title}"),
                                                                     Description = glue::glue("{api_info$description} ",
                                                                                              "Automatically Generated by googlePackageMaker",
                                                                                              .trim = F)))
   
   usethis::proj_set(path = temp_package_dir, force = T)
   
   usethis::use_package('gargle')
   usethis::use_package('dplyr')
   usethis::use_package('purrr')
   usethis::use_package('glue')
   usethis::use_package('stringr')
   usethis::use_pipe()
   
   .endpoints <- methods
   usethis::use_data(.endpoints, internal = T, overwrite = T)
   
   # Form strings which can be evaluated to subset json documentation for methods
   base_url <- api_info$rootUrl   ### NOT baseUrl since gargle doesn't handle multiple forward slashes in the base_url field of a request.
   path_prefix <- sub(api_info$rootUrl, '', api_info$baseUrl)
   
   # https://developers.google.com/discovery/v1/reference/apis
   for(method_info in methods){
      
      # method ids are of the form {api}.{category}.{...}. Need to peel off category.
      start <- stringr::str_locate_all(method_info$id, stringr::fixed('.'))[[1]][[1]] + 1
      end <- stringr::str_locate_all(method_info$id, stringr::fixed('.'))[[1]][[2]] - 1
      
      category <- method_info$id %>% stringr::str_sub(start, end = end)
      category_file <- glue::glue('{temp_script_dir}/{category}.R')
      
      if(!file.exists(category_file)) file.create(category_file)
      
      # function name is function id. may revisit
      function_id <- method_info$id
      function_name <- create_function_name(function_id)
      
      # description of function
      function_description <- method_info$description
      
      # path for api calls. Not sure whether to use flatPath or path yet.
      path <- paste0(path_prefix, method_info$path)
      
      # api method for call
      method <- method_info$httpMethod
      
      # vector of scopes needed to make the given api call
      scopes <- method_info$scopes
      
      # relevant schema for response of the request
      if(!is.null(method_info$request)){
         response_schema_ref <- method_info$request
      }else{
         response_schema_ref <- NULL
      }
      
      params <- method_info$parameters
      read_only_param_names <- params %>% purrr::keep(~'readOnly' %in% names(.x)) %>% purrr::keep(~.x$readOnly) %>% names()
      params <- params[!names(params) %in% read_only_param_names]
      required_param_names <- params %>% purrr::keep(~'required' %in% names(.x)) %>% purrr::keep(~.x$required) %>% names()
      params <- params[!names(params) %in% c('access_token', 'oauth_token', 'key')]
      
      # Order params by whether they're required or not.
      params <- append(
         params[names(params) %in% required_param_names],
         params[!names(params) %in% required_param_names]
      )
      
      ############ Generate documentation text ############
      doc_text <- glue::glue(
         
         "\n\t",
         "#' {function_description %>% stringr::str_sub(1, stringr::str_locate(., stringr::fixed('.'))[[1]])}",
         "\n\t",
         "#'",
         "\n\t",
         "#' {function_description %>% stringr::str_sub(stringr::str_locate(., fixed('.'))[[1]] + 1) %>% stringr::str_trim()} Autogenerated via \\code{{\\link[googlePackageMaker]{{package_make}}}}.",
         "\n\t",
         "#'",
         "\n\t",
         "#' @seealso \\href{{{api_info$documentationLink}}}{{Google Documentation}}",
         "\n\t",
         "#'",
         "\n\t",
         "#' @details",
         "\n\t",
         "#' Authentication scopes used by this function are:",
         "\n\t",
         "#' \\itemize{{", 
         
         .trim = F)
      
      for(scope in scopes){
         
         doc_text <- glue::glue("{doc_text}",
                                "\n\t",
                                "#' \\item {scope}", 
                                .trim = F)
      }
      
      doc_text <- glue::glue("{doc_text}", 
                             "\n\t",
                             "#' }}", 
                             .trim = F)
      
      # Add function params to documentation.
      # Can get duplicates because body params are rolled into this. See chromeosdevices.methods.patch deviceId param for example.
      for(param in unique(names(params))){
         
         # Check length of matches here to prevent duplicates?
         
         param_info <- method_info$parameters[[param]]
         
         doc_text <- glue::glue("{doc_text}",
                                "\n\t",
                                "#' @param {param} {param_info$description %>% stringr::str_replace_all(stringr::fixed('\n'), '')}", 
                                .trim = F)
      }
      
      # Add token, return_request, and return_response as well.
      doc_text <- glue::glue("{doc_text}", 
                             "\n\t",
                             "#' @param gargle_token A token prepared by one of gargle's token generating functions. Defaults to gargle::token_fetch(...) with appropriate scopes. See \\code{{\\link[gargle]{{token_fetch}}}} for more info.",
                             "\n\t",
                             "#' @param return_request Whether to return the request without making it. Defaults to FALSE. See \\code{{\\link[gargle]{{request_build}}}} for more info on the returned request object.",
                             "\n\t",
                             "#' @param return_response Whether to return the response or the response content. Defaults to FALSE (return response content).", 
                             .trim = F)
      
      doc_text <- glue::glue("{doc_text}",
                             "\n\t",
                             "#' @export", 
                             .trim = F)
      
      
      ############ Generate function text ###############
      function_text <- glue::glue("\t",
                                  "{function_name} <- function(",
                                  .trim = F)
      
      # Add params to function definition.
      # Can get duplicates because body params are rolled into this. See admin:directory_v1 chromeosdevices.methods.patch deviceId param for example.
      for(param in unique(names(params))){
         
         # Check length of matches here to prevent duplicates?
         
         if(param %in% required_param_names){
            function_text <- glue::glue("{function_text}", "{param}, ")
         }else{
            function_text <- glue::glue("{function_text}", "{param} = NULL, ")
         }
      }
      
      # Finish off function parameters list
      function_text <- glue::glue("{function_text}",
                                  ####         "token = gargle::token_fetch(scopes = get_function_scopes('{function_id}')), return_response = F, fields = NULL){{",
                                  "gargle_token = gargle::token_fetch(scopes = .endpoints[['{function_id}']]$scopes[[1]]), return_request = F, return_response = F){{",
                                  .trim = F)
      
      # Build function
      # TODO: NEED TO ADD useragent to request_make.
      function_text <- glue::glue("{function_text}", 
                                  "\n\t\t",
                                  "params <- as.list(environment())[!names(as.list(environment())) %in% c(",
                                  ###         ifelse(!is.null(body_schema_ref), "'{body_schema_ref}', ", ""),
                                  "'return_request', 'return_response', 'gargle_token')]",
                                  "\n\t\t",
                                  "req <- gargle::request_develop(endpoint = .endpoints[['{function_id}']], params = params, base_url = '{base_url}')",
                                  "\n\t\t",
                                  "req <- gargle::request_build(method = req$method, path = req$path, params = req$params, body = req$body, token = httr::config(token = gargle_token), base_url = req$base_url)",
                                  "\n\t\t",
                                  "if(return_request) return(req)",
                                  "\n\t\t",
                                  "res <- gargle::request_make(req, encode = 'json')",
                                  "\n\t\t",
                                  "if(return_response) return(res)",
                                  "\n\t\t",
                                  "httr::content(res)",
                                  "\n\t",
                                  "}",
                                  .trim = F)
      
      # Update appropriate file with new documentation and function.
      readr::write_lines(doc_text, category_file, append = T)
      readr::write_lines(function_text, category_file, append = T)
      
   }
   
   # Create batch request function.
   api_name <- api_info$title
   batch_path <- paste0('batch/', api_id %>% stringr::str_replace_all('[: _]', '/'))
   batch_function_name <- glue::glue("batch.{api_id %>% stringr::str_replace_all('[: _]', '.')}")
   
   package_batch_request_file <- glue::glue('{temp_script_dir}/batchRequests.R')
   file.create(package_batch_request_file)
   glue::glue(readLines(system.file("templates", "make_batch_request.R", package = "googlePackageMaker")) %>% paste(collapse = '\n'), .trim = F) %>%
 #  glue::glue(readLines('templates/make_batch_request.R') %>% paste(collapse = '\n'), .trim = F) %>% 
      stringr::str_remove_all('"') %>% 
      writeLines(package_batch_request_file)
      
   # Output package files.
   file.copy(from = temp_package_dir, to = output_dir, recursive = T, overwrite = F)
   
   T
}

# Removes first word in function_id for brevity.
create_function_name <- function(function_id){
   
   require(stringr)
   
   periods <- function_id %>% str_locate_all(fixed('.')) %>% purrr::pluck(1)
   
   str_sub(function_id, periods[[1]] + 1)
}