Merge pull request #47 from ReseauBiodiversiteQuebec/adne_refactor

Adne refactor

Author: vcameron1

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rcoleo
 Title: rcoleo
-Version: 2.3.0
+Version: 2.3.1
 Authors@R: c(
     person("Steve", "Vissault", , "steve.vissault@usherbrooke.ca", role = "aut",
            comment = c(ORCID = "0000-0002-0866-4376")),

R/coleo_api_utils.R

@@ -61,3 +61,35 @@ coleo_begin_req <- function(schema){
                        "useragent" = "rcoleo") |>
     httr2::req_error(body = coleo_error_message)
 }
+
+
+####################
+# Fonctions de base pour les médias
+####################
+
+ # Config de base pour les médias
+media_server <- function(){
+  s <- Sys.getenv("COLEOMEDIA_SERVER")
+  if (s==''){
+    if(file.exists(".local-server")){
+      s <- as.character(readRDS(".local-server"))
+    }else{
+      s <- "https://coleo.biodiversite-quebec.ca/upload/"
+    }
+   }
+   return(s)
+ }
+
+#' Pépare une requête générique à l'API de coleo-media
+#'
+#' @param server_dir Dossier sur le serveur où faire la requête
+#'
+#' @return Un objet httr2 request
+coleo_media_begin_req <- function(server_dir){
+  paste0(media_server(), server_dir, "/") |>
+    httr2::request() |>
+    httr2::req_headers("Accept" = "application/json",
+                       `Content-type` = "multipart/form-data",
+                       "Authorization" = paste("Bearer", bearer())) |>
+    httr2::req_error(body = coleo_error_message)
+}

R/coleo_inject.R

