R/mockable_function_wrapper.R

In EntirelyDS/mutablefnr: Mockable Functions For R

MockableFunctionWrapper <- R6::R6Class(
  'MockableFunctionWrapper',
  public = list(
    initialize = function(f){
      if(!missing(f) && (typeof(f) == 'closure')){
        private$fn_ <- f
        private$orig_fn_ <- f
      }else{
        stop('RHS to \\%mockable\\% operator is not a closure')
      }
    },
    mock = function(f){
      if(!missing(f) && (typeof(f) == 'closure')){
        new_args <- formals(f)
        n_new <- length(new_args)
        orig_args <- formals(private$orig_fn_)
        n_orig <- length(orig_args)
        # Check whether have same args
        has_same_args <- n_new == n_orig
        has_same_args <- has_same_args &&
          (n_new == 0 || sort(names(new_args)) == sort(names(orig_args)))

        is_compatible <- TRUE
        if (!has_same_args){
          # If not the same args, check if compatible
          if (n_orig == 0){
            is_compatible <- FALSE
          }else{
            nm <- names(orig_args)
            if ('...' %in% nm){
              nm <- nm[nm != '...']
              if (
                length(nm) > 0 &&
                  (length(nm) > n_new || !all(nm %in% names(new_args)))
              ){
                is_compatible <- FALSE
              }
            }else{
              is_compatible <- FALSE
            }
          }
        }
        if (!is_compatible){
          warning(
            stringr::str_c(
              'Mock function ',
              deparse(match.call()[['f']]),
              ' does not have compatible argument list as original function, ',
              'mockable not mocked'
            )
          )
        }else{
          private$fn_ <- f
        }
      }else{
        warning(
          stringr::str_c(
            'Mock function ',
            ifelse(
              missing(f), '',
              stringr::str_c(
                deparse(match.call()[['f']]),
                ' '
              )
            ),
            'is not a closure, mockable not mocked'
          )
        )
      }
    },
    unmock = function(){
      private$fn_ <- private$orig_fn_
    },
    call = function(...) {
      if(!typeof(private$fn_) == 'closure') {
        warning("MockableFunction has no underlying object of type closure")
        return(NA)
      }
      return(private$fn_(...))
    }
  ),
  private = list(
    fn_ = NA,
    orig_fn_ = NA
  )
)