R/googleAuthR_discovery.R

In yinscapital/googleAuthR-reference: Easy Authentication with Google OAuth2 API

#' Create a Google API package
#' 
#' @param api_json json from \link{gar_discovery_api}
#' @param directory Where to build the package
#' @param rstudio Passed to \link[devtools]{create}, creates RStudio project file
#' @param check Perform a \link[devtools]{check} on the package once done
#' @param github If TRUE will upload package to your github
#' @param format If TRUE will use \link[formatR]{tidy_eval} on content
#' @param overwrite Whether to overwrite an existing directory if it exists
#' 
#' @details 
#' 
#' For github upload to work you need to have your github PAT setup. See \link[devtools]{use_github}.
#' 
#' Uses devtools' \link[devtools]{create} to create a package structure then 
#'   \link{gar_create_api_skeleton} and \link{gar_create_api_objects} to create 
#'   starting files for a Google API package.
#' 
#' @seealso \url{https://developers.google.com/discovery/v1/reference/apis/list}
#'
#' @return If check is TRUE, the results of the CRAN check, else FALSE
#' 
#' @seealso A Github repository with \href{154 R packages}{https://github.com/MarkEdmondson1234/autoGoogleAPI} generated by this function.
#' 
#' @family Google Discovery API functions
#' @export
gar_create_package <- function(api_json, 
                               directory, 
                               rstudio = TRUE, 
                               check = TRUE, 
                               github = TRUE,
                               format = TRUE,
                               overwrite = TRUE){
  check_package_loaded("devtools")
  package_name <- paste0("google",
                         gsub("\\.","", make.names(api_json$id, allow_ = FALSE)),
                         ".auto")
  package_dir <- file.path(directory, package_name)
  if(file.exists(package_dir) & !overwrite){
    message("Package directory already exisits and overwrite = FALSE, returning NULL")
    return(NULL)
  }
  message("Creating ", package_name, " at file location ", package_dir )
  
  f_files <- file.path(package_dir, "R", paste0(api_json$name, "_functions.R"))
  o_files <- file.path(package_dir, "R", paste0(api_json$name,"_objects.R"))
  
  if(!file.exists(f_files)){
    devtools::create(file.path(directory, package_name),
                     list(
                       Package = package_name,
                       Version = "0.0.0.9000",
                       Title = api_json$title,
                       Description = paste0(api_json$description, " Auto-generated via googleAuthR."),
                       "Authors@R" = 'c(person("Mark", "Edmondson",email = "m@sunholo.com",
                       role = c("aut", "cre")))',
                       Imports = "googleAuthR (>= 0.3)",
                       License = "MIT + file LICENSE"
                       ),
                     rstudio = rstudio)
  }
  
  gar_create_api_skeleton(f_files, api_json, format = format)
  gar_create_api_objects(o_files, api_json, format = format)
  
  add_line(c("YEAR: 2016\nCOPYRIGHT HOLDER: Sunholo Ltd.\n\t"), file.path(package_dir,"LICENSE"))
  
  if(format) devtools::document(package_dir)
  make_readme(package_dir, api_json)

  ## add_travis

  result <- FALSE
  if(check){
    result <- devtools::check(package_dir)
  }
  
  if(github){
    ## if fail, use git add
    devtools::use_github(pkg = package_dir, protocol = "https")
  } ## git2r::push
  
  result
}


#' Get a list of Google API libraries
#' 
#' Doesn't require authentication
#' 
#' @seealso \url{https://developers.google.com/discovery/v1/reference/apis/list}
#' 
#' @return List of Google APIs and their resources
#' @family Google Discovery API functions
#' 
#' @export
gar_discovery_apis_list <- function(){
  
  url <- "https://www.googleapis.com/discovery/v1/apis"
  req <- httr::RETRY("GET", url)
  
  httr::stop_for_status(req)
  
  stuff <- httr::content(req, as = "text")
  apis <- jsonlite::fromJSON(stuff)
  
  if(!is.null(apis$kind) && apis$kind == "discovery#directoryList"){
    out <- apis$items
  } else {
    stop("Problem fetching Discovery APIs")
  }
  
  out
}

#' Get meta data details for specified Google API
#' 
#' Doesn't require authentication
#' 
#' @param api The API to fetch
#' @param version The API version to fetch
#' 
#' @seealso \url{https://developers.google.com/discovery/v1/reference/apis/getRest}
#' 
#' @return Details of the API 
#' @family Google Discovery API functions
#' @export
gar_discovery_api <- function(api, version){
  
  url <- sprintf("https://www.googleapis.com/discovery/v1/apis/%s/%s/rest",
                 api,
                 version)
  
  req <- httr::RETRY("GET", url)
  
  httr::stop_for_status(req)
  
  stuff <- httr::content(req, as = "text")
  api <- jsonlite::fromJSON(stuff)
  
  if(!is.null(api$kind) && api$kind == "discovery#restDescription"){
    out <- api
  } else {
    stop("Problem fetching API Description")
  }
  
  out
}



