Move help section out of shiny module

Can't interact with global app elements from within a module

R/help_ui.R

@@ -0,0 +1,40 @@
+#' Generates Help Tab UI
+#'
+#' @param cheatsheet_only If TRUE then returns just basic regex
+#'   explainer UI.
+#' @keywords internal
+generate_help_ui <- function(cheatsheet_only = TRUE) {
+  miniUI::miniContentPanel(
+    shiny::fillRow(
+      flex = c(1, 4),
+      shiny::tagList(
+        shiny::tags$ul(
+          id = "help-sidebar",
+          if (!cheatsheet_only) tags$li(
+            shiny::actionLink("help_try_this", "Try This")
+          ),
+          shiny::tags$li("Character Classes", class = "header"),
+          shiny::tags$ul(
+            class = "subgroup",
+            shiny::tags$li(shiny::actionLink("help_cat_character_classes_regular", "Regular")),
+            shiny::tags$li(shiny::actionLink("help_cat_character_classes_prebuilt", "Pre-Built"))
+          ),
+          shiny::tags$li(shiny::actionLink("help_cat_anchors", "Anchors")),
+          shiny::tags$li("Escaped Characters", class = "header"),
+          shiny::tags$ul(
+            class = "subgroup",
+            shiny::tags$li(shiny::actionLink("help_cat_escaped_general", "General")),
+            shiny::tags$li(shiny::actionLink("help_cat_escaped_hex", "Hex")),
+            shiny::tags$li(shiny::actionLink("help_cat_escaped_control", "Control Characters"))
+          ),
+          shiny::tags$li(shiny::actionLink("help_cat_groups", "Groups")),
+          shiny::tags$li(shiny::actionLink("help_cat_quantifiers", "Quantifiers"))
+        )
+      ),
+      shiny::tags$div(
+        style = "width: 100%; padding-left: 10px;",
+        shiny::uiOutput('help_text_selected')
+      )
+    )
+  )
+}

R/regex_gadget.R

@@ -111,7 +111,7 @@ regex_gadget <- function(text = NULL,
       # ---- UI - Tab - Help ----
       miniTabPanel(
         "Help", icon = icon("support"),
-        help_ui("help")
+        generate_help_ui(cheatsheet_only = FALSE)
       )
     )
   )
@@ -290,7 +290,67 @@ regex_gadget <- function(text = NULL,
     })
 
     # ---- Server - Tab - Help ----
