R/upload_to_master.R

In KaiAragaki/ragaki: Reduce Annoyances

#' Get SharePoint drive
#'
#' A tiny wrapper function around `get_sharepoint_site` and `get_drive`
#'
#' @param site_url URL to SharePoint site. Defaults to GBCI site.
#'
#' @return an R6 object of class `ms_drive`
#' @export
get_sp_drive <- function(site_url = "https://livejohnshopkins.sharepoint.com/sites/GBCIStorage") {
  sp <- Microsoft365R::get_sharepoint_site(site_url = site_url)
  drive <- sp$get_drive()
}

#' Download a masterlist from SharePoint
#'
#' @param file Character. The name of the file. Varies depending on user
#'   convention.
#' @param user Character. The name of the user. Typically lastname-firstname.
#' @param masterlist_dir Character. The directory in which the masterlists are
#'   stored for that user. Varies depending on user convention. Defaults to
#'   Kai's masterlist directory name.
#' @export
#'
#' @details This function is highly tailored for personal use, and this has some
#'   hard-codings that might not suit your needs. Since this is a personal
#'   package, I think this is allowed.
#'
#'   `user` does not default here because I don't want to supply a `user`
#'   default to `put_master` - I don't want people accidentally uploading stuff
#'   to my masterlists, and I want consistency between like functions.
#'
#' @examples
#' \dontrun{
#' get_master("rna-master", "aragaki-kai")
#' }
get_master <- function(file, user, masterlist_dir = "01_masterlists") {

  gbci <- get_sp_drive()

  path <- fs::path("Projects and Manuscripts", user, masterlist_dir, file, ext = "xlsx")

  master_dest <- tempfile()
  gbci$download_file(path, dest = master_dest, overwrite = TRUE)
  readxl::read_excel(master_dest)
}


#' Upload a local masterlist to the SharePoint masterlist
#'
#' Note - this function is generally not recommended for interactive use.
#'
#' @param local_masterlist Character path to local masterlist
#' @param sp_masterlist Character name of SharePoint masterlist
#' @param user Character. lastname-firstname
#' @param masterlist_dir Directory (or path of directories) leading from the
#'   user folder to the masterlists folder.
#'
#' @export
put_master <- function(local_masterlist, sp_masterlist, user, masterlist_dir = "01_masterlists") {

  gbci <- get_sp_drive()

  path <- fs::path("Projects and Manuscripts", user, masterlist_dir, sp_masterlist, ext = "xlsx")

  gbci$upload_file(local_masterlist, path)

}

#' Upload a formatted object to a corresponding master list
#'
#' @param x Object to be uploaded
#' @param ... Additional arguments passed to methods
#'
#' @export
upload_to_master <- function(x, ...) {
  UseMethod("upload_to_master")
}


#' @param x a `nanodrop` object
#'
#' @param user character. Username to look for `masterlist_dir` in. 'lastname-firstname'
#' @param masterlist_dir character. Path from `user` just after `user` to the directory where masterlists are kept.
#' @param ... Additional arguments passed to methods
#'
#' @rdname upload_to_master
#' @export
upload_to_master.nanodrop <- function(x, user, masterlist_dir = "01_masterlists", ...) {

  stopifnot(is.character(user))

  if (!x$nucleotide %in% c("RNA")) {
    stop("No known way to upload nanodrop files of nucleotide type ", x$nucleotide)
  }

  if (x$nucleotide == "RNA") {

    master <- get_master("rna-master", user, masterlist_dir)

    both <- dplyr::inner_join(x$data, master, by = c("date", "nd_conc", "nd_file_sample_name"), suffix = c(".data", ".master"))
    master_has <- dplyr::semi_join(master, x$data, by = c("date", "nd_conc", "nd_file_sample_name"))
    if(nrow(master_has) >= nrow(x$data)) {
      message("All entries already found in masterlist.")
      if (all(is.na(master_has$nd_file_location))) {
        message("No link pointing to raw data location. Attempting to upload...")

        raw_file <- tempdir()
        out_file <- write_nanodrop(x, destination = raw_file, raw = TRUE)
        gbci <- get_sp_drive()
        path <- fs::path("Raw%20Data", "Nanodrop", user, fs::path_file(out_file))
        gbci$upload_file(out_file, path)
        link <- paste0("https://livejohnshopkins.sharepoint.com/sites/GBCIStorage/Shared%20Documents/", path)
        master_has$nd_file_location <- link
        not_current <- dplyr::anti_join(master, x$data, c("date", "nd_conc", "nd_file_sample_name"))

        master <- master_has |>
          dplyr::bind_rows(master_has, not_current) |>
          dplyr::arrange(date)

        file <- tempfile(fileext = ".xlsx")

        openxlsx::write.xlsx(master, file)

        put_master(file, "rna-master", user, masterlist_dir)

        return(invisible(x))

      }
      return(invisible(x))
    }
    master <- master |>
      dplyr::bind_rows(x$data) |>
      dplyr::arrange(date)

    file <- tempfile(fileext = ".xlsx")

    openxlsx::write.xlsx(master, file)

    put_master(file, "rna-master", user, masterlist_dir)
  }
}

#' Make data match format of master file
#'
#' @param x an object that has a corresponding master file
#' @export
format_like_master <- function(x) {
  UseMethod("format_like_master")
}

#' @param x a `nanodrop` object
#' @export
#' @rdname format_like_master
format_like_master.nanodrop <- function(x) {

  if (!x$nucleotide %in% c("RNA")) {
    stop("No known way to format nanodrop files of nucleotide type ", x$nucleotide)
  }

  if (x$nucleotide == "RNA") {

    if (!x$is_tidy) {
      message("nanodrop must be tidy to format properly but is not. Tidying.")
      x <- tidy_lab(x)
    }

    nd <- x$data

    final <- dplyr::tibble(
      date = lubridate::date(nd$date),
      nd_file_location = "",
      nd_file_sample_name = nd$sample_name,
      tube_name = nd$tube_name,
      nd_conc = nd$conc,
      a260_280 = nd$a260_280,
      a260_230 = nd$a260_230,
      cell_line = nd$cell_line,
      experimental_condition = nd$experimental_condition
    )

    x$data <- final
    return(x)
  }
}