Merge pull request #22 from Appsilon/showcase

Showcase

.github/workflows/ci.yml

@@ -16,6 +16,8 @@ jobs:
 
       - name: Install R package dependencies
         uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: local::. # Necessary to avoid object usage linter errors.
 
       - name: R CMD check
         if: always()

DESCRIPTION

@@ -23,4 +23,5 @@ Suggests:
   purrr,
   rcmdcheck,
   rmarkdown,
-  shiny
+  shiny,
+  shiny.router

R/components.R

@@ -348,7 +348,7 @@ Text <- component("Text")
 #' @export
 Tree <- component("Tree")
 
-#' FormGroup
+#' Form group
 #'
 #' Documentation: <https://blueprintjs.com/docs/#core/components/form-group>
 #'
@@ -357,7 +357,7 @@ Tree <- component("Tree")
 #' @export
 FormGroup <- component("FormGroup")
 
-#' ControlGroup
+#' Control group
 #'
 #' Documentation: <https://blueprintjs.com/docs/#core/components/control-group>
 #'
@@ -406,7 +406,7 @@ RadioGroup <- component("RadioGroup")
 #' @export
 RadioGroup.shinyInput <- input("RadioGroup", NULL) # nolint
 
-#' HTMLSelect
+#' HTML select
 #'
 #' Documentation: <https://blueprintjs.com/docs/#core/components/html-select>
 #'
@@ -438,7 +438,7 @@ Switch.shinyInput <- input("Switch", FALSE) # nolint
 
 # TODO: Numeric input
 
-#' InputGroup
+#' Input group
 #'
 #' Documentation: <https://blueprintjs.com/docs/#core/components/text-inputs.input-group>
 #'
@@ -453,7 +453,7 @@ InputGroup.shinyInput <- input("InputGroup", "") # nolint
 
 # TODO: Tag input
 
-#' TextArea
+#' Text area
 #'
 #' Documentation: <https://blueprintjs.com/docs/#core/components/text-inputs.text-area>
 #'
@@ -474,7 +474,9 @@ TextArea.shinyInput <- input("TextArea", "") # nolint
 
 # TODO: Context menu
 
-# TODO: Dialogs
+# TODO: Dialog
+
+# TODO: MultistepDialog
 
 # TODO: Drawer
 

inst/examples/components/Breadcrumbs.R

@@ -1,13 +1,18 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
 items <- list(
   list(icon = "folder-close", text = "Users"),
   list(icon = "folder-close", text = "Janet"),
   list(icon = "document", text = "image.jpg")
 )
 
-if (interactive()) shinyApp(
-  ui = Breadcrumbs(items = items),
-  server = function(input, output) {}
-)
+ui <- function(id) {
+  Breadcrumbs(items = items)
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {})
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/Button.R

@@ -1,36 +1,42 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
-if (interactive()) shinyApp(
-  ui = tagList(
-    textOutput("clicks"),
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    textOutput(ns("clicks")),
     Button(
-      onClick = triggerEvent("click1"),
+      onClick = triggerEvent(ns("click1")),
       icon = "refresh",
       "Refresh"
     ),
     Button.shinyInput(
-      inputId = "click2",
+      inputId = ns("click2"),
       rightIcon = "share",
       "Export"
     ),
     AnchorButton(
-      onClick = triggerEvent("click3"),
+      onClick = triggerEvent(ns("click3")),
       intent = "primary",
       "OK"
     ),
     AnchorButton.shinyInput(
-      inputId = "click4",
+      inputId = ns("click4"),
       intent = "success",
       "Next"
     )
-  ),
-  server = function(input, output) {
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
     clicks <- reactiveVal(0)
     output$clicks <- renderText(paste("Clicks:", clicks()))
     observeEvent(input$click1, clicks(clicks() + 1))
     observeEvent(input$click2, clicks(clicks() + 1))
     observeEvent(input$click3, clicks(clicks() + 1))
     observeEvent(input$click4, clicks(clicks() + 1))
-  }
-)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/ButtonGroup.R

