R/run_quietly.R

In cvms: Cross-Validation for Model Selection

run_quietly <- function(fn, ..., msg_context_fn) {
  call_process <- tryCatch(
    {
      purrr::map(.x = 1, .f = purrr::quietly(function(.x) {
        fn(...)
      }))
    },
    error = function(e) {
      stop(msg_context_fn(m = e))
    }
  )

  call_process[[1]]
}

throw_messages <- function(messages, msg_context_fn) {
  # Message the caught messages to the user
  for (m in messages) {
    # purrr::quietly adds \n to end of messages, which we're not interested in here
    m <- gsub("\\\n$", "", m)

    message(
      simpleMessage(
        paste0(msg_context_fn(m = m), "\n"),
        call = if (p <- sys.parent(1)) sys.call(p)
      )
    )
  }
}

throw_warnings <- function(warnings, msg_context_fn) {
  # Throw the caught warnings
  for (w in warnings) {
    warning(
      simpleWarning(
        msg_context_fn(m = w),
        call = if (p <- sys.parent(1)) sys.call(p)
      )
    )
  }
}