R/mockable.R

In EntirelyDS/mutablefnr: Mockable Functions For R

#' @export
mockable <- function(g, f){

  parent_env <- parent.frame(n = 1)
  fm <- MockableFunctionWrapper$new(f)$call
  eval(
    call("<-", match.call()[["g"]], fm), parent_env, parent_env
  )
  invisible(
    eval(
      call(
        "class<-", match.call()[["g"]],
        c("MockableFunction", eval(class(g), parent_env, parent_env))
      ),
      parent_env, parent_env
    )
  )

}

#' @export
mock <- function(g, f){

  parent_env <- parent.frame(n = 1)

  check <- try(
    "MockableFunction" %in% suppressWarnings(
      eval(class(g), parent_env, parent_env)
    ),
    silent = TRUE
  )
  if ('try-error' %in% class(check)){
    rm(check)
    check <- FALSE
  }
  if (!check){
    stop(
      stringr::str_c(
        deparse(match.call()[["g"]]), " must be a mockable function"
      )
    )
  }
  invisible(environment(g)[['self']]$mock(f))
}

#' @export
unmock <- function(g, f){

  parent_env <- parent.frame(n = 1)
  check <- try(
    "MockableFunction" %in% suppressWarnings(
      eval(class(g), parent_env, parent_env)
    ),
    silent = TRUE
  )
  if ('try-error' %in% class(check)){
    rm(check)
    check <- FALSE
  }
  if (!check){
    stop(
      stringr::str_c(
        deparse(match.call()[["g"]]), " must be a mockable function"
      )
    )
  }
  invisible(environment(g)[['self']]$unmock())
}

#' @export
definition <- function(g){

  parent_env <- parent.frame(n = 1)
  check <- try(
    "MockableFunction" %in% suppressWarnings(
      eval(class(g), parent_env, parent_env)
    ),
    silent = TRUE
  )
  if ('try-error' %in% class(check)){
    rm(check)
    check <- FALSE
  }
  if (!check){
    stop(
      stringr::str_c(
        deparse(match.call()[["g"]]), " must be a mockable function"
      )
    )
  }
  return(environment(g)[['private']]$fn_)
}



#' @export
print.MockableFunction <- function(x, ...){
  cat("Current definition of mockable function:\n")
  print(environment(x)[['private']]$fn_)
}

#' @export
`%mockable%` <- mockable
#' @export
`%mock%` <- mock