Tools to work with the Google DNS over HTTPS API in R https://cinc.rud.is/web/packages/gdns/
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

utils-safely.R 2.1KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990
  1. # Less cool counterparts to purrr's side-effect capture-rs
  2. #
  3. # Most of the helper functions are 100% from output.R in purrr repo
  4. #
  5. # @param quiet Hide errors (`TRUE`, the default), or display them
  6. # as they occur?
  7. # @param otherwise Default value to use when an error occurs.
  8. #
  9. # @return `safely`: wrapped function instead returns a list with
  10. # components `result` and `error`. One value is always `NULL`.
  11. #
  12. # `quietly`: wrapped function instead returns a list with components
  13. # `result`, `output`, `messages` and `warnings`.
  14. #
  15. # `possibly`: wrapped function uses a default value (`otherwise`)
  16. # whenever an error occurs.
  17. safely <- function(.f, otherwise = NULL, quiet = TRUE) {
  18. function(...) capture_error(.f(...), otherwise, quiet)
  19. }
  20. quietly <- function(.f) {
  21. function(...) capture_output(.f(...))
  22. }
  23. possibly <- function(.f, otherwise, quiet = TRUE) {
  24. force(otherwise)
  25. function(...) {
  26. tryCatch(.f(...),
  27. error = function(e) {
  28. if (!quiet)
  29. message("Error: ", e$message)
  30. otherwise
  31. },
  32. interrupt = function(e) {
  33. stop("Terminated by user", call. = FALSE)
  34. }
  35. )
  36. }
  37. }
  38. capture_error <- function(code, otherwise = NULL, quiet = TRUE) {
  39. tryCatch(
  40. list(result = code, error = NULL),
  41. error = function(e) {
  42. if (!quiet)
  43. message("Error: ", e$message)
  44. list(result = otherwise, error = e)
  45. },
  46. interrupt = function(e) {
  47. stop("Terminated by user", call. = FALSE)
  48. }
  49. )
  50. }
  51. capture_output <- function(code) {
  52. warnings <- character()
  53. wHandler <- function(w) {
  54. warnings <<- c(warnings, w$message)
  55. invokeRestart("muffleWarning")
  56. }
  57. messages <- character()
  58. mHandler <- function(m) {
  59. messages <<- c(messages, m$message)
  60. invokeRestart("muffleMessage")
  61. }
  62. temp <- file()
  63. sink(temp)
  64. on.exit({
  65. sink()
  66. close(temp)
  67. })
  68. result <- withCallingHandlers(
  69. code,
  70. warning = wHandler,
  71. message = mHandler
  72. )
  73. output <- paste0(readLines(temp, warn = FALSE), collapse = "\n")
  74. list(
  75. result = result,
  76. output = output,
  77. warnings = warnings,
  78. messages = messages
  79. )
  80. }