reading arguments of $-method functions

Question

I use redux::hiredis over ssh port-forwarding for some projects, and my network link occasionally glitches and the connection object fails (for known reasons). redux provides R$reconnect() for this, I'm trying to find a way to automate reconnecting (since it is only a manual process).

The most direct way is to use something like this, everywhere:

R <- redux::hiredis()
res <- tryCatch(
  R$GET("quux"),
  error = function(e) {
    if (grepl("Failure communicating", conditionMessage(e))) {
      R$reconnect()
      R$GET("quux")
    } else stop(e)
  })

but that gets a bit onerous when used in many places (some I don't have easy access to change).

One thought I had is to super-class it and add an $-method for the new class. It takes some trickery to not be recursive, but something like this works, though it adds a PING to each call:

redis_retry <- function(..., verbose = FALSE) {
  R <- redux::hiredis(...)
  class(R) <- c("redis_retry", class(R))
  R
}

`$.redis_retry` <- function(x, val) {
  val <- substitute(val)
  ocls <- class(x)
  on.exit(class(x) <- ocls, add = TRUE)
  class(x) <- setdiff(class(x), "redis_retry")
  res <- tryCatch(x$PING(), error = function(e) e)
  if (inherits(res, "error")) {
    if (grepl("Failure communicating with", conditionMessage(res))) {
      x$reconnect()
      res <- tryCatch(x$PING(), error = function(e) e)
      if (inherits(res, "error")) stop(res)
      return(x[[val]])
    } else stop(res)
  }
  x[[val]]
}

R2 <- redis_retry()
R2$SET("quux", 42)
# [Redis: OK]
R2$GET("quux")
# [1] "42"

### disconnect ssh port-forwarding
R2$GET("quux")
# Error in redis_connect_tcp(config$host, config$port, config$timeout) : 
#   Failed to create context: Unknown error

### reconnect ssh port-forwarding
R2$GET("quux")
# [1] "42"

I'd like to be able to skip the need for x$PING() internally. However, the intent of the $-accessor is only to return the function, so the following ("quux") is unknown to $. For example, if I debug it,

Browse[1]> debug at #3: val <- substitute(val)
Browse[2]> match.call()
`$.redis_retry`(x = R2, val = GET)
Browse[2]> where
where 1: `$.redis_retry`(R2, GET)
where 2: R2$GET
Browse[2]> sys.calls()
[[1]]
R2$GET
[[2]]
`$.redis_retry`(R2, GET)

and I don't see an easy way to determine the rest of the expression.

Perhaps I'm being dim about this, is there an easy way to wrap the R2 object such that the original named-function is tried and, if it fails, $reconnect() and try again?

Fake redis

If you don't have redux or an instance of redis available, here's a fake version that (I think) adequately resembles the redis::hiredis methods I'm demonstrating above:

fake_redis <- function() {
  .counter <- 0L
  env <- new.env(parent = emptyenv())
  env$GET <- function(ign) {
    if (.counter > 2) stop("counter is high")
    .counter <<- .counter + 1L
    "42"
  }
  env$reconnect <- function() .counter <<- 0L
  env
}
fakeR <- fake_redis()
fakeR$GET("quux")
# [1] "42"
fakeR$GET("quux")
# [1] "42"
fakeR$GET("quux")
# [1] "42"
fakeR$GET("quux")
# Error in fakeR$GET("quux") : counter is high
fakeR$reconnect()
fakeR$GET("quux")
# [1] "42"

Is there any other example we could test with that doesn't use `redux::hiredis`? I'm not sure I follow what's going on and since I can't run it, it's difficult to test. — MrFlick, Mar 14 '23 at 14:55
Fair question, thanks @MrFlick. I've edited with a fake version which I hope adequately mimics the `redux` behavior. — r2evans, Mar 14 '23 at 15:32

MrFlick · Accepted Answer · 2023-03-14T20:59:55.623

1

So what if the $ returned a function that wrapped the inner function. So like this

`$.redis_retry` <- function(x, val) {
  val <- substitute(val)
  ocls <- class(x)
  class(x) <- setdiff(class(x), "redis_retry")
  function(...) {
    res <- tryCatch(x[[val]](...), error = function(e) e)
    if (inherits(res, "error")) {
      x$reconnect()
      message("reconnecting")
      res <- x[[val]](...)
    }
    res
  }
}

I tested with the fake_redis function you provided

redis_retry <- function(..., verbose = FALSE) {
  R <- fake_redis(...)
  class(R) <- c("redis_retry", class(R))
  R
}
fakeR <- redis_retry()
fakeR$GET("quux")
# [1] "42"
> fakeR$GET("quux")
[1] "42"
fakeR$GET("quux")
# [1] "42"
fakeR$GET("quux")
# reconnecting
# [1] "42"
fakeR$reconnect()
# [1] 0
fakeR$GET("quux")
# [1] "42"

edited Mar 14 '23 at 20:59

answered Mar 14 '23 at 16:52

MrFlick

195,160
17
277
295

This worked with the real `redux`-based problem as well, perfect. Thank you! – r2evans Mar 14 '23 at 19:54
1

I think you can probably move the class renaming stuff outside of the inner function. I forgot to test it but probably doesn't matter too much. – MrFlick Mar 14 '23 at 20:13
yes that works as well – r2evans Mar 14 '23 at 20:43
1

I found I needed to add `class(x) <- c("redis_retry", class(x))` inside the inner function immediately before `res` is returned, otherwise the second failure would not use this adjusted `$`-method. – r2evans May 15 '23 at 17:43

reading arguments of $-method functions

Fake redis

1 Answers1