1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
# (x <- Hooks$new())
# x$hooks
# x$define_hook(hook_type = "foo", fun = function(x) x ^ 2)
# x$hooks$foo(4)
# x$clear_hooks()
# x$hooks
#' @title Hooks class
#'
#' @description Helps define new hooks, hold hooks, and accessors to get and
#' use hooks.
#'
#' @keywords internal
#' @details
#' \strong{Private Methods}
#' \describe{
#' \item{`make_hook(x, plac, fun)`}{
#' Make a hook.
#' - x (character) Hook name
#' - plac Placement, one of "start" or "end"
#' - fun a function/callback
#' }
#' }
#' @format NULL
#' @usage NULL
Hooks <- R6::R6Class(
'Hooks',
public = list(
#' @field hooks intenal use
hooks = list(),
#' @description invoke a hook
#' @param hook_type (character) Hook name
#' @param args (named list) Args passed when invoking a hook
#' @return executes hook
invoke_hook = function(hook_type, args) {
self$hooks[[hook_type]](args)
},
#' @description clear all hooks
#' @return no return
clear_hooks = function() {
# clear hooks, set back to an empty list
self$hooks <- list()
},
#' @description define a hook
#' @param hook_type (character) Hook name
#' @param fun A function
#' @param prepend (logical) Whether to prepend or add to the end
#' of the string. Default: `FALSE`
#' @return no return; defines hook internally
define_hook = function(hook_type, fun, prepend = FALSE) {
private$make_hook(hook_type, if (prepend) "start" else "end", fun)
}
),
private = list(
make_hook = function(x, plac, fun) {
defhk <- DefinedHooks$new()
self$hooks[[x]] <-
defhk$set_hook(name = x,
placement_method = plac,
fun = fun
)
}
)
)
# defined hooks - xxx
DefinedHooks <- R6::R6Class(
'DefinedHooks',
public = list(
hooks = list(),
set_hook = function(name, placement_method, fun) {
attr(fun, "placement_method") <- placement_method
self$hooks[[name]] <- fun
return(self$hooks[[name]])
}
)
)
|