-    help_text <- callModule(help_server, "help")
+    source(system.file("shiny", "help_server.R", package = "regexplain"), local = TRUE)
+
+    observeEvent(input$help_try_this, {
+      tagList(
+        tags$p("Try these examples."),
+        tags$h4("Parse Github Repos"),
+        tags$p("Click",
+               actionLink("help_try_this_github", "this link"),
+               "to try out the GitHub repo regex challenge."
+        ),
+        tags$h4("CSS Unit Validation"),
+        tags$p("CSS units can be integer or decimal numbers with units such as",
+               "in, cm, mm, em, ex, pt, px, etc.",
+               "Try to determine if", actionLink("help_try_this_css_text", "these units"),
+               "are", actionLink("help_try_this_css_pattern", "are valid."))
+      ) %>%
+        as.character() %>%
+        help_text()
+    })
+
+    observeEvent(input$help_try_this_github, {
+      github_repos <- c(
+        "metacran/crandb",
+        "jeroenooms/curl@v0.9.3",
+        "jimhester/covr#47",
+        "hadley/dplyr@*release",
+        "r-lib/remotes@550a3c7d3f9e1493a2ba"
+      )
+      owner_rx   <- "(?:(?<owner>[^/]+)/)?"
+      repo_rx    <- "(?<repo>[^/@#]+)"
+      subdir_rx  <- "(?:/(?<subdir>[^@#]*[^@#/]))?"
+      ref_rx     <- "(?:@(?<ref>[^*].*))"
+      pull_rx    <- "(?:#(?<pull>[0-9]+))"
+      release_rx <- "(?:@(?<release>[*]release))"
+
+      subtype_rx <- sprintf("(?:%s|%s|%s)?", ref_rx, pull_rx, release_rx)
+      github_rx  <- sprintf(
+        "^(?:%s%s%s%s|(?<catchall>.*))$",
+        owner_rx, repo_rx, subdir_rx, subtype_rx
+      )
+
+      updateTextAreaInput(session, "text", value = paste(github_repos, collapse = "\n"))
+      updateTextInput(session, 'pattern', value = github_rx)
+      updateCheckboxGroupInput(session, "regex_options", selected = c('text_break_lines', 'perl'))
+      showNotification("Example Loaded! Go to RegEx Tab", type = 'message')
+    })
+
+    observeEvent(input$help_try_this_css_text, {
+      css_units <- c(
+        "125%","16pt","2cm","7em","3ex","24pt",
+        ".15in","20pc","5.9vw","3.0vh","2vmin"
+      )
+      updateTextAreaInput(session, "text", value = paste(css_units, collapse = "\n"))
+    })
+
+    observeEvent(input$help_try_this_css_pattern, {
+      pattern <- "^(auto|inherit|((\\.\\d+)|(\\d+(\\.\\d+)?))(%|in|cm|mm|em|ex|pt|pc|px|vh|vw|vmin|vmax))$"
+      updateTextInput(session, "pattern", value = pattern)
+      updateCheckboxGroupInput(session, 'regex_options', selected = c('text_break_lines', 'perl'))
+      showNotification("Pattern loaded! Go to RegEx tab", type = "message")
+    })
 
     # ---- Server - Tab - Exit ----
     observeEvent(input$done, {

R/regex_help.R

@@ -12,11 +12,11 @@ regexplain_cheatsheet <- function() {
       "Regex Cheatsheet Quick Reference",
       right = miniTitleBarButton("done", "OK", TRUE)
     ),
-    help_ui("help")
+    generate_help_ui(cheatsheet_only = TRUE)
   )
 
   server <- function(input, output, session) {
-    help_text <- callModule(help_server, "help")
+    source(system.file("shiny/help_server.R", package = "regexplain"), local = TRUE)
     observeEvent(input$done, {
       stopApp()
     })
@@ -28,113 +28,3 @@ regexplain_cheatsheet <- function() {
   viewer <- shiny::paneViewer(700)
   runGadget(ui, server, viewer = viewer)
 }
-
-# ---- Help - Shiny Module ----
-
-help_ui <- function(id) {
-  ns <- NS(id)
-
-  miniContentPanel(
-    fillRow(
-      flex = c(1, 4),
-      tagList(
-        tags$ul(
-          id = "help-sidebar",
-          tags$li("Character Classes", class = "header"),
-          tags$ul(
-            class = "subgroup",
-            tags$li(actionLink(ns("help_cat_character_classes_regular"), "Regular")),
-            tags$li(actionLink(ns("help_cat_character_classes_prebuilt"), "Pre-Built"))
-          ),
-          tags$li(actionLink(ns("help_cat_anchors"), "Anchors")),
-          tags$li("Escaped Characters", class = "header"),
-          tags$ul(
-            class = "subgroup",
-            tags$li(actionLink(ns("help_cat_escaped_general"), "General")),
-            tags$li(actionLink(ns("help_cat_escaped_hex"), "Hex")),
-            tags$li(actionLink(ns("help_cat_escaped_control"), "Control Characters"))
-          ),
-          tags$li(actionLink(ns("help_cat_groups"), "Groups")),
-          tags$li(actionLink(ns("help_cat_quantifiers"), "Quantifiers"))
-        )
-      ),
-      tags$div(
-        style = "width: 100%; padding-left: 10px;",
-        uiOutput(ns('help_text_selected'))
-      )
-    )
-  )
-}
-
-#' @importFrom rlang .data
-help_server <- function(input, output, session) {
-  help_text <- reactiveVal("<p>Select a category from the left sidebar.</p>")
-
-  make_html_table <- function(x) {
-    select(x, .data$regexp, .data$text) %>%
-      knitr::kable(
-        col.names = c("Regexp", "Text"),
-        escape = FALSE,
-        format = "html")
-  }
-
-  output$help_text_selected <- renderUI({
-    HTML(help_text())
-  })
-
-  observeEvent(input$help_cat_character_classes_regular, {
-    cheatsheet %>%
-      filter(.data$category == "character classes", .data$group == "regular") %>%
-      make_html_table() %>%
-      help_text()
-  })
-
-  observeEvent(input$help_cat_character_classes_prebuilt, {
-    cheatsheet %>%
-      filter(.data$category == "character classes", .data$group == "pre-built") %>%
-      make_html_table() %>%
-      help_text()
-  })
-
-  observeEvent(input$help_cat_anchors, {
-    cheatsheet %>%
-      filter(.data$category == "anchors") %>%
-      make_html_table() %>%
-      help_text()
-  })
-
-  observeEvent(input$help_cat_escaped_general, {
-    cheatsheet %>%
-      filter(.data$category == "escaped characters", .data$group == "general") %>%
-      make_html_table() %>%
-      help_text()
-  })
-
-  observeEvent(input$help_cat_escaped_hex, {
-    cheatsheet %>%
-      filter(.data$category == "escaped characters", .data$group == "hex") %>%
-      make_html_table() %>%
-      help_text()
-  })
-
-  observeEvent(input$help_cat_escaped_control, {
-    cheatsheet %>%
-      filter(.data$category == "escaped characters", .data$group == "control characters") %>%
-      make_html_table() %>%
-      help_text()
-  })
-
-  observeEvent(input$help_cat_groups, {
-    cheatsheet %>%
-      filter(.data$category == "groups") %>%
-      make_html_table() %>%
-      help_text()
-  })
-
-  observeEvent(input$help_cat_quantifiers, {
-    cheatsheet %>%
-      filter(.data$category == "quantifiers") %>%
-      make_html_table() %>%
-      help_text()
-  })
-}

inst/shiny/help_server.R

@@ -0,0 +1,75 @@
+HELP_DEFAULT_TEXT <- "<p>Select a category from the left sidebar.</p>"
+
+help_text <- reactiveVal(HELP_DEFAULT_TEXT)
+
+make_html_table <- function(x) {
+  select(x, .data$regexp, .data$text) %>%
+    knitr::kable(
+      col.names = c("Regexp", "Text"),
+      escape = FALSE,
+      format = "html")
+}
+
+output$help_text_selected <- renderUI({
+  help_body <- help_text()
+  if (inherits(help_body, "shiny.tag.list")) {
+    help_body
+  } else HTML(help_body)
+})
+
+observeEvent(input$help_cat_character_classes_regular, {
+  cheatsheet %>%
+    filter(.data$category == "character classes", .data$group == "regular") %>%
+    make_html_table() %>%
+    help_text()
+})
+
+observeEvent(input$help_cat_character_classes_prebuilt, {
+  cheatsheet %>%
+    filter(.data$category == "character classes", .data$group == "pre-built") %>%
+    make_html_table() %>%
+    help_text()
+})
+
+observeEvent(input$help_cat_anchors, {
+  cheatsheet %>%
+    filter(.data$category == "anchors") %>%
+    make_html_table() %>%
+    help_text()
+})
+
+observeEvent(input$help_cat_escaped_general, {
+  cheatsheet %>%
+    filter(.data$category == "escaped characters", .data$group == "general") %>%
+    make_html_table() %>%
+    help_text()
+})
+
+observeEvent(input$help_cat_escaped_hex, {
+  cheatsheet %>%
+    filter(.data$category == "escaped characters", .data$group == "hex") %>%
+    make_html_table() %>%
+    help_text()
+})
+
+observeEvent(input$help_cat_escaped_control, {
+  cheatsheet %>%
+    filter(.data$category == "escaped characters", .data$group == "control characters") %>%
+    make_html_table() %>%
+    help_text()
+})
+
+observeEvent(input$help_cat_groups, {
+  cheatsheet %>%
+    filter(.data$category == "groups") %>%
+    make_html_table() %>%
+    help_text()
+})
+
+observeEvent(input$help_cat_quantifiers, {
+  cheatsheet %>%
+    filter(.data$category == "quantifiers") %>%
+    make_html_table() %>%
+    help_text()
+})
+