R/common.R

In teramonagi/fitbitr: Provides Access to Fitbit API

# Dummy functions for function argument...

#' @param token An OAuth 2.0 token generated by oauth_token()
inheritparams_token <- function(){}

#' @param date A Date class object or a string in the format "yyyy-MM-dd" or "today".
inheritparams_date <- function(){}

#' @param simplify logical; should the result be simplified from a list to a data.frame if possible
inheritparams_simplify <- function(){}

tidy_output <- function(content, simplify)
{
  if(!simplify){return(content)}
  if(is.data.frame(content)){return(content)}
  if(length(content) == 0){return(content)}

  #Stop redundant warnings
  old <- options(warn = -1)
  result <- Reduce(cbind, lapply(content, as.data.frame))
  options(old)
  names(result) <- stringr::str_replace_all(names(result), "\\.", "_")
  result
}

check_response <- function(response)
{
  if(httr::http_error(response)){
    message <- paste0(httr::http_condition(response, "message"), httr::content(response, as="text"))
    stop(message)
  }
  response
}

get <- function(url, token)
{
  header <- character()
  if(!is.null(token$locale)){
    header <- c("Accept-Locale"=token$locale)
  }
  if(!is.null(token$language)){
    header <- c(header, "Accept-Language"=token$language)
  }
  response <- httr::GET(url=url, httr::add_headers(.headers = header), httr::config(token = token$token))
  extract_content(check_response(response))
}

post <- function(url, token, body)
{
  response <- check_response(httr::POST(url=url, body=body, httr::config(token = token$token)))
  extract_content(check_response(response))
}

delete <- function(url, token)
{
  response <- check_response(httr::DELETE(url=url, httr::config(token = token$token)))
  extract_content(check_response(response))
}

make_get_function <- function(url)
{
  function(token, simplify=TRUE)
  {
    tidy_output(get(url, token), simplify)
  }
}

extract_content <- function(response)
{
  jsonlite::fromJSON(httr::content(response, as = "text"))
}

format_date <- function(date){
  if(lubridate::is.Date(date)){
    format(date, "%Y-%m-%d")
  }else{
    date
  }
}

to_posixct <- function(...)
{
  args <- list(...)
  if(length(args)==1){
    #regard as date_time
    as.POSIXct(strptime(stringr::str_replace(args[[1]], "\\.\\d+", ""), "%Y-%m-%dT%H:%M:%S"))
  } else if(length(args)==2){
    date <- as.Date(args[[1]])
    time <- args[[2]]
    diff_hour <- diff(as.numeric(stringr::str_sub(time, 1, 2)))
    date <- date + Reduce(function(x, y){(y < 0) + x}, diff_hour, 0, accumulate=TRUE)
    #regars as date, time
    as.POSIXct(strptime(paste0(date, " ", time), "%Y-%m-%d %H:%M:%S"))
  } else{
    stop("Error")
  }
}

stop_if_x_is_not_in <- function(x, choices)
{
  if(!(x %in% choices)){
    stop("Error")
  }
}