Display multiple examples in dashboard (#185)

* feat: add all examples to dashboard * feat: break blocks of descriptions into paragraphs * refactor: live example cards * fix: E2E dashboard test --------- Co-authored-by: Jakub Sobolewski <[email protected]>
Appsilon · Jun 30, 2023 · d3e3bb9 · d3e3bb9
1 parent 96d2e9f
commit d3e3bb9
Show file tree

Hide file tree

Showing 6 changed files with 58 additions and 36 deletions.
diff --git a/inst/examples/DetailsList3.R b/inst/examples/DetailsList3.R
@@ -8,7 +8,7 @@ CustomComponents <- tags$script(HTML("(function() {
   const React = jsmodule['react'];
   const Fluent = jsmodule['@fluentui/react'];
   const Shiny = jsmodule['@/shiny'];
-  const CustomComponents = jsmodule['CustomComponents'] = {};
+  const CustomComponents = jsmodule['CustomComponents'] ??= {};
 
   function useSelection(inputId) {
     const selection = React.useRef(new Fluent.Selection({

diff --git a/inst/examples/TextField2.R b/inst/examples/TextField2.R
@@ -7,7 +7,7 @@ library(shiny.fluent)
 CustomComponents <- tags$script(HTML("(function() {
   const { InputAdapter } = jsmodule['@/shiny.react'];
   const { TextField } = jsmodule['@fluentui/react'];
-  const CustomComponents = jsmodule['CustomComponents'] = {};
+  const CustomComponents = jsmodule['CustomComponents'] ??= {};
 
   CustomComponents.UpperCaseTextField = InputAdapter(TextField, (value, setValue) => ({
     value: value.toUpperCase(),

diff --git a/inst/examples/dashboard/app.R b/inst/examples/dashboard/app.R
@@ -22,7 +22,7 @@ router_page_elements <- append(
     route("/", homePage),
     route("about", aboutPage)
   ),
-  map(examples_routes, "router")
+  map(examples_routes, "route")
 )
 
 router_page <- do.call(router_ui, router_page_elements)
@@ -64,13 +64,10 @@ sass(
 
 server <- function(input, output, session) {
   router_server()
-  example_servers <- unlist(map(examples_routes, "server"))
-  lapply(
-    examples,
-    function(item, modules = example_servers) {
-      modules[[item]](item)
-    }
-  )
+  examples_routes %>%
+    map("servers") %>%
+    flatten() %>%
+    iwalk(function(server, id) server(id))
 }
 
 shinyApp(ui, server)
diff --git a/inst/examples/dashboard/examples.R b/inst/examples/dashboard/examples.R
@@ -92,35 +92,58 @@ readExample <- function(path) {
   list(code = code, ui = module$ui, server = module$server)
 }
 
-makeExamplePage <- function(name, ui, code) {
+#' Splits `text` into paragraphs.
+makeText <- function(text) {
+  strsplit(text, "\\n\\n")[[1]] %>%
+    map(Text) %>%
+    Stack(tokens = list(childrenGap = 10))
+}
+
+makeExamplePage <- function(name, example) {
   help <- getHelpList(name)
   makePage(
     name,
     "Fluent UI component",
     div(
-      makeCard("Description", Text(nowrap = FALSE, help$description)),
+      makeCard("Description", makeText(help$description)),
       makeCard("Usage", pre(help$usage)),
-      makeCard("Live example", div(style = "padding: 20px", ui)),
-      makeCard("Live example code", pre(code))
+      imap(example, makeLiveExamplePage)
+    )
+  )
+}
+
+makeLiveExamplePage <- function(example, id) {
+  makeCard(
+    title = Text("Live example", variant = "large"),
+    content = div(
+      id = id,
+      example$ui(id),
+      Separator(),
+      pre(example$code)
     )
   )
 }
 
 makeExampleRoute <- function(name) {
-  path <- system.file(file.path("examples", paste0(name, ".R")), package = "shiny.fluent")
-  example <- readExample(path)
-  example_server <- list()
-  example_server[[name]] <- example$server
-  return(
-    list(
-      server = example_server,
-      router = route(
-        path = name,
-        ui = makeExamplePage(
-          name = name,
-          ui = example$ui(name),
-          code = example$code
-        )
+  examples_files <- list.files(
+    system.file("examples", package = "shiny.fluent"),
+    full.names = TRUE
+  )
+  # Match on component names with optional digits at the end
+  pattern <- paste0("^", name, "[0-9]*.R")
+  path <- examples_files[grepl(pattern, basename(examples_files))]
+  examples_names  <- tools::file_path_sans_ext(basename(path))
+  example <- path %>%
+    map(readExample) %>%
+    set_names(examples_names)
+
+  list(
+    servers = map(example, "server"),
+    route = route(
+      path = name,
+      ui = makeExamplePage(
+        name = name,
+        example = example
       )
     )
   )

diff --git a/inst/examples/dashboard/utils.R b/inst/examples/dashboard/utils.R
@@ -10,10 +10,12 @@ makePage <- function (title, subtitle, contents) {
 }
 
 makeCard <- function(title, content) {
-  div(class = "card ms-depth-8",
-      Stack(
-        tokens = list(childrenGap = 5),
-        Text(variant = "large", title, block = TRUE),
-        content
-      ))
+  div(
+    class = "card ms-depth-8",
+    Text(variant = "large", title, block = TRUE),
+    div(
+      style = "margin-top: 10px;",
+      content
+    )
+  )
 }
diff --git a/js/cypress/integration/dashboard/dashboard.cy.js b/js/cypress/integration/dashboard/dashboard.cy.js
@@ -3,14 +3,14 @@ describe('Dashboard', () => {
     cy.visit('http://localhost:8889/#!/Slider');
     const steps = 15;
     const arrows = '{rightarrow}'.repeat(steps);
-    cy.get('.ms-Slider-slideBox')
+    cy.get('#Slider .ms-Slider-slideBox')
       .focus()
       .type(arrows);
     cy.contains('Value: 15');
   });
   it('Dropdown', () => {
     cy.visit('http://localhost:8889/#!/Dropdown');
-    cy.get('.ms-Dropdown-title').click();
+    cy.get('#Dropdown .ms-Dropdown-title').click();
     cy.get('.ms-Dropdown-item').contains('Option C').click();
     cy.contains('Value: C');
   });