R/crul_utils.R

Defines functions get_ocpu_list_item format_crul_input .quote get_crul_results session_list_item get_ocpu_obj ocpu_session

Documented in format_crul_input get_crul_results get_ocpu_list_item get_ocpu_obj ocpu_session .quote session_list_item

#functions for interacting with crul calls to opencpu

#' @title ocpu_session
#' @export
#' @details get ocpu results session
ocpu_session<-function(x){
  x$meta$session
}

#' @title get_ocpu_obj
#' @export
#' @details get ocpu results based on session
get_ocpu_obj<-function(session,open_cpu_url=options('open_cpu_url')){
  session_url<-paste0(open_cpu_url,'/tmp/',session,'/R/.val/rds')
  readRDS(gzcon(curl::curl(session_url)))
}

#' @title session_list_item
#' @export
#' @details get list element by name from obj created in a previous session
session_list_item<-function(obj,name){
  obj[[name]]
}


#' @title get_crul_results
#' @param res crul response object
#' @import crul
#' @export
get_crul_results<-function(res){

  #headers

  headers <- tryCatch(res$response_headers,error=function(e){e})

  if("error" %in% class(headers)){

    return(
      list(
        meta = list(
          session = NULL,
          status = NULL
        ),
        paths = NULL
      )
    )

  }

  list(
    meta = list(
      session = headers$`x-ocpu-session`,
      status = res$status_code
    ),
    paths = strsplit(res$parse(), '\n')[[1]] #error messages will get sent here as well
  )

}

#' @title .quote
#' @export
#' @details add extra quotes around expression
.quote<-function(x,sep="'"){
  paste0(sep,x,sep)
}


#' @title format_crul_input
#' @param body
#'
#' @return
#' @export
#'
#' @examples
format_crul_input<-function(body){

  #omit session references
  #convert characters to quotes
  #convert lists to json

  is_session<-function(x){
    tryCatch(!is.null(x$meta$session),error=function(e){FALSE})
  }

  crul_format<-function(x){

    if(is_session(x)) return(ocpu_session(x))

    if(is.list(x) | length(x) >1) return(toJSON(x))

    if(is.character(x) & length(x) == 1) return(.quote(x))

    return(x)

  }

  lapply(body,  crul_format)

}

#' @title get_ocpu_list_item
#' @param connection
#' @param body
#'
#' @return named element from objects created in other sessions
#' @export
#'
#' @examples
get_ocpu_list_item <- function(connection, body) {
  pkg_url <- 'ocpu/library/ocpuclient/R/session_list_item'

  headers <- connection$headers$'Content-Type'
  connection$headers$'Content-Type' <- NULL

  body$obj<-ocpu_session(body$obj)
  body$name<-.quote(body$name)
  res <-
    connection$post(path = pkg_url,
                    body = body)


  connection$headers$'Content-Type' <- headers

  get_crul_results(res)

}
dgrapov/ocpuclient documentation built on April 16, 2022, 6:19 a.m.