Allow feedback messages to be an htmltools tag or tagList

NEWS.md

@@ -31,6 +31,7 @@ learnr (development version)
 * `exercise.cap` now accepts HTML input. If no `exercise.cap` is provided, an icon of the exercise engine will be displayed. If no icon is known, the `exercise.cap` will default to the combination of the exercise engine and `" code"`. ([#397](https://github.com/rstudio/learnr/pull/397), [#429](https://github.com/rstudio/learnr/pull/429))
 * `engine` is now passed to the `exercise.checker` to help distinguish what language is being checked in the exercise. ([#397](https://github.com/rstudio/learnr/pull/397))
 * Hitting the `TAB` key in an exercise has always opened the auto-completion drop down. Now, hitting the `TAB` key will also complete the currently selected code completion. ([#428](https://github.com/rstudio/learnr/pull/428))
+* Feedback messages can now be an htmltools tag or tagList, or a character message ([#458](https://github.com/rstudio/learnr/pull/458))
 
 ## Bug fixes
 

R/feedback.R

@@ -16,8 +16,8 @@ feedback_validated <- function(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)) {
-    stop("The 'message' field of feedback must be a character vector", 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)

tests/testthat/test-feedback.R

@@ -0,0 +1,40 @@
+fdbck <- function(message = "a", correct = TRUE, type = NULL, location = NULL) {
+  feedback(message, correct, type, location)
+}
+
+test_that("feedback_validated() doesn't validate length-0 objects", {
+  expect_null(feedback_validated(NULL))
+  expect_equal(feedback_validated(list()), list())
+})
+
+test_that("feedback must be a list with $message and $correct", {
+  expect_error(feedback_validated("no"), "must be a list")
+  expect_error(feedback_validated(list(correct = FALSE)), "message")
+  expect_error(feedback_validated(list(message = "foo")), "correct")
+})
+
+test_that("feedback message must be character or tag or tagList", {
+  expect_error(feedback_validated(fdbck(list())), "character")
+  expect_error(feedback_validated(fdbck(2)), "character")
+  expect_error(feedback_validated(fdbck(list(a = 1, b = 2))), "character")
+
+  expect_silent(feedback_validated(fdbck("good")))
+  expect_silent(feedback_validated(fdbck(htmltools::HTML("good"))))
+  expect_silent(feedback_validated(fdbck(htmltools::p("good"))))
+  expect_silent(feedback_validated(fdbck(htmltools::tagList(htmltools::p("good")))))
+})
+
+test_that("feedback type must be one of the acceptable values", {
+  expect_error(feedback_validated(fdbck(type = "--bad--")), "type")
+
+  expect_equal(feedback_validated(fdbck(correct = TRUE))$type, "success")
+  expect_equal(feedback_validated(fdbck(correct = FALSE))$type, "error")
+  expect_equal(feedback_validated(fdbck(type = c("info", "error")))$type, "info")
+})
+
+test_that("feedback location must be one of the acceptable values", {
+  expect_error(feedback_validated(fdbck(location = "--bad--")), "location")
+
+  expect_equal(feedback_validated(fdbck())$location, "append")
+  expect_equal(feedback_validated(fdbck(location = c("replace", "prepend")))$location, "replace")
+})