@@ -120,12 +120,6 @@ coleo_inject <- function(df, media_path = NULL, schema = 'public') {
       ### 1. Inject media files into coleo
       df_id <- coleo_inject_media(df_id, server_dir = 'observation', media_path)
 
-    } else if (campaign_type == "ADNe" & table == "landmarks") {
-      ## Obervations at the lake scale for "ADNe" campaigns do not have landmarks
-      ## Landmarks are injected even if there is no data with NA lat lon
-      ## It is necessary to skip their injection
-      df_id <- coleo_inject_adne_landmarks(df_id, campaign_type)
-
     } else {
       ## Regular table injections
       df_id <- coleo_inject_table(df_id, table, schema = schema)
@@ -292,18 +286,18 @@ coleo_injection_prep <- function(df, db_table, schema = 'public'){
     colnames_of_tbl <- coleo_get_column_names(tbl = db_table)$column_name
 
     df_prep <- df |>
-      coleo_prep_input_data(db_table) |>
+      coleo_prep_input_data(db_table, schema = schema) |>
       dplyr::mutate(inject_request = list(coleo_inject_general_df(dplyr::across(dplyr::any_of(colnames_of_tbl)), endpoint = db_table, schema = schema)))
 
   } else if (db_table == "ref_species") {
     # ref_species is the only table where the table name and the endpoint name are NOT THE SAME
     # here we hard-code the difference. This lets us stay with the convention of using the table name as the argument (not the endpoint name)
     df_prep <- df |>
-      coleo_prep_input_data(db_table) |>
+      coleo_prep_input_data(db_table, schema = schema) |>
       dplyr::mutate(inject_request = list(coleo_inject_general_df(dplyr::cur_data_all(), endpoint = "taxa", schema = schema)))
   } else {
     df_prep <- df |>
-      coleo_prep_input_data(db_table) |>
+      coleo_prep_input_data(db_table, schema = schema) |>
       dplyr::mutate(inject_request = list(coleo_inject_general_df(dplyr::cur_data_all(), endpoint = db_table, schema = schema)))
 
   }
@@ -520,27 +514,19 @@ coleo_inject_cells <- function(df, schema = 'public') {
 coleo_inject_media <- function(df_id, server_dir = "observation", file_dir) {
   #--------------------------------------------------------------------------
   # 1. Prep request
-  #--------------------------lures------------------------------------------------
-  url <- paste0(server(), "/upload/", server_dir, "/")
-
+  #--------------------------------------------------------------------------
   medias_requests <- df_id |>
     dplyr::rowwise() |>
     dplyr::mutate(inject_request = list(
       ## Form request
-      httr2::request(url) |>
-        httr2::req_headers(
-          `Content-type` = "multipart/form-data",
-          Authorization = paste("Bearer", bearer())
-        ) |>
-        ## Add id to request URL
-        ## - Can be observation_id, campaign_id, etc.
-        httr2::req_url_path_append(!!as.name(paste0(server_dir, "_id"))) |>
-        ## Error body
-        httr2::req_error(body = coleo_error_message) |>
-        ## Send file
-        httr2::req_body_multipart(
-          media = curl::form_file(paste0(file_dir, "/", media_name)),
-          type = "image")
+      coleo_media_begin_req(server_dir) |>
+      ## Add id to request URL
+      ## - Can be observation_id, campaign_id, etc.
+      httr2::req_url_path_append(!!as.name(paste0(server_dir, "_id"))) |>
+      ## Send file
+      httr2::req_body_multipart(
+        media = curl::form_file(paste0(file_dir, "/", media_name)),
+        type = "image")
     ))
 
   #--------------------------------------------------------------------------
@@ -666,47 +652,6 @@ coleo_inject_mam_landmarks <- function(df_id, schema = 'public') {
 }
 
 
-#' Injection des repères d'une campagne ADNe dans la table
-#' landmarks de coleo.
-#'
-#' L'injection des repèes ADNe est différente des autres de par la structure du jeu de données (tel que formaté par le template). Les observation à l'échelle du lac n'ont pas de repères alors que celles à l'échelle de la station ont des repères.
-#'
-#' Accepte un data.frame validè par \code{\link[rcoleo]{coleo_validate}} et performe
-#' l'injection de la table landmarks.
-#'
-#' La fonction est utilisée par \code{\link[rcoleo]{coleo_inject}}.
-#'
-#' @param df_id Un data.frame contenant une colonne campaign_id.
-#' @param campaign_type Type de la campagne. Doit être "ADNe".
-#' @param schema Schéma sur lequel faire la requête. Par défaut, le schéma
-#' public est utilisé.
-#'
-#' @return Une data.frame avec une colonne landmark_X_id et une colonne pour
-#' les landmark_X_error.
-#'
-coleo_inject_adne_landmarks <- function(df_id, campaign_type, schema = 'public') {
-  # Obervations at the lake scale for "ADNe" campaigns do not have landmarks
-  # Landmarks are injected even if there is no data with NA lat lon
-  # It is necessary to skip their injection
-  which_lac <- df_id$observations_extra_value_1 == "lac"
-  no_lake_id <- df_id[!which_lac,] |>
-    coleo_inject_table(table = "landmarks", schema = schema)
-
-  # Reassemble the dataframes
-  with_lac <- df_id[which_lac,]
-  with_lac[setdiff(names(no_lake_id), names(with_lac))] <- NA_character_
-  df_id <- rbind(no_lake_id, with_lac[names(no_lake_id)])
-
-  # Order columns
-  df_id <- df_id[,order(colnames(df_id))] |>
-      dplyr::relocate(dplyr::ends_with("_error")) |>
-      dplyr::relocate(dplyr::ends_with("_id"))
-
-  # Return the results
-  return(df_id)
-}
-
-
 #' Injection des colonnes taxa_names dans la table ref_species de coleo.
 #'
 #' Accepte un vecteur de noms de taxons et performe l'injection de la table

R/coleo_prep_input_data.R

@@ -11,10 +11,11 @@
 #'
 #' @param df le dataframe à preparer
 #' @param db_table la table ciblée dans la base de données
+#' @param schema le schéma de la base de données
 #'
 #' @return un tbl, nested
 #' @export
-coleo_prep_input_data <- function(df, db_table) {
+coleo_prep_input_data <- function(df, db_table, schema = "public") {
 
   # Convert character NAs to actual NAs
   # df[df == "NA"] <- NA
@@ -23,7 +24,7 @@ coleo_prep_input_data <- function(df, db_table) {
   if (db_table == "sites") {
     df <- df |>
       dplyr::nest_by(cells_cell_code) |>
-      dplyr::mutate(coleo_id = list(coleo_request_by_code(human_code = cells_cell_code, table = "cells")),
+      dplyr::mutate(coleo_id = list(coleo_request_by_code(human_code = cells_cell_code, table = "cells", schema = schema)),
             cell_id = coleo_extract_id(coleo_id)) |>
       dplyr::select(-cells_cell_code, -coleo_id) |>
       dplyr::relocate(cell_id) |>
@@ -36,7 +37,7 @@ coleo_prep_input_data <- function(df, db_table) {
     ## Add site_id to campaigns table
     df <- df |>
       dplyr::nest_by(sites_site_code) |>
-      dplyr::mutate(coleo_id = list(coleo_request_by_code(human_code = sites_site_code, table = "sites")),
+      dplyr::mutate(coleo_id = list(coleo_request_by_code(human_code = sites_site_code, table = "sites", schema = schema)),
             site_id = coleo_extract_id(coleo_id)) |>
       dplyr::select(-sites_site_code, -coleo_id) |>
       dplyr::relocate(site_id) |>

R/coleo_request.R

@@ -61,11 +61,12 @@ coleo_request_general <- function(endpoint, perform = TRUE, response_as_df = FAL
 #'
 #' @param human_code Code de site ou de cellule.
 #' @param table Table de la base de données à accéder. Seuls "cells" et "sites" sont supportés pour l'instant.
+#' @param schema Schéma de la base de données à accéder. Par défaut, "public".
 #' @param perform TRUE par default. Ne performe pas la requête et retourne l'object httr2 request si FALSE.
 #'
 #' @return si perform = TRUE, la réponse est retournée. Si perform = FALSE, la requête httr2 est retournée.
 #' @export
-coleo_request_by_code <- function(human_code, table, perform = TRUE){
+coleo_request_by_code <- function(human_code, table, schema = "public", perform = TRUE){
   # endpoint or whatever
   requested_code <- list(human_code)
   requested_code <- paste0("eq.", requested_code[[1]])
@@ -76,7 +77,7 @@ coleo_request_by_code <- function(human_code, table, perform = TRUE){
                                   sites = "site_code",
                                   stop("idk what to do with that"))
 
-  written_req <- coleo_begin_req('public') |>
+  written_req <- coleo_begin_req(schema) |>
     httr2::req_url_path_append(table) |>
     httr2::req_url_query(!!!requested_code)
 

R/coleo_validate.R

@@ -341,18 +341,20 @@ coleo_validate <- function(data, media_path = NULL) {
   #------------------------------------------------------------------------
   # Check that complexes of species are correctly formated
   #------------------------------------------------------------------------
-  is_complexes <- grepl("|", data$obs_species_taxa_name) |> which()
-  if(!length(is_complexes) == 0) {
-    cplx_valid <-sapply(data$obs_species_taxa_name[is_complexes], function(cplx) {
-      cplx_split <- strsplit(cplx, "|", fixed = TRUE) |> 
-        unlist() |>
-        stringr::str_trim()
-      cplx_formated <- paste(cplx_split, collapse = " | ")
-      identical(cplx, cplx_formated)
-    })
+  if ("obs_species_taxa_name" %in% dat_names) {
+    is_complexes <- grepl("|", data$obs_species_taxa_name) |> which()
+    if(!length(is_complexes) == 0) {
+      cplx_valid <-sapply(data$obs_species_taxa_name[is_complexes], function(cplx) {
+        cplx_split <- strsplit(cplx, "|", fixed = TRUE) |> 
+          unlist() |>
+          stringr::str_trim()
+        cplx_formated <- paste(cplx_split, collapse = " | ")
+        identical(cplx, cplx_formated)
+      })
 
-    if(!all(cplx_valid)) warning("--------------------------------------------------\nV\u00E9rifiez le format des complexes d'esp\u00e8ces : certain complexes sont incorrectement format\u00E9s. Les taxons composants le complexe doivent être s\u00E9par\u00E9s par une barre verticale flanqu\u00E9e d'un espace de chaque côt\u00E9 \" | \". Exemple : \"Acer saccharum | Acer negundo\"\n\n")
+      if(!all(cplx_valid)) warning("--------------------------------------------------\nV\u00E9rifiez le format des complexes d'esp\u00e8ces : certain complexes sont incorrectement format\u00E9s. Les taxons composants le complexe doivent être s\u00E9par\u00E9s par une barre verticale flanqu\u00E9e d'un espace de chaque côt\u00E9 \" | \". Exemple : \"Acer saccharum | Acer negundo\"\n\n")
 
+    }
   }
 
 
@@ -520,7 +522,9 @@ coleo_validate <- function(data, media_path = NULL) {
     if (campaign_type == "végétation_transect" & table == "campaigns")  message <- new_vegetation_transect_campaigns(data, nvals)
 
     ### Update message with missing observations
-    if (any(is.na(data$obs_species_taxa_name)) & table == "observations")  message <- missing_obs(data, nvals)
+    if ("obs_species_taxa_name" %in% dat_names) {
+      if (any(is.na(data$obs_species_taxa_name)) & table == "observations")  message <- missing_obs(data, nvals)
+    }
 
     ### Print message
     message(message)