More internationalization

NEWS.md

@@ -18,6 +18,7 @@ learnr (development version)
 * Added an event handler system, with the functions `event_register_handler()` and `one_time()`. There is also a new event `"section_viewed"`, which is triggered when a new section becomes visible. ([#398](https://github.com/rstudio/learnr/pull/398))
 * Previously, when a question submission was reset, it would be recorded as a `"question_submission"` event with the value `reset=TRUE`. Now it a separate event, `"reset_question_submission"`. ([#398](https://github.com/rstudio/learnr/pull/398))
 * Added a new `polyglot` tutorial to learnr. This tutorial displays mixing R, python, and sql exercises. See [`run_tutorial("polyglot", "learnr")`](https://learnr-examples.shinyapps.io/polyglot) for a an example. ([#397](https://github.com/rstudio/learnr/pull/397))
+* Text throughout the learnr interface can be customized or localized using the new `language` argument of `tutorial()`. Translations for English and French are provided and contributes will be welcomed. Read more about these features in `vignette("multilang", package = "learnr")`. ([#456](https://github.com/rstudio/learnr/pull/456))
 
 ## Minor new features and improvements
 

R/html-dependencies.R

@@ -83,3 +83,20 @@ ace_html_dependency <- function() {
     script = "ace.js"
   )
 }
+
+tutorial_i18n_html_dependency <- function(language = NULL) {
+  htmltools::htmlDependency(
+    name = "i18n",
+    version = "1.2.0",
+    src = system.file("lib/i18n", package = "learnr"),
+    script = c("i18next.min.js", "jquery-i18next.min.js", "tutorial-i18n-init.js"),
+    head = format(htmltools::tags$script(
+      id = "i18n-cstm-trns",
+      type = "application/json",
+      jsonlite::toJSON(
+        i18n_process_language_options(language),
+        auto_unbox = TRUE
+      )
+    ))
+  )
+}

R/i18n.R

@@ -0,0 +1,194 @@
+i18n_process_language_options <- function(language = NULL) {
+  # Take the language entry from the tutorial options or YAML header and process
+  # into the list of resources used when initializing the i18next translations
+
+  is_path_json <- function(x) {
+    checkmate::test_string(
+      x,
+      na.ok = FALSE,
+      null.ok = FALSE,
+      pattern = "[.]json$",
+      ignore.case = TRUE
+    )
+  }
+
+  if (is_path_json(language)) {
+    language <- i18n_read_json(language)
+  }
+
+  custom <- list()
+  if (is.null(language) || (is.character(language) && length(language) == 1)) {
+    ## language: en
+    ## language: fr
+    default <- if (!is.null(language)) language else "en"
+  } else {
+    ## language
+    ##   en:
+    ##     button:
+    ##       continue: Got it!
+    ##   es:
+    ##     button:
+    ##       continue: Continuar
+    ##   fr: learnr.fr.json
+
+    if (!is.list(language) || is.null(names(language))) {
+      stop(
+        "`language` must be a single character language code or ",
+        "a named list of customizations indexed by language code ",
+        'as described in `vignette("multilang", package = "learnr")`',
+        call. = FALSE
+      )
+    }
+
+    # the first language in this format is the default language
+    default <- names(language)[1]
+
+    for (lng in names(language)) {
+      if (is_path_json(language[[lng]])) {
+        language[[lng]] <- i18n_read_json(language[[lng]])
+      }
+
+      language[[lng]] <- i18n_validate_customization(language[[lng]])
+
+      if (is.null(language[[lng]])) next
+      custom[[lng]] <- list(custom = language[[lng]])
+    }
+  }
+
+  # Get default translations and then merge in customizations
+  translations <- i18n_translations()
+  if (length(custom) > 0) {
+    for (lang in union(names(translations), names(custom))) {
+      translations[[lang]] <- c(translations[[lang]], custom[[lang]])
+    }
+  }
+
+  list(language = default, resources = translations)
+}
+
+i18n_read_json <- function(path) {
+  tryCatch(
+    jsonlite::read_json(path, simplifyDataFrame = FALSE, simplifyMatrix = FALSE),
+    error = function(e) {
+      message("Unable to read custom language JSON file at: ", path)
+      NULL
+    }
+  )
+}
+
+i18n_validate_customization <- function(lng) {
+  if (is.null(lng)) {
+    # NULL language items are okay, esp as the first lang (default)
+    return(NULL)
+  }
+
+  # returns a valid language customization or NULL
+  # always throws warnings, not errors
+  default <- i18n_translations()$en$translation
+  group_keys <- names(default)
+
+  if (!is.list(lng) || is.null(names(lng))) {
+    warning(
+      "Custom languages must be lists with entries: ",
+      paste(group_keys, collapse = ", "),
+      immediate. = TRUE
+    )
+    return(NULL)
+  }
+
+  # Let extra keys through for custom components but warn in case accidental
+  extra_group_keys <- setdiff(names(lng), group_keys)
+  if (length(extra_group_keys)) {
+    warning(
+      "Ignoring extra customization groups ", paste(extra_group_keys, collapse = ", "),
+      immediate. = TRUE
+    )
+  }
+
+  for (group in intersect(names(lng), group_keys)) {
+    extra_keys <- setdiff(names(lng[[group]]), names(default[[group]]))
+    if (length(extra_keys)) {
+      warning(
+        "Ignoring extra ", group, " language customizations: ",
+        paste(extra_keys, collapse = ", "),
+        immediate. = TRUE
+      )
+    }
+  }
+
+  lng
+}
+
+i18n_translations <- function() {
+  list(
+    en = list(
+      translation = list(
+        button = list(
+          runcode = "Run Code",
+          hints = "Hints",
+          startover = "Start Over",
+          continue = "Continue",
+          submitanswer = "Submit Answer",
+          previoustopic = "Previous Topic",
+          nexttopic = "Next Topic",
+          questionsubmit = "Submit Answer",
+          questiontryagain = "Try Again"
+        ),
+        text = list(
+          startover = "Start Over",
+          areyousure = "Are you sure you want to start over? (all exercise progress will be reset)",
+          youmustcomplete = "You must complete the",
+          exercise = "exercise",
+          exercise_plural = "exercises",
+          inthissection = "in this section before continuing."
+        )
+      )
+    ),
+    fr = list(
+      translation = list(
+        button = list(
+          runcode = "Lancer le Code",
+          hints = "Indice",
+          startover = "Recommencer",
+          continue = "Continuer",
+          submitanswer = "Soumettre",
+          previoustopic = "Chapitre Pr\u00e9c\u00e9dent",
+          nexttopic = "Chapitre Suivant",
+          questionsubmit = "Soumettre",
+          questiontryagain = "R\u00e9essayer"
+        ),
+        text = list(
+          startover = "Recommencer",
+          areyousure = "\u00cates-vous certains de vouloir recommencer? (La progression sera remise \u00e0 z\u00e9ro)",
+          youmustcomplete = "Vous devez d'abord compl\u00e9ter",
+          inthissection = "de cette section avec de continuer.",
+          exercise = "l'exercice",
+          exercise_plural = "des exercices"
+        )
+      )
+    ),
+    emo = list(
+      translation = list(
+        button = list(
+          runcode = "\U0001f3c3",
+          hints = "\U0001f50e",
+          startover = "\u23ee",
+          continue = "\u2705",
+          submitanswer = "\U0001f197",
+          previoustopic = "\u2b05",
+          nexttopic = "\u27a1",
+          questionsubmit = "\U0001f197",
+          questiontryagain = "\U0001f501"
+        ),
+        text = list(
+          startover = "\u23ee",
+          areyousure = "\U0001f914",
+          youmustcomplete = "\u26a0 \U0001f449",
+          exercise = "",
+          exercise_plural = "",
+          inthissection = "."
+        )
+      )
+    )
+  )
+}

R/quiz.R

@@ -556,34 +556,50 @@ question_module_server_impl <- function(
 
 question_button_label <- function(question, label_type = "submit", is_valid = TRUE) {
   label_type <- match.arg(label_type, c("submit", "try_again", "correct", "incorrect"))
+
+  if (label_type %in% c("correct", "incorrect")) {
+    # No button when answer is correct or incorrect (wrong without try again)
+    return(NULL)
+  }
+
   button_label <- question$button_labels[[label_type]]
   is_valid <- isTRUE(is_valid)
 
+  # We don't want to localize button labels that were customized by the user
+  # If they're default labels, we'll add the `data-i18n` attribute for localization
+  default_label <- eval(formals("question")[[paste0(label_type, "_button")]])
+  # At this point, `button_label` has been upgraded to HTML. 
+  # Need to format() for a fair comparison
+  is_default_label <- identical(format(button_label), default_label)
+
   default_class <- "btn-primary"
   warning_class <- "btn-warning"
 
   action_button_id <- NS(question$ids$question)("action_button")
 
   if (label_type == "submit") {
-    button <- actionButton(action_button_id, button_label, class = default_class)
+    button <- actionButton(
+      action_button_id, button_label,
+      class = default_class,
+      `data-i18n` = if (is_default_label) "button.questionsubmit"
+    )
     if (!is_valid) {
       button <- disable_all_tags(button)
     }
     button
   } else if (label_type == "try_again") {
     mutate_tags(
-      actionButton(action_button_id, button_label, class = warning_class),
+      actionButton(
+        action_button_id, button_label,
+        class = warning_class,
+        `data-i18n` = if (is_default_label) "button.questiontryagain"
+      ),
       paste0("#", action_button_id),
       function(ele) {
         ele$attribs$class <- str_remove(ele$attribs$class, "\\s+btn-default")
         ele
       }
     )
-  } else if (
-    label_type == "correct" ||
-    label_type == "incorrect"
-  ) {
-    NULL
   }
 }
 

R/tutorial-format.R

@@ -24,6 +24,9 @@
 #'        \code{---} to em-dashes, \code{--} to en-dashes, and \code{...} to ellipses.
 #'        Deprecated in \pkg{rmarkdown} v2.2.0.
 #' @param ... Forward parameters to html_document
+#' @param language Language or custom text of the UI elements. See
+#'        `vignette("multilang", package = "learnr")` for more information
+#'        about available options and formatting
 #'
 #' @export
 #' @importFrom utils getFromNamespace
@@ -45,6 +48,7 @@ tutorial <- function(fig_width = 6.5,
                      includes = NULL,
                      md_extensions = NULL,
                      pandoc_args = NULL,
+                     language = "en",
                      ...) {
 
   # base pandoc options
@@ -103,6 +107,7 @@ tutorial <- function(fig_width = 6.5,
     tutorial_html_dependency(),
     tutorial_autocompletion_html_dependency(),
     tutorial_diagnostics_html_dependency(),
+    tutorial_i18n_html_dependency(language),
     htmltools::htmlDependency(
       name = "tutorial-format",
       version = utils::packageVersion("learnr"),