#' Create an API library skeleton
#' 
#' This will create a file with the skeleton of the API functions 
#'   for the specified library
#' 
#' @param filename R file to write skeleton to
#' @param api_json The json from \link{gar_discovery_api}
#' @param format If TRUE will use \link[formatR]{tidy_eval} on content
#' 
#' @return TRUE if successful, side effect will write a file
#' @family Google Discovery API functions
#' @export
gar_create_api_skeleton <- function(filename, 
                                    api_json,
                                    format = TRUE){
  

  if(is.null(api_json$kind) && api_json$kind != "discovery#restDescription"){
    stop("api_json not recognised from gar_discovery_api")
  }
  
  if(file.exists(filename)){
    warning("Overwriting file ", filename)
    file.remove(filename)
  }
  
  temp <- tempfile()
  on.exit(file.remove(temp))
  
  header <- paste0(
      "#' ", api_json$title, "\n",
      "#' ", api_json$description, "\n",
      "#' \n",
      "#' Auto-generated code by googleAuthR::gar_create_api_skeleton\n",
      "#'  at ", as.character(Sys.time()), "\n",
      "#' filename: ", as.character(filename),"\n",
      "#' api_json: ", paste(substitute(api_json), collapse = " "),"\n",
      "#' \n",
      "#' @details \n",
      "#' Authentication scopes used are:\n",
      "#' \\itemize{\n",
      "#'   \\item ", paste(names(api_json$auth$oauth2$scopes), collapse = "\n#' \\item "),
      "\n#' }\n",
      "#' \n",
      "#' @docType package \n",
      "#' @name ", paste0(api_json$name,"_googleAuthR"), "\n",
      "#' \n",
      "NULL",
      "\n"
      )
  
  support_functions <- paste0(
    "#' A helper function that tests whether an object is either NULL _or_\n",
    "#' a list of NULLs\n",
    "#'\n",
    "#' @keywords internal\n",
    "  is.NullOb <- function(x) is.null(x) | all(sapply(x, is.null))\n",
    "\n",   
    "   #' Recursively step down into list, removing all such objects\n",
    "   #'\n",
    "   #' @keywords internal\n",
    "   rmNullObs <- function(x) {\n",
    "     x <- Filter(Negate(is.NullOb), x)\n",
    "     lapply(x, function(x) if (is.list(x)) rmNullObs(x) else x)\n",
    "   }\n"
  )
  
  add_line(header, temp)
  add_line(support_functions, temp)
  
  ## apis can have methods at varying steps into JSON tree
  ## find the methods to extract into API
  api_method <- get_json_methods(api_json$resources)

  fd <- lapply(api_method, function_docs, api_json = api_json)
  fp <- lapply(api_method, function_params, api_json = api_json)
  fb <- lapply(api_method, function_body, api_json = api_json)

  lapply(paste(fd, fp,fb, sep = "\n\n"), add_line, temp)
  
  if(format){
    check_package_loaded("formatR")
    formatR::tidy_eval(temp, file = filename, width.cutoff = 80)
  } else {
    file.copy(temp, filename)
  }
  
}




#' Create the API objects from the Discovery API
#' 
#' @param filename File to write the objects to
#' @param api_json The json from \link{gar_discovery_api}
#' @param format If TRUE will use \link[formatR]{tidy_eval} on content
#' 
#' @return TRUE if successful, side-effect creating filename
#' @family Google Discovery API functions
#' @export
gar_create_api_objects <- function(filename, api_json, format = TRUE){
  
  if(is.null(api_json$kind) && api_json$kind != "discovery#restDescription"){
    stop("api_json not recognised from gar_discovery_api")
  }
  
  if(file.exists(filename)){
    warning("Overwriting file ", filename)
    file.remove(filename)
  }
  
  temp <- tempfile()
  on.exit(file.remove(temp))

  
  header <- paste0(
    "#' ", api_json$title, " Objects \n",
    "#' ", api_json$description, "\n",
    "#' \n",
    "#' Auto-generated code by googleAuthR::gar_create_api_objects\n",
    "#'  at ", as.character(Sys.time()), "\n",
    "#' filename: ", as.character(filename),"\n",
    "#' api_json: ", paste(substitute(api_json), collapse = " "),"\n",
    "#' \n",
    "#' Objects for use by the functions created by googleAuthR::gar_create_api_skeleton\n",
    "\n"
  )

  add_line(header, temp)
  
  ## take the json and create a file of structures that will get passed to the functions that need them
  object_schema <- api_json$schemas
  set_global(NULL)
  apply_json_props(object_schema)
  properties <- get_global()
  set_global(list())
  
  fd <- lapply(names(properties), object_docs, properties)
  fp <- lapply(names(properties), object_params, properties)
  fb <- lapply(names(properties), object_body, properties)
  
  lapply(paste(fd, fp,fb, sep = "\n\n"), add_line, temp)
  
  if(format){
    formatR::tidy_eval(temp, file = filename, width.cutoff = 80)
  } else {
    file.copy(temp, filename)
  }

  
}