Merge pull request #116 from Appsilon/kuba.rhino-compatibility

Kuba.rhino compatibility

DESCRIPTION

@@ -1,10 +1,11 @@
 Package: shiny.router
 Type: Package
 Title: Basic Routing for Shiny Web Applications
-Version: 0.2.3
+Version: 0.2.3.9000
 Authors@R:
   c(
     person("Ryszard", "Szymański", email = "[email protected]", role = c("cre", "aut")),
+    person("Jakub", "Nowicki", email = "[email protected]", role = c("aut")),
     person("Filip", "Stachura", email = "[email protected]", role = c("aut")),
     person("Dominik", "Krzemiński", email = "[email protected]", role = c("aut")),
     person("Krystian", "Igras", email = "[email protected]", role = c("aut")),
@@ -20,9 +21,10 @@ Encoding: UTF-8
 LazyData: true
 License: MIT + file LICENSE
 Imports:
-    shiny,
-    htmltools
-RoxygenNote: 7.2.1
+    htmltools,
+    glue,
+    shiny
+RoxygenNote: 7.2.3
 Suggests:
     covr,
     lintr,

NAMESPACE

@@ -11,5 +11,7 @@ export(page404)
 export(parse_url_path)
 export(route)
 export(route_link)
+export(router_server)
+export(router_ui)
 importFrom(htmltools,renderDependencies)
 importFrom(htmltools,resolveDependencies)

R/router.R

@@ -65,16 +65,23 @@ get_url_hash <- function(session = shiny::getDefaultReactiveDomain()) {
 #'
 #' @param path Website route.
 #' @param ui Valid Shiny user interface.
-#' @param server Function that is called as callback on server side
+#' @param server Function that is called as callback on server side [deprecated]
 #' @return A route configuration.
 #' @examples
 #' \dontrun{
 #' route("/", shiny::tags$div(shiny::tags$span("Hello world")))
 #'
-#' route("/main", shiny::tags$div(h1("Main page"), p("Lorem ipsum.")))
+#' route("main", shiny::tags$div(h1("Main page"), p("Lorem ipsum.")))
 #' }
 #' @export
 route <- function(path, ui, server = NA) {
+  if (!missing(server)) {
+    warning(
+      "`server` argument in `route` is deprecated.
+      It will not be used when `route` is called inside `router_ui`."
+    )
+  }
+
   out <- list()
   out[[path]] <- callback_mapping(path, ui, server)
   out
@@ -88,7 +95,7 @@ route <- function(path, ui, server = NA) {
 #'
 #' @return Router callback.
 #' @keywords internal
-create_router_callback <- function(root, routes) {
+create_router_callback <- function(root, routes = NULL) {
   function(input, output, session = shiny::getDefaultReactiveDomain(), ...) {
     # Making this a list inside a shiny::reactiveVal, instead of using a
     # shiny::reactiveValues, because it should change atomically.
@@ -105,7 +112,9 @@ create_router_callback <- function(root, routes) {
       session$userData$shiny.router.url_hash(cleanup_hashpath(shiny::getUrlHash()))
     })
 
-    lapply(routes, function(route) route$server(input, output, session, ...))
+    if (!is.null(routes)) {
+      lapply(routes, function(route) route$server(input, output, session, ...))
+    }
 
     # Watch for updates to the address bar's fragment (aka "hash"), and update
     # our router state if needed.
@@ -131,7 +140,14 @@ create_router_callback <- function(root, routes) {
         parsed <- parse_url_path(cleaned_url)
         parsed$path <- ifelse(parsed$path == "", root, parsed$path)
 
-        if (!valid_path(routes, parsed$path)) {
+        is_path_valid <- if (is.null(routes)) {
+          log_msg("Valid paths:", input$routes)
+          !is.null(input$routes) && !(parsed$path %in% c(input$routes, "404"))
+        } else {
+          !valid_path(routes, parsed$path)
+        }
+
+        if (is_path_valid) {
           log_msg("Invalid path sent to observer")
           # If it's not a recognized path, then go to default 404 page.
           change_page(PAGE_404_ROUTE, mode = "replace")
@@ -160,11 +176,83 @@ create_router_callback <- function(root, routes) {
   }
 }
 
+#' Create router UI
+#'
+#' Creates router UI in Shiny applications.
+#'
+#' @param default Main route to which all invalid routes should redirect.
+#' @param ... All other routes defined with shiny.router::route function.
+#' @param page_404 Styling of page when invalid route is open. See \link{page404}.
+#' @param env Environment (only for advanced usage), makes it possible to use shiny.router inside
+#'   shiny modules.
+#'
+#' @details If you are defining the router inside a shiny module,
+#'   we assume that the namespacing function defined in the UI is named as ns.
+#'
+#' @return Application UI wrapped in a router.
+#'
+#' @examples
+#' \dontrun{
+#'   ui <- function() {
+#'     router_ui(
+#'       route("/", root_page(id = "root")),
+#'       route("/other", other_page(id = "other")),
+#'       page_404 = page404(
+#'         message404 = "Please check if you passed correct bookmark name!")
+#'     )
+#'   }
+#' }
+#' @export
+router_ui <- function(default, ..., page_404 = page404(), env = parent.frame()) {
+  routes <- c(default, ...)
+  root <- names(default)[1]
+  if (! PAGE_404_ROUTE %in% names(routes))
+    routes <- c(routes, route(PAGE_404_ROUTE, page_404))
+  router <- list(root = root, routes = routes)
+
+  routes_input_id <- "routes"
+  if (!is.null(env$ns)) {
+    routes_input_id <- env$ns(routes_input_id)
+  }
+
+  routes_names <- paste0("'", names(c(default, ...)), "'", collapse = ", ")
+
+  shiny::tagList(
+    shiny::tags$script(
+      glue::glue("$(document).on('shiny:connected', function() {{
+        Shiny.setInputValue('{routes_input_id}', [{routes_names}]);
+      }});")
+    ),
+    router_ui_internal(router)
+  )
+}
+
+#' Create router pages server callback
+#'
+#' Server part of the router.
+#'
+#' @param root_page Main page path.
+#' @param env Environment (only for advanced usage).
+#'
+#' @return Router pages server callback.
+#'
+#' @examples
+#' \dontrun{
+#'   server <- function(input, output, session) {
+#'     router_server(root_page = "/")
+#'   }
+#' }
+#' @export
+router_server <- function(root_page = "/", env = parent.frame()) {
+  router <- create_router_callback(root_page)
+  router(env$input, env$output, env$session)
+}
+
 #' Create router pages server callback
 #'
 #' @param router Router pages object. See \link{make_router}.
 #' @keywords internal
-router_server <- function(router) {
+router_server_internal <- function(router) {
   create_router_callback(router$root, router$routes)
 }
 
@@ -175,7 +263,7 @@ router_server <- function(router) {
 #' @return list with shiny tags that adds "router-page-wrapper" div and embeds
 #' router javascript script.
 #' @keywords internal
-router_ui <- function(router) {
+router_ui_internal <- function(router) {
   shiny::addResourcePath(
     "shiny.router",
     system.file("www", package = "shiny.router")
@@ -199,7 +287,7 @@ router_ui <- function(router) {
   )
 }
 
-#' Creates router.
+#' [Deprecated] Creates router.
 #'
 #' Returned callback needs to be called within Shiny server code.
 #'
@@ -220,12 +308,17 @@ router_ui <- function(router) {
 #' }
 #' @export
 make_router <- function(default, ..., page_404 = page404()) {
+  .Deprecated(
+    new = "router_ui",
+    msg = "make_router function is deprecated. Please use 'router_ui' instead."
+  )
+
   routes <- c(default, ...)
   root <- names(default)[1]
   if (! PAGE_404_ROUTE %in% names(routes))
     routes <- c(routes, route(PAGE_404_ROUTE, page_404))
   router <- list(root = root, routes = routes)
-  list(ui = router_ui(router), server = router_server(router))
+  list(ui = router_ui_internal(router), server = router_server_internal(router))
 }
 
 #' Convenience function to retrieve just the "page" part of the input.

R/zzz.R

@@ -7,8 +7,7 @@
 #'
 #' @keywords internal
 .onAttach <- function(libname, pkgname) {
-  packageStartupMessage("shiny.router from version >= 0.2.0 introduced major
-  changes to the API that are not compatible with the
-  previous versions. Please check the docs, or examples
-  to learn more: https://github.com/Appsilon/shiny.router")
+  packageStartupMessage("shiny.router from version > 0.2.3 introduced major
+  changes to the API. Old API is still working but has been marked as deprecated.
+  Please check the docs, or examples to learn more: https://github.com/Appsilon/shiny.router")
 }

README.md

@@ -12,7 +12,7 @@
 Now it's possible to recreate a state of your app, by providing a specific URL, like:
 
 ```r
-make_router(
+router_ui(
   route("<your_app_url>/main",  mainPageShinyUI),
   route("<your_app_url>/other", otherPageShinyUI)
 )
@@ -47,24 +47,22 @@ library(shiny.router)
 root_page <- div(h2("Root page"))
 other_page <- div(h3("Other page"))
 
-router <- make_router(
-  route("/", root_page),
-  route("other", other_page)
-)
-
 ui <- fluidPage(
   title = "Router demo",
-  router$ui
+  router_ui(
+    route("/", root_page),
+    route("other", other_page)
+  )
 )
 
 server <- function(input, output, session) {
-  router$server(input, output, session)
+  router_server()
 }
 
 shinyApp(ui, server)
 ```
 
-Check [the tutorial](https://appsilon.github.io/shiny.router/articles/basics.html) for more details on how to start using `shiny.router` or read the article on [Appsilon's blog](https://appsilon.com/shiny-router-package/).
+Check [the tutorial](https://appsilon.github.io/shiny.router/articles/basics.html) for more details on how to start using `shiny.router`.
 
 Examples
 -------

examples/basic/app.R

@@ -2,12 +2,10 @@ library(shiny)
 library(shiny.router)
 
 # This generates menu in user interface with links.
-menu <- (
-  tags$ul(
-    tags$li(a(class = "item", href = route_link("/"), "Page")),
-    tags$li(a(class = "item", href = route_link("other"), "Other page")),
-    tags$li(a(class = "item", href = route_link("third"), "A third page"))
-  )
+menu <- tags$ul(
+  tags$li(a(class = "item", href = route_link("/"), "Page")),
+  tags$li(a(class = "item", href = route_link("other"), "Other page")),
+  tags$li(a(class = "item", href = route_link("third"), "A third page"))
 )
 
 # This creates UI for each page.
@@ -25,36 +23,26 @@ root_page <- page("Home page", "Welcome on sample routing page!", "table_one")
 other_page <- page("Some other page", "Lorem ipsum dolor sit amet.", "table_two")
 third_page <- div(menu, titlePanel("Third Page"))
 
-# Callbacks on the server side for
-# the sample pages
-root_callback <- function(input, output, session) {
+# Make output for our router in main UI of Shiny app.
+ui <- fluidPage(
+  router_ui(
+    route("/", root_page),
+    route("other", other_page),
+    route("third", third_page)
+  )
+)
+
+# Plug router into Shiny server.
+server <- shinyServer(function(input, output, session) {
+  router_server()
+
   output$table_one <- renderDataTable({
     data.frame(x = c(1, 2), y = c(3, 4))
   })
-}
 
-other_callback <- function(input, output, session) {
   output$table_two <- renderDataTable({
-    data.frame(x = c(5, 6), y = c(7, 8))
+    data.frame(A = c("a", "a"), B = c("b", "b"))
   })
-}
-
-# Creates router. We provide routing path, a UI as
-# well as a server-side callback for each page.
-router <- make_router(
-  route("/", root_page, root_callback),
-  route("other", other_page, other_callback),
-  route("third", third_page, NA)
-)
-
-# Make output for our router in main UI of Shiny app.
-ui <- shinyUI(fluidPage(
-  router$ui
-))
-
-# Plug router into Shiny server.
-server <- shinyServer(function(input, output, session) {
-  router$server(input, output, session)
 })
 
 # Run server in a standard way.