Merge pull request #20 from Appsilon/feature/components-set-3

Feature/components set 3

NAMESPACE

@@ -17,6 +17,8 @@ export(ControlGroup)
 export(Divider)
 export(EditableText)
 export(EditableText.shinyInput)
+export(FileInput)
+export(FileInput.shinyInput)
 export(FormGroup)
 export(H1)
 export(H2)
@@ -35,11 +37,15 @@ export(Label)
 export(Menu)
 export(MenuDivider)
 export(MenuItem)
+export(MultiSlider)
+export(MultiSliderHandle)
 export(Navbar)
 export(NavbarDivider)
 export(NavbarGroup)
 export(NavbarHeading)
 export(NonIdealState)
+export(NumericInput)
+export(NumericInput.shinyInput)
 export(OL)
 export(OverflowList)
 export(PanelStack2)
@@ -49,14 +55,20 @@ export(ProgressBar)
 export(Radio)
 export(RadioGroup)
 export(RadioGroup.shinyInput)
+export(RangeSlider)
+export(RangeSlider.shinyInput)
 export(ResizeSensor)
+export(Slider)
+export(Slider.shinyInput)
 export(Spinner)
 export(Switch)
 export(Switch.shinyInput)
 export(Tab)
 export(Tabs)
 export(TabsExpander)
 export(Tag)
+export(TagInput)
+export(TagInput.shinyInput)
 export(Text)
 export(TextArea)
 export(TextArea.shinyInput)

R/components.R

@@ -25,6 +25,17 @@ component <- function(name) {
   }
 }
 
+properties <- function(name) {
+  function(...) {
+    shiny.react::reactElement(
+      module = "@/appsilon.blueprint",
+      name = name,
+      props = shiny.react::asProps(...),
+      deps = blueprintDependency()
+    )
+  }
+}
+
 button <- function(name) {
   function(inputId, ...) {
     shiny.react::reactElement(
@@ -419,7 +430,44 @@ HTMLSelect <- component("HTMLSelect")
 #' @export
 HTMLSelect.shinyInput <- input("HTMLSelect", "") # nolint
 
-# TODO: Slider
+#' Slider
+#'
+#' Documentation: <https://blueprintjs.com/docs/#core/components/sliders.slider>
+#'
+#' @example inst/examples/components/Slider.R
+#' @inherit template params
+#' @export
+Slider <- component("Slider")
+
+#' @rdname Slider
+#' @export
+Slider.shinyInput <- input("Slider", 0) # nolint
+
+#' Range slider
+#'
+#' Documentation: <https://blueprintjs.com/docs/#core/components/sliders.range-slider>
+#'
+#' @example inst/examples/components/Slider.R
+#' @inherit template params
+#' @export
+RangeSlider <- component("RangeSlider")
+
+#' @rdname RangeSlider
+#' @export
+RangeSlider.shinyInput <- input("RangeSlider", c(0, 0)) # nolint
+
+#' Multi slider
+#'
+#' Documentation: <https://blueprintjs.com/docs/#core/components/sliders.multi-slider>
+#'
+#' @example inst/examples/components/MultiSlider.R
+#' @inherit template params
+#' @export
+MultiSlider <- component("MultiSlider")
+
+#' @rdname MultiSlider
+#' @export
+MultiSliderHandle <- properties("MultiSliderHandle")
 
 #' Switch
 #'
@@ -434,9 +482,31 @@ Switch <- component("Switch")
 #' @export
 Switch.shinyInput <- input("Switch", FALSE) # nolint
 
-# TODO: File input
+#' FileInput
+#'
+#' Documentation: <https://blueprintjs.com/docs/#core/components/file-input>
+#'
+#' @example inst/examples/components/Switch.R
+#' @inherit template params
+#' @export
+FileInput <- component("FileInput")
 
-# TODO: Numeric input
+#' @rdname Switch
+#' @export
+FileInput.shinyInput <- input("FileInput", "") # nolint
+
+#' NumericInput
+#'
+#' Documentation: <https://blueprintjs.com/docs/#core/components/numeric-input>
+#'
+#' @example inst/examples/components/NumericInput.R
+#' @inherit template params
+#' @export
+NumericInput <- component("NumericInput")
+
+#' @rdname NumericInput
+#' @export
+NumericInput.shinyInput <- input("NumericInput", 0) # nolint
 
 #' Input group
 #'
@@ -451,7 +521,18 @@ InputGroup <- component("InputGroup")
 #' @export
 InputGroup.shinyInput <- input("InputGroup", "") # nolint
 
-# TODO: Tag input
+#' TagInput
+#'
+#' Documentation: <https://blueprintjs.com/docs/#core/components/tag-input>
+#'
+#' @example inst/examples/components/TagInput.R
+#' @inherit template params
+#' @export
+TagInput <- component("TagInput")
+
+#' @rdname TagInput
+#' @export
+TagInput.shinyInput <- input("TagInput", NULL) # nolint
 
 #' Text area
 #'

inst/examples/components/FileInput.R

@@ -0,0 +1,31 @@
+library(shiny)
+library(appsilon.blueprint)
+
+setInput <- function(inputId, accessor = NULL) {
+  JS(paste0("x => Shiny.setInputValue('", inputId, "', x", accessor, ")"))
+}
+
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    FileInput(
+      onChange = setInput(ns("value1"), ".target.value"),
+      text = "Please, choose a file...",
+    ),
+    textOutput(ns("value1Output")),
+    FileInput.shinyInput(
+      inputId = ns("value2"),
+      value = "Please, choose a file..."
+    ),
+    textOutput(ns("value2Output"))
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
+    output$value1Output <- renderText(input$value1)
+    output$value2Output <- renderText(input$value2)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/MultiSlider.R

@@ -0,0 +1,64 @@
+library(shiny)
+library(appsilon.blueprint)
+
+ui <- function(id) {
+  ns <- NS(id)
+  reactOutput(ns("multiSliderOutput"))
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
+    ns <- session$ns
+
+    thresholds <- reactiveValues(
+      dangerStart = 3,
+      warningStart = 8,
+      warningEnd = 14,
+      dangerEnd = 17
+    )
+
+    observeEvent(input$mutliSliderInput, {
+      sliderValues <- sort(input$mutliSliderInput)
+      thresholds$dangerStart <- sliderValues[1]
+      thresholds$warningStart <- sliderValues[2]
+      thresholds$warningEnd <- sliderValues[3]
+      thresholds$dangerEnd <- sliderValues[4]
+    })
+
+    output$multiSliderOutput <- renderReact({
+      MultiSlider(
+        defaultTrackIntent = "success",
+        onChange = setInput(ns("mutliSliderInput")),
+        stepSize = 1,
+        min = 0,
+        max = 20,
+        MultiSliderHandle(
+          type = "start",
+          intentBefore = "danger",
+          value = thresholds$dangerStart,
+          interactionKind = "push"
+        ),
+        MultiSliderHandle(
+          type = "start",
+          intentBefore = "warning",
+          value = thresholds$warningStart,
+          interactionKind = "push"
+        ),
+        MultiSliderHandle(
+          type = "end",
+          intentAfter = "warning",
+          value = thresholds$warningEnd,
+          interactionKind = "push"
+        ),
+        MultiSliderHandle(
+          type = "end",
+          intentAfter = "danger",
+          value = thresholds$dangerEnd,
+          interactionKind = "push"
+        )
+      )
+    })
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/NumericInput.R

@@ -0,0 +1,27 @@
+library(shiny)
+library(appsilon.blueprint)
+
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    NumericInput(
+      onValueChange = setInput(ns("value1")),
+      intent = "primary"
+    ),
+    textOutput(ns("value1Output")),
+    NumericInput.shinyInput(
+      inputId = ns("value2"),
+      intent = "primary"
+    ),
+    textOutput(ns("value2Output"))
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
+    output$value1Output <- renderText(input$value1)
+    output$value2Output <- renderText(input$value2)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/RangeSlider.R

@@ -0,0 +1,24 @@
+library(shiny)
+library(appsilon.blueprint)
+
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    RangeSlider.shinyInput(
+      inputId = ns("value"),
+      min = 0,
+      max = 10,
+      stepSize = 0.1,
+      labelStepSize = 10
+    ),
+    textOutput(ns("valueOutput"))
+  )
+}
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
+    output$valueOutput <- renderText(input$value)
+  })
+}
+
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/Slider.R