@@ -1,11 +1,16 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
-if (interactive()) shinyApp(
-  ui = ButtonGroup(
+ui <- function(id) {
+  ButtonGroup(
     Button(icon = "database", "Queries"),
     Button(icon = "function", "Functions"),
     AnchorButton(rightIcon = "caret-down", "Options")
-  ),
-  server = function(input, output) {}
-)
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {})
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/Callout.R

@@ -1,12 +1,17 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
-if (interactive()) shinyApp(
-  ui = Callout(
+ui <- function(id) {
+  Callout(
     title = "Visually important content",
     "The component is a simple wrapper around the CSS API",
     " that provides props for modifiers and optional title element.",
     " Any additional HTML props will be spread to the rendered ", Code("div"), " element."
-  ),
-  server = function(input, output) {}
-)
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {})
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/Card.R

@@ -1,15 +1,20 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
-if (interactive()) shinyApp(
-  ui = Card(
+ui <- function(id) {
+  Card(
     interactive = TRUE,
     H5(tags$a(href = "#", "Analytical applications")),
     tags$p(
       "User interfaces that enable people to interact smoothly with data,",
       " ask better questions, and make better decisions."
     ),
     Button(text = "Explore products")
-  ),
-  server = function(input, output) {}
-)
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {})
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/Checkbox.R

@@ -1,23 +1,33 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
+
+setInput <- function(inputId, accessor = NULL) {
+  JS(paste0("x => Shiny.setInputValue('", inputId, "', x", accessor, ")"))
+}
 
-if (interactive()) shinyApp(
-  ui = tagList(
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
     Checkbox(
-      onChange = JS("(event) => Shiny.setInputValue('apples', event.target.checked)"),
+      onChange = setInput(ns("apples"), ".target.checked"),
       defaultChecked = TRUE,
       label = "Apples"
     ),
     Checkbox.shinyInput(
-      inputId = "bananas",
+      inputId = ns("bananas"),
       value = TRUE,
       label = "Bananas"
     ),
-    textOutput("applesEnabled"),
-    textOutput("bananasEnabled")
-  ),
-  server = function(input, output) {
+    textOutput(ns("applesEnabled")),
+    textOutput(ns("bananasEnabled"))
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
     output$applesEnabled <- renderText(paste("Apples:", deparse(input$apples)))
     output$bananasEnabled <- renderText(paste("Bananas:", deparse(input$bananas)))
-  }
-)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/Collapse.R

@@ -1,5 +1,5 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
 logs <- Pre(
   "[11:53:30] Finished 'typescript-bundle-blueprint' after 769 ms\n",
@@ -9,16 +9,22 @@ logs <- Pre(
   "[11:53:30] Finished 'sass-compile-blueprint' after 2.84 s\n"
 )
 
-if (interactive()) shinyApp(
-  ui = tagList(
-    Button.shinyInput("toggle", "Toggle logs"),
-    reactOutput("ui")
-  ),
-  server = function(input, output) {
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    Button.shinyInput(ns("toggle"), "Toggle logs"),
+    reactOutput(ns("ui"))
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
     show <- reactiveVal(FALSE)
     observeEvent(input$toggle, show(!show()))
     output$ui <- renderReact({
       Collapse(isOpen = show(), logs)
     })
-  }
-)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/ControlGroup.R

@@ -1,11 +1,16 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
-if (interactive()) shinyApp(
-  ui = ControlGroup(
+ui <- function(id) {
+  ControlGroup(
     HTMLSelect(options = rownames(mtcars)),
     InputGroup(placeholder = "Find car..."),
     Button(icon = "arrow-right"),
-  ),
-  server = function(input, output) {}
-)
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {})
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/Divider.R

@@ -1,8 +1,8 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
-if (interactive()) shinyApp(
-  ui = ButtonGroup(
+ui <- function(id) {
+  ButtonGroup(
     minimal = TRUE,
     Button(text = "File"),
     Button(text = "Edit"),
@@ -12,6 +12,11 @@ if (interactive()) shinyApp(
     Divider(),
     Button(icon = "add"),
     Button(icon = "remove")
-  ),
-  server = function(input, output) {}
-)
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {})
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/EditableText.R

@@ -1,19 +1,25 @@
-library(shiny)
 library(appsilon.blueprint)
+library(shiny)
 
-if (interactive()) shinyApp(
-  ui = tagList(
-    H2(EditableText(onChange = setInput("header"))),
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    H2(EditableText(onChange = setInput(ns("header")))),
     EditableText.shinyInput(
-      inputId = "body",
+      inputId = ns("body"),
       multiline = TRUE,
       minLines = 3, maxLines = 12
     ),
-    textOutput("headerValue"),
-    textOutput("bodyValue")
-  ),
-  server = function(input, output) {
+    textOutput(ns("headerValue")),
+    textOutput(ns("bodyValue"))
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
     output$headerValue <- renderText(paste("Header:", deparse(input$header)))
     output$bodyValue <- renderText(paste("Body:", deparse(input$body)))
-  }
-)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))