-
Notifications
You must be signed in to change notification settings - Fork 2
/
preview-tools.R
109 lines (91 loc) · 3.04 KB
/
preview-tools.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
### tools to help users preview their quizzes ###
# shiny preview -----------------------------------------------------------
#' Tools for previewing quizzes
#'
#' Launch a viewer to preview the structure of the questions in a quiz.
#'
#' @param quiz an object of class 'quiz' to preview
#' @param launch_browser launch in a web browser?
#'
#' @return Called for side effect
#' @export
#' @author Joseph Marlo
#'
#' @examplesIf interactive()
#' quiz <- create_quiz(
#' create_question(
#' 'Lorem ipsum dolor sit amet, consectetur adipiscing elit. Select nulla.',
#' add_choice('auctor'),
#' add_choice('nulla', correct = TRUE)
#' ),
#' create_question(
#' 'Mauris congue aliquet dui, ut dapibus lorem porttitor sed. Select 600.',
#' add_choice('600', correct = TRUE),
#' add_choice('800')
#' )
#' )
#' preview_app(quiz)
#' @describeIn preview_app Preview a quiz with full operability
preview_app <- function(quiz, launch_browser = TRUE){
verify_quiz_structure(quiz)
ui <- shiny::fluidPage(
htmltools::div(
style = "max-width: 700px",
quiz_ui(quiz),
htmltools::br(),
shiny::checkboxInput('show', 'Show output'),
shiny::conditionalPanel("input.show == true", shiny::verbatimTextOutput('quizSummary'))
)
)
server <- function(input, output, session) {
# run the quiz
quiz_summary <- quiz_server(quiz)
# display the available output
output$quizSummary <- shiny::renderPrint(quiz_summary())
}
shiny::shinyApp(ui, server, options = list(launch.browser = !isFALSE(launch_browser)))
}
# html preview ------------------------------------------------------------
# these are used the print methods
#' @noRd
#' @keywords internal
#' @describeIn preview_app Quick preview a quiz
preview_quiz <- function(quiz, launch_browser = FALSE){
verify_quiz_structure(quiz)
viewer <- ifelse(
isTRUE(launch_browser),
getOption("browser", utils::browseURL),
getOption("viewer", utils::browseURL)
)
panels <- shiny::fluidPage(
base::do.call(
shiny::tabsetPanel,
c(id = 't',
purrr::map2(quiz@questions, seq_along(quiz@questions), function(q, i) {
shiny::tabPanel(
title = glue::glue('Question {i}'),
q@prompt
)
})
)
)
)
htmltools::html_print(panels, viewer = viewer)
cli::cli_alert_warning('Some items like `shiny::renderPlot` may not show correctly in the viewer')
return(invisible(panels))
}
#' @param question an object of class 'quizQuestion' to preview
#' @noRd
#' @keywords internal
#' @describeIn preview_app Quick preview a single question
preview_question <- function(question, launch_browser = FALSE){
verify_question_structure(question)
viewer <- ifelse(
isTRUE(launch_browser),
getOption("browser", utils::browseURL),
getOption("viewer", utils::browseURL)
)
htmltools::html_print(question@prompt, viewer = viewer)
cli::cli_alert_warning('Some items like sliders may not show correctly in the viewer')
return(invisible(question@prompt))
}