# Provide exercise feedback
feedback <- function(message, correct, type, location) {
feedback_validated(list(
message = message,
correct = correct,
type = type,
location = location
))
}
# return feedback if it's valid (with defaults), otherwise throw an error
feedback_validated <- function(feedback) {
if (!length(feedback)) {
return(feedback)
}
if (!(is.list(feedback) && all(c("message", "correct") %in% names(feedback)))) {
stop("Feedback must be a list with 'message' and 'correct' fields", call. = FALSE)
}
if (!(is.character(feedback$message) || inherits(feedback$message, c("shiny.tag", "shiny.tag.list")))) {
stop("The 'message' field of feedback must be a character vector or an htmltools tag or tagList", call. = FALSE)
}
if (!is.logical(feedback$correct)) {
stop("The 'correct' field of feedback must be a logical (i.e., boolean) value", call. = FALSE)
}
# Fill in type/location defaults and check their value
feedback$type <- feedback$type[1] %||% "auto"
feedback$location <- feedback$location[1] %||% "append"
feedback_types <- c("auto", "success", "info", "warning", "error", "custom")
if (!feedback$type %in% feedback_types) {
stop("Feedback 'type' field must be one of these values: ",
paste(feedback_types, collapse = ", "), call. = FALSE)
}
feedback_locations <- c("append", "prepend", "replace")
if (!feedback$location %in% feedback_locations) {
stop("Feedback 'location' field must be one of these values: ",
paste(feedback_locations, collapse = ", "), call. = FALSE)
}
if (feedback$type %in% "auto") {
feedback$type <- if (feedback$correct) "success" else "error"
}
feedback
}
feedback_as_html <- function(feedback) {
if (!length(feedback)) {
return(feedback)
}
feedback <- feedback_validated(feedback)
if (feedback$type %in% "custom") {
return(div(feedback$message))
}
if (feedback$type %in% "error") {
feedback$type <- "danger"
}
if (feedback$type %in% c("success", "info", "warning", "danger")) {
return(div(
role = "alert",
class = paste0("alert alert-", feedback$type),
feedback$message
))
}
stop("Invalid message type specified.", call. = FALSE)
}
# helper function to create tags for error message
error_message_html <- function(message, style = "code") {
switch(
style,
alert = div(class = "alert alert-danger", role = "alert", message),
code = ,
pre(
code(class = "text-danger", message, .noWS = c("before", "after")),
.noWS = c("before", "after")
)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.