R/golem_utils_server.R

In dbca-wa/turtleviewer: WA Turtle Data Viewer

# Inverted versions of in, is.null and is.na
`%not_in%` <- Negate(`%in%`)

not_null <- Negate(is.null)

not_na <- Negate(is.na)

# Removes the null from a vector
drop_nulls <- function(x) {
  x[!sapply(x, is.null)]
}

# If x is null, return y, otherwise return x
"%||%" <- function(x, y) {
  if (is.null(x)) {
    y
  } else {
    x
  }
}
# If x is NA, return y, otherwise return x
"%|NA|%" <- function(x, y) {
  if (is.na(x)) {
    y
  } else {
    x
  }
}

# typing reactiveValues is too long
rv <- shiny::reactiveValues
rvtl <- shiny::reactiveValuesToList

#' Return an sf object as tbl_df
#'
#' Used to remove unprintable elements before rendering a reactable.
#' @param sf_obj A SimpleFeatures (sf) object.
#' @return The sf object as tbl_df.
#' @export
sf_as_tbl <- function(sf_obj) {
  sf::st_geometry(sf_obj) <- NULL
  sf_obj
}

#' Shortcut for a filterable, sortable reactable.
#'
#' @param data A dataframe
#' @return The data in a reactable::reactable()
#' @export
rtbl <- function(data) {
  reactable::reactable(data, filterable = T, searchable = T)
}

#' Drop all list columns of a dataframe.
#'
#' @param data A tbl_df or sf
#' @return The tbl_df without columns that can't be written to csv.
drop_list_cols <- function(data) {
  data %>% dplyr::select_if(purrr::negate(is.list))
}

library(magrittr)
library(wastdr)

utils::globalVariables(".")
utils::globalVariables("area_name")
utils::globalVariables("geometry")
utils::globalVariables("site_conditions")
utils::globalVariables("turtledata")
utils::globalVariables("zip")

#' Download all data from ODKC UAT and PROD
#' 
#' @param workdir An absolute path to run the download in. Media attachments
#'   will be saved to `{workdir}/media` and linked as `media/{filename.jpg}`.
#' @param save_packagedata Whether to update the package data, default: FALSE
#' @export
download_odkc <- function(
  workdir=here::here("inst/odk"),
  save_packagedata=F
){
  old_workdir <- getwd()
  setwd(workdir)
  
  message(glue::glue("Downloading ODK Central data to {getwd()}..."))
  
  turtledata <- wastdr::download_odkc_turtledata_2019(
    datafile=fs::path(workdir, "turtledata.rda"),
    extrafile = fs::path(workdir, "turtledata_uat.rda"), 
    local_dir="media"
  )
  
  setwd(old_workdir)
  message(glue::glue("Restoreds workdir to {getwd()}."))
  
  if (save_packagedata==TRUE) {
    usethis::use_data(turtledata, compress="xz", overwrite=T)
  }

  turtledata
}

#' #' Render details for turtledata$mwi
#' #' 
#' #' @param index The row index for one row of turtledata$mwi
#' #' @return Shiny tags
#' #' @export
#' #' @examples
#' #' data(turtledata)
#' #' reactable(turtledata$mwi, details=details_mwi)
#' details_mwi <- function(index) {
#'   tags$div(
#'     class="row",
#'     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat),
#'     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat2),
#'     tags$img(width="200px;", src=get_data()$mwi[index,]$photo_habitat3),
#'   )
#' }
#' 

#' Generate a reactable::colDef from a vector of column names
#' 
#' @param colnames A vector of column names
#' @export
mkcoldef <- function(colnames){
  
  l <- list()
  for (cn in colnames)
    l[[cn]] = reactable::colDef(aggregate = "sum")
  l
}