@@ -0,0 +1,24 @@
+library(shiny)
+library(appsilon.blueprint)
+
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    Slider.shinyInput(
+      inputId = ns("value"),
+      min = 0,
+      max = 10,
+      stepSize = 0.1,
+      labelStepSize = 10
+    ),
+    textOutput(ns("valueOutput"))
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
+    output$valueOutput <- renderText(input$value)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/components/TagInput.R

@@ -0,0 +1,22 @@
+library(shiny)
+library(appsilon.blueprint)
+
+
+ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    TagInput.shinyInput(
+      inputId = ns("value"),
+      value = c("one", "two", "three")
+    ),
+    textOutput(ns("valueOutput"))
+  )
+}
+
+server <- function(id) {
+  moduleServer(id, function(input, output, session) {
+    output$valueOutput <- renderText(input$value)
+  })
+}
+
+if (interactive()) shinyApp(ui("app"), function(input, output) server("app"))

inst/examples/showcase/app.R

@@ -41,16 +41,18 @@ sections <- list(
     item("Checkbox", "Checkbox"),
     item("Radio", "Radio"),
     item("HTML select", "HTMLSelect"),
-    # TODO: Slider
+    item("Slider", "Slider"),
+    item("Range slider", "RangeSlider"),
+    item("Multi slider", "MultiSlider"),
     item("Switch", "Switch")
   ),
   section(
     "FORM INPUTS",
-    # TODO: File input
-    # TODO: Numeric input
+    item("File input", "FileInput"),
+    item("Numeric input", "NumericInput"),
     item("Input group", "InputGroup"),
-    item("Text area", "TextArea")
-    # TODO: Tag input
+    item("Text area", "TextArea"),
+    item("Tag input", "TagInput")
   ),
   section(
     "OVERLAYS",