-
Notifications
You must be signed in to change notification settings - Fork 9
/
shinyModule.R
147 lines (135 loc) · 3.72 KB
/
shinyModule.R
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
#' Reactlog Shiny Module
#'
#' Displays an iframe of the reactlog in the given application.
#'
#' State will not be preserved between refreshes.
#' To open the reactlog at a particular step, be sure to mark your time points
#' with `Cmd+Shift+F3` (Windows: `Ctrl+Shift+F3`)
#'
#' @param id \pkg{shiny} module id to use
#' @param ... parameters passed to [shiny::actionButton()]
#' @param width,height HTML attributes to be applied to the reactlog iframe
#' @param include_refresh should the iframe refresh button be included?
#' @seealso [shiny::moduleServer()]
#' @rdname reactlog_module
#' @export
#' @examples
#' if (!require("shiny")) {
#' message("`shiny` required to run example")
#' return()
#' }
#'
#' library(shiny)
#' # Enable reactlog
#' reactlog_enable()
#'
#' # Define UI for app that draws a histogram ----
#' ui <- fluidPage(
#' tags$h1("Pythagorean theorem"),
#' numericInput("a", "A", 3),
#' numericInput("b", "B", 4),
#' "C:", verbatimTextOutput("c"),
#' ### start ui module
#' reactlog_module_ui()
#' ### end ui module
#' )
#'
#' server <- function(input, output, session) {
#' a2 <- reactive({a <- input$a; req(a); a * a}, label = "a^2")
#' b2 <- reactive({b <- input$b; req(b); b * b}, label = "b^2")
#' c2 <- reactive({a2() + b2()}, label = "c^2")
#' c_val <- reactive({sqrt(c2())}, label = "c")
#'
#' output$c <- renderText({
#' c_val()
#' })
#'
#' ### start server module
#' reactlog_module_server()
#' ### end server module
#'
#' }
#'
#' if (interactive()) {
#' shinyApp(ui = ui, server = server)
#' }
reactlog_module_ui <- function(include_refresh = TRUE, id = "reactlog_module") {
ns <- shiny::NS(id)
shiny::tagList(
if (isTRUE(include_refresh))
shiny::actionButton(
ns("refresh"),
"",
icon = shiny::icon("arrows-rotate", lib = "font-awesome"),
class = "btn-sm btn-warning"
),
shiny::uiOutput(ns("iframe"))
)
}
#' @rdname reactlog_module
#' @export
reactlog_module_server <- function(
id = "reactlog_module",
width = "100%",
height = 600,
...
) {
assert_shiny_version()
shiny::moduleServer(
id,
function(input, output, session) {
ns <- shiny::NS(id)
output$iframe <- shiny::renderUI({
# trigger render refresh
input$refresh
test_mode_txt <-
if (isTRUE(getOption("shiny.testmode"))) {
"&test=1"
} else {
""
}
random_id <- ns(paste0(
"reactlog_iframe_",
as.hexmode(floor(stats::runif(1, 1, 16^7)))
))
htmltools::tagList(
htmltools::tags$iframe(
id = random_id,
width = width,
height = height,
...
),
htmltools::tags$script(htmltools::HTML(paste0("
(function() {
var src =
'reactlog?w=' + window.escape(window.Shiny.shinyapp.config.workerId) +
'&s=' + window.escape(window.Shiny.shinyapp.config.sessionId) + '",
test_mode_txt, "';
$('#", random_id, "').attr('src', src);
})()
")))
)
})
}
)
}
shiny_version_required <- function() {
desc_file <- system.file("DESCRIPTION", package = "reactlog")
suggests <- read.dcf(desc_file)[1, "Suggests"]
pkgs <- strsplit(suggests, ",")[[1]]
shiny_version <- gsub("[^.0-9]", "", pkgs[grepl("^shiny ", pkgs)])
package_version(shiny_version)
}
test_shiny_version <- function() {
tryCatch({
utils::packageVersion("shiny") >= shiny_version_required()
}, error = function() {
# package not found
FALSE
})
}
assert_shiny_version <- function() {
if (!test_shiny_version()) {
stop("`shiny` v", shiny_version_required, " or greater must be installed")
}
}