feat: add notification helpers

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: gDRutils
 Type: Package
 Title: A package with helper functions for processing drug response data
-Version: 1.3.16
-Date: 2024-10-11
+Version: 1.3.17
+Date: 2024-10-18
 Authors@R: c(person("Bartosz", "Czech", role=c("aut"),
                    comment = c(ORCID = "0000-0002-9908-3007")),
              person("Arkadiusz", "Gladki", role=c("cre", "aut"), email="[email protected]",

NAMESPACE

@@ -55,6 +55,7 @@ export(get_default_identifiers)
 export(get_duplicated_rows)
 export(get_env_assay_names)
 export(get_env_identifiers)
+export(get_env_var)
 export(get_expect_one_identifiers)
 export(get_experiment_groups)
 export(get_header)
@@ -87,6 +88,7 @@ export(merge_assay)
 export(merge_metadata)
 export(modifyData)
 export(mrowData)
+export(notify_if_duplicates)
 export(predict_conc_from_efficacy)
 export(predict_efficacy_from_conc)
 export(prettify_flat_metrics)
@@ -98,6 +100,7 @@ export(rename_DFrame)
 export(rename_bumpy)
 export(reset_env_identifiers)
 export(round_concentration)
+export(send_email)
 export(set_SE_experiment_metadata)
 export(set_SE_experiment_raw_data)
 export(set_SE_fit_parameters)

NEWS.md

@@ -1,3 +1,6 @@
+## gDRutils 1.3.17 - 2024-10-18
+* add notification helpers
+
 ## gDRutils 1.3.16 - 2024-10-11
 * make duplicates' helpers supporting combo assays as well
 

R/duplicates.R

@@ -185,3 +185,62 @@ throw_msg_if_duplicates <- function(dt, assay_name = "unknown", msg_f = stop, pr
      msg_f(paste0(msg, msg2, msg3))
   }
 }
+
+#' send email if assay data.table contains duplicated rows
+#' 
+#' An auxiliary function to send email if duplicated rows in assay data.table are found
+#' 
+#' @param dt data.table with assay data
+#' @param by charvec with notification methods (currently 'email' supported)
+#' @param assay_name string with the name of the assay
+#' @param preview_max_numb number of rows to preview if duplicates found
+#' @param metadata list with the additional metadata to send via email
+#' @examples
+#' sdata <- get_synthetic_data("finalMAE_small")
+#' smetrics_data <- convert_se_assay_to_dt(sdata[[1]], "Metrics")
+#' throw_msg_if_duplicates(smetrics_data, assay_name = "Metrics", msg_f = futile.logger::flog.info)
+#' @return NULL
+#' @keywords duplicates
+#'
+#' @export
+#' 
+notify_if_duplicates <- function(dt, by = "email", assay_name = "unknown", preview_max_numb = 4, metadata = NULL) {
+
+  checkmate::assert_data_table(dt)
+  checkmate::assert_subset(by, c("email", "slack"))
+  checkmate::assert_string(assay_name)
+  checkmate::assert_number(preview_max_numb)
+  checkmate::assert_list(metadata, null.ok = TRUE)
+
+  dup_dt <- get_assay_dt_duplicated_rows(dt, output = "data")
+
+     msg <- sprintf(
+          "The %i out of %i rows are duplicated in the assay '%s'",
+          NROW(dup_dt),
+          NROW(dt),
+          assay_name)
+     msg2 <- sprintf(" when checking uniqueness with the following set of columns: '%s'. ",
+          toString(get_assay_req_uniq_cols(dt)))
+     msg3 <- sprintf("Here is the preview of the first %i duplicated rows in JSON format: '%s'",
+          preview_max_numb,
+          jsonlite::toJSON(dup_dt[seq(preview_max_numb), ]))
+     msg <- paste0(msg, msg2, msg3)
+     m_sbj <- "[gDR] Error - unexpected duplicates found"
+
+     if ("email" %in% by) { 
+     att_l <- list(c(dup_dt = dup_dt, metadata))
+     att_f <- tempfile()
+     qs::qsave(att_l, att_f)
+     m_to <- get_env_var("EMAIL_RECIPIENT")
+     stopifnot(nchar(m_to) > 0)
+     send_email(body = msg, subject = m_sbj, to = m_to, attached_files = att_f)
+     }    
+
+     if ("slack" %in% by) { 
+     s_to <- get_env_var("EMAIL_SLACK_NOTIFICATION")
+     stopifnot(nchar(s_to) > 0)
+     send_email(body = msg, subject = m_sbj, to = s_to)
+     }    
+
+
+  }

R/utils.R

@@ -757,3 +757,68 @@ calc_sd <- function(x) {
   }
 }
 
+
+#' send email by wrapping `mailR::send.mail`
+#'
+#' @param body a character containing the body content of the email
+#' @param subject A string with the subject of the email
+#' @param to a string with the recipient's email address
+#' @param from string with the sender's email address
+#' @param html a logical flag indicating whether the body of the email should be parsed as HTML
+#' @param inline a logical flag indicating whether images in the HTML file should be embedded inline
+#' @param host_name a string with the hostname
+#' @param attached_files a character with file paths to be attached to the email
+#'
+#' @keywords utils
+#' @export
+send_email <-
+  function(body,
+           subject,
+           to = get_env_var("EMAIL_RECIPIENT"),
+           from = get_env_var("EMAIL_SENDER"),
+           html = TRUE,
+           inline = FALSE,
+           host_name = get_env_var("EMAIL_HOSTNAME"),
+           attached_files = NULL) {
+
+    checkmate::assert_character(body)
+    checkmate::assert_string(subject, min.chars = 1)
+    checkmate::assert_string(to, min.chars = 1)
+    checkmate::assert_string(from, min.chars = 1)
+    checkmate::assert_flag(html)
+    checkmate::assert_flag(inline)
+    checkmate::assert_string(host_name, min.chars = 1)
+    if (!is.null(attached_files)) {
+      checkmate::assert_character(attached_files)
+      checkmate::assert_file_exists(attached_files)
+    }
+
+
+    mailR::send.mail(
+      from = from,
+      to = to,
+      subject = subject,
+      body = body,
+      smtp = list(host.name = host_name),
+      html = html,
+      inline = inline,
+      attach.files = attached_files
+    )
+  }
+
+
+#' safe wrapper of Sys.getenv()
+#' 
+#' So far the helper is needed to handle env vars containing `:` 
+#' for which the backslash  is automatically added in some contexts
+#' and R could not get the original value for these env vars.
+#' 
+#' @param x string with the name of the environemntal variable
+#' @param ... additional params for Sys.getenev
+#' @keywords utils
+#
+#' @export 
+#' @return sanitized value of the env variable
+get_env_var <- function(x, ...) {
+  gsub("\\\\", "", Sys.getenv(x, ...))
+}