diff --git a/.Rbuildignore b/.Rbuildignore index e13c405..a8964d3 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,4 @@ ^.*\.Rproj$ ^\.Rproj\.user$ ^LICENSE\.md$ +^inst/tmp$ diff --git a/DESCRIPTION b/DESCRIPTION index 9c4bf28..c8cb172 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,9 +1,10 @@ Package: blaze Type: Package Title: Observe URL Paths with 'shiny' -Version: 0.0.1 +Version: 0.0.1.9000 Author: c( - person("Nathan", "Teetor", email = "nathanteetor@gmail.com", role = c("aut", "cre"))) + person("Nathan", "Teetor", email = "nathanteetor@gmail.com", role = c("aut", "cre")), + person("Garrick", "Aden-Buie", email = "garrick@adenbuie.com", role = c("ctb"), comment = c(ORCID = "0000-0002-7111-0077"))) Maintainer: Nathan Teetor Description: Simulate routing within a 'shiny' application by observering and reacting to URL changes. 'shiny' applications are considered single page @@ -12,12 +13,13 @@ Description: Simulate routing within a 'shiny' application by observering License: MIT + file LICENSE Encoding: UTF-8 LazyData: true -RoxygenNote: 7.0.2 +RoxygenNote: 7.1.1 Imports: fs, htmltools, rematch2, rlang, - shiny + shiny, + utils Suggests: testthat diff --git a/NAMESPACE b/NAMESPACE index fb01ab9..1fe5658 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,9 +1,13 @@ # Generated by roxygen2: do not edit by hand +S3method(as_paths,character) +S3method(as_paths,list) +S3method(as_paths,yml) +export(blaze) export(getPath) export(observePath) -export(param) export(pathLink) +export(paths) export(pushPath) importFrom(fs,dir_create) importFrom(fs,dir_delete) diff --git a/R/blaze.R b/R/blaze.R index 6e85001..3406fd9 100644 --- a/R/blaze.R +++ b/R/blaze.R @@ -19,26 +19,27 @@ NULL #' #' Using path link elements (a variation of standard hyperlinks) users can #' browse to different URL paths. A shiny application can detect these changes -#' with `observePath()` allowing you to update tab sets or other dynamic -#' elements within the application. `pushPath()` lets you redirect the user from +#' with [observePath()] allowing you to update tab sets or other dynamic +#' elements within the application. [pushPath()] lets you redirect the user from #' the server. #' #' Because of how shiny handles URL paths be sure to run the -#' `paths()` function before launching an application. +#' [paths()] function before launching an application. #' #' @name blaze "_PACKAGE" #' @section Including in a shiny app: #' -#' To use blaze with a shiny application the `blaze()` function must be called +#' To use blaze with a shiny application the [blaze()] function must be called #' inside the application's UI. #' #' @rdname blaze +#' @export blaze <- function() { htmltools::htmlDependency( name = "blaze", - version = packageVersion("blaze"), + version = utils::packageVersion("blaze"), src = c( file = path_package("blaze", "www", "js"), href = "blaze/js" diff --git a/R/link.R b/R/link.R index a107c71..c8d9d1a 100644 --- a/R/link.R +++ b/R/link.R @@ -4,7 +4,7 @@ #' let the user browse to different parts of your application without refreshing #' the current page. #' -#' @param ... Arguments passed to `htmltools::a()`. +#' @param ... Arguments passed to [htmltools::a()]. #' #' @param href A character string specifying the URL path to navigate to. #' @@ -12,5 +12,5 @@ pathLink <- function(href, ...) { stopifnot(is.character(href)) - htmltools::a(..., href = href, `data-blaze` = NA) + htmltools::a(..., href = path_app(href), `data-blaze` = NA) } diff --git a/R/paths.R b/R/paths.R index 60a66f0..e8f2a4b 100644 --- a/R/paths.R +++ b/R/paths.R @@ -23,7 +23,73 @@ paths_remove <- function(p) { .globals$paths[[p]] <- NULL } -paths <- function(...) { +#' Declare Paths for Use with Shiny +#' +#' Declare path endpoints that will be available inside your Shiny app. This +#' function should be called before the call to [shiny::shinyApp()] in your +#' `app.R` file or inside your `server.R` script before the server function. +#' This function makes it possible for users to enter your app URL with a path, +#' e.g. `/about`, and be directed to the `"about"` page within your +#' Shiny app. +#' +#' @examples +#' \dontrun{ +#' library(shiny) +#' library(blaze) +#' +#' options(shiny.launch.browser = TRUE) +#' +#' blaze::paths( +#' "home", +#' "about", +#' "explore" +#' ) +#' +#' shinyApp( +#' ui = fluidPage( +#' blaze(), +#' tags$nav( +#' pathLink("/home", "Home"), +#' pathLink("/about", "About"), +#' pathLink("/explore", "Explore") +#' ), +#' uiOutput("page") +#' ), +#' server = function(input, output, session) { +#' state <- reactiveValues(page = NULL) +#' +#' observePath("/home", { +#' state$page <- "Home is where the heart is." +#' }) +#' +#' observePath("/about", { +#' state$page <- "About this, about that." +#' }) +#' +#' observePath("/explore", { +#' state$page <- div( +#' p("Curabitur blandit tempus porttitor."), +#' p("Vivamus sagittis lacus augue rutrum dolor auctor.") +#' ) +#' }) +#' +#' output$page <- renderUI(state$page) +#' } +#' ) +#' } +#' +#' @param ... Path names as character strings that will be valid entry points +#' into your Shiny app. +#' +#' @param app_path The name of the sub-directory where your Shiny app is hosted, +#' e.g. `host.com//`. +#' +#' @return Invisibly writes temporary HTML files to be hosted by Shiny to +#' redirect users to the requested path within your Shiny app. The [paths()] +#' function returns the temporary folder used by \pkg{blaze}. +#' +#' @export +paths <- function(..., app_path = NULL) { args <- lapply(list(...), as_paths) routes <- unique(unlist(args)) tmp <- path(tempdir(check = TRUE), "blaze") @@ -34,28 +100,43 @@ paths <- function(...) { old <- setwd(tmp) on.exit(setwd(old)) + .globals$app_path <- if (!is.null(app_path)) { + app_path <- gsub("^/|/$", "", app_path) + dir_create(app_path, recurse = TRUE) + app_path + } + lapply(routes, function(route) { + if (!is.null(app_path)) route <- path(app_path, route) dir_create(route) }) - dirs <- dir_ls(tmp, recurse = FALSE, type = "directory") + app_dir <- if (is.null(app_path)) tmp else path(tmp, app_path) + dirs <- dir_ls(app_dir, recurse = FALSE, type = "directory") prefixes <- path_file(dirs) Map(p = prefixes, dir = dirs, paths_add) - dir_walk(recurse = TRUE, type = "directory", fun = function(d) { + dir_walk(app_dir, recurse = TRUE, type = "directory", fun = function(d) { index <- file_create(path(d, "index.html")) if (!grepl("^/", d)) { d <- paste0("/", d) } + app_redirect <- if (is.null(app_path)) "" else paste0("/", app_path) + cat(file = index, sprintf(" - + Redirecting - ", d + ", app_redirect )) }) @@ -66,6 +147,7 @@ as_paths <- function(x, ...) { UseMethod("as_paths", x) } +#' @export as_paths.character <- function(x, ...) { n <- names(x) @@ -81,6 +163,7 @@ as_paths.character <- function(x, ...) { }, character(1)) } +#' @export as_paths.list <- function(x, ...) { x <- unlist(x) @@ -91,6 +174,20 @@ as_paths.list <- function(x, ...) { as_paths.character(x) } +#' @export as_paths.yml <- function(x, ...) { as_paths.list(unclass(x)) } + + +path_app <- function(path) { + if (!grepl("^/", path)) { + path <- paste0("/", path) + } + + if (!is.null(.globals$app_path)) { + path <- paste0("/", .globals$app_path, path) + } + + path +} diff --git a/R/url.R b/R/url.R index e92af08..c002b7c 100644 --- a/R/url.R +++ b/R/url.R @@ -19,7 +19,7 @@ #' @param ... Additional arguments passed to `grepl()`. #' #' @param domain A reactive context, defaults to -#' `shiny::getDefaultReactiveDomain()`. +#' [shiny::getDefaultReactiveDomain()]. #' #' @export observePath <- function(path, handler, env = parent.frame(), quoted = FALSE, @@ -58,6 +58,14 @@ as_route <- function(x) { x <- gsub("/:([^/]*)", "/(?<\\1>[^/]+)", x) } + if (!grepl("^/", x)) { + x <- paste0("/", x) + } + + if (!is.null(.globals$app_path)) { + x <- paste0("/", .globals$app_path, x) + } + if (!grepl("^[\\^]", x)) { x <- paste0("^", x) } @@ -86,8 +94,6 @@ mask_params <- function(path, url) { }) } -#' @rdname observePath -#' @export param <- function(x, params = peek_params()) { sym_x <- rlang::ensym(x) name_x <- rlang::as_name(sym_x) @@ -103,25 +109,36 @@ peek_params <- function() { #' Push a new URL path or get the current path. #' #' @param path A character string specifying a new URL path +#' @param mode Either `"push"` or `"replace"`. If `"push"`, the default, the +#' path is pushed onto the history stack and pressing the back button in the +#' browser will redirect to the current path (before pushing the path). If +#' `"replace"`, then the pushed path will replace the current path without +#' changing the next page in the browser's back button stack. #' #' @param session A reactive context, defaults to #' `shiny::getDefaultReactiveDomain()`. #' #' @export -pushPath <- function(path, session = getDefaultReactiveDomain()) { - if (!grepl("^/", path)) { - path <- paste0("/", path) - } +pushPath <- function(path, mode = c("push", "replace"), session = getDefaultReactiveDomain()) { + path <- path_app(path) + mode <- match.arg(mode) path <- utils::URLencode(path) session$sendCustomMessage("blaze:pushstate", list( - path = path + path = path, + mode = mode )) } #' @rdname pushPath #' @export getPath <- function(session = getDefaultReactiveDomain()) { - session$clientData$url_state + url <- session$clientData$url_state + if (is.null(.globals$app_path)) { + return(url) + } + url <- sub(paste0("/", .globals$app_path), "", url, fixed = TRUE) + if (!length(url) || !grepl("^/", url)) url <- paste0("/", url) + url } diff --git a/R/zzz.R b/R/zzz.R index 5443167..87d7bdc 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,3 +1,3 @@ -.onLoad <- function(pkg, lib) { +.onLoad <- function(lib, pkg) { shiny::addResourcePath("blaze", path_package("blaze", "www")) } diff --git a/inst/tmp/hello/index.html b/inst/tmp/hello/index.html deleted file mode 120000 index 6ce4406..0000000 --- a/inst/tmp/hello/index.html +++ /dev/null @@ -1 +0,0 @@ -tmp/index.html \ No newline at end of file diff --git a/inst/tmp/index.html b/inst/tmp/index.html deleted file mode 100644 index 0417e19..0000000 --- a/inst/tmp/index.html +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - - - diff --git a/inst/tmp/world/index.html b/inst/tmp/world/index.html deleted file mode 100644 index 0417e19..0000000 --- a/inst/tmp/world/index.html +++ /dev/null @@ -1,10 +0,0 @@ - - - - - - - - diff --git a/inst/www/js/blaze.js b/inst/www/js/blaze.js index b960842..3ae47c1 100644 --- a/inst/www/js/blaze.js +++ b/inst/www/js/blaze.js @@ -3,12 +3,31 @@ Shiny.setInputValue(".clientdata_url_state", value, { priority: "event" }); }; + var getURLComponents = function() { + const params = new URLSearchParams(window.location.search); + params.delete('redirect'); + return { + params, + pathname: window.location.pathname, + hash: window.location.hash + }; + }; + + var pathURI = function(redirect, {params, hash} = getURLComponents()) { + if (!redirect || redirect == window.location.pathname) { + return false; + } + if (params.toString()) redirect = redirect + '?' + params; + return redirect + hash; + }; + (function() { const params = new URLSearchParams(window.location.search); const redirect = params.get("redirect") || "/"; if (redirect !== "/") { - history.replaceState(redirect, null, redirect); + redirectURI = pathURI(redirect); + history.replaceState(redirectURI, null, redirectURI); } window.addEventListener("DOMContentLoaded", function() { @@ -19,6 +38,20 @@ })(); window.addEventListener("DOMContentLoaded", function() { + var _path = function(path, mode) { + const uri = pathURI(path); + if (uri) { + if ((mode || "push") === "push") { + history.pushState({uri, pathname: path}, null, uri); + } else if (mode === "replace") { + history.replaceState({uri, pathname: path}, null, uri); + } else { + throw `Unknown blaze::pushPath() mode: ${mode}`; + } + sendState(path); + } + }; + document.addEventListener("click", function(event) { const target = event.target; @@ -32,8 +65,7 @@ var uri = target.getAttribute("href"); if (uri !== window.location.pathname) { - sendState(uri); - history.pushState(uri, null, uri); + _path(uri); } } @@ -41,17 +73,14 @@ }); Shiny.addCustomMessageHandler("blaze:pushstate", function(msg) { - var _path = function(path) { - history.pushState(path, null, path); - }; - if (msg.path) { - _path(msg.path); + _path(msg.path, msg.mode || "push"); } }); }); window.addEventListener("popstate", function(event) { - sendState(event.state || "/"); + let {pathname} = event.state || window.location; + sendState(pathname || "/"); }); })(window.jQuery, window.Shiny); diff --git a/man/blaze.Rd b/man/blaze.Rd index 2ae7884..08976e7 100644 --- a/man/blaze.Rd +++ b/man/blaze.Rd @@ -16,17 +16,17 @@ buttons. Using path link elements (a variation of standard hyperlinks) users can browse to different URL paths. A shiny application can detect these changes -with `observePath()` allowing you to update tab sets or other dynamic -elements within the application. `pushPath()` lets you redirect the user from +with [observePath()] allowing you to update tab sets or other dynamic +elements within the application. [pushPath()] lets you redirect the user from the server. Because of how shiny handles URL paths be sure to run the -`paths()` function before launching an application. +[paths()] function before launching an application. } \section{Including in a shiny app}{ -To use blaze with a shiny application the `blaze()` function must be called +To use blaze with a shiny application the [blaze()] function must be called inside the application's UI. } diff --git a/man/observePath.Rd b/man/observePath.Rd index e8ff4bd..87645c6 100644 --- a/man/observePath.Rd +++ b/man/observePath.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/url.R \name{observePath} \alias{observePath} -\alias{param} \title{Observe URL paths} \usage{ observePath( @@ -13,8 +12,6 @@ observePath( ..., domain = getDefaultReactiveDomain() ) - -param(x, params = peek_params()) } \arguments{ \item{path}{A character string specifying a URL path, by default `path` is @@ -33,7 +30,7 @@ expression. If `TRUE`, the expression must be quoted with `quote()`.} \item{...}{Additional arguments passed to `grepl()`.} \item{domain}{A reactive context, defaults to -`shiny::getDefaultReactiveDomain()`.} +[shiny::getDefaultReactiveDomain()].} } \description{ Observe a URL path and run a handler expression. `handler` is run when the diff --git a/man/pathLink.Rd b/man/pathLink.Rd index da01960..8111a02 100644 --- a/man/pathLink.Rd +++ b/man/pathLink.Rd @@ -9,7 +9,7 @@ pathLink(href, ...) \arguments{ \item{href}{A character string specifying the URL path to navigate to.} -\item{...}{Arguments passed to `htmltools::a()`.} +\item{...}{Arguments passed to [htmltools::a()].} } \description{ The `pathLink()` function creates a special `tags$a()` element. These links diff --git a/man/paths.Rd b/man/paths.Rd new file mode 100644 index 0000000..8b06abe --- /dev/null +++ b/man/paths.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/paths.R +\name{paths} +\alias{paths} +\title{Declare Paths for Use with Shiny} +\usage{ +paths(..., app_path = NULL) +} +\arguments{ +\item{...}{Path names as character strings that will be valid entry points +into your Shiny app.} + +\item{app_path}{The name of the sub-directory where your Shiny app is hosted, +e.g. `host.com//`.} +} +\value{ +Invisibly writes temporary HTML files to be hosted by Shiny to + redirect users to the requested path within your Shiny app. The [paths()] + function returns the temporary folder used by \pkg{blaze}. +} +\description{ +Declare path endpoints that will be available inside your Shiny app. This +function should be called before the call to [shiny::shinyApp()] in your +`app.R` file or inside your `server.R` script before the server function. +This function makes it possible for users to enter your app URL with a path, +e.g. `/about`, and be directed to the `"about"` page within your +Shiny app. +} +\examples{ +\dontrun{ +library(shiny) +library(blaze) + +options(shiny.launch.browser = TRUE) + +blaze::paths( + "home", + "about", + "explore" +) + +shinyApp( + ui = fluidPage( + blaze(), + tags$nav( + pathLink("/home", "Home"), + pathLink("/about", "About"), + pathLink("/explore", "Explore") + ), + uiOutput("page") + ), + server = function(input, output, session) { + state <- reactiveValues(page = NULL) + + observePath("/home", { + state$page <- "Home is where the heart is." + }) + + observePath("/about", { + state$page <- "About this, about that." + }) + + observePath("/explore", { + state$page <- div( + p("Curabitur blandit tempus porttitor."), + p("Vivamus sagittis lacus augue rutrum dolor auctor.") + ) + }) + + output$page <- renderUI(state$page) + } +) +} + +} diff --git a/man/pushPath.Rd b/man/pushPath.Rd index 086c3d4..a7f42d9 100644 --- a/man/pushPath.Rd +++ b/man/pushPath.Rd @@ -5,13 +5,23 @@ \alias{getPath} \title{Path utilities} \usage{ -pushPath(path, session = getDefaultReactiveDomain()) +pushPath( + path, + mode = c("push", "replace"), + session = getDefaultReactiveDomain() +) getPath(session = getDefaultReactiveDomain()) } \arguments{ \item{path}{A character string specifying a new URL path} +\item{mode}{Either `"push"` or `"replace"`. If `"push"`, the default, the +path is pushed onto the history stack and pressing the back button in the +browser will redirect to the current path (before pushing the path). If +`"replace"`, then the pushed path will replace the current path without +changing the next page in the browser's back button stack.} + \item{session}{A reactive context, defaults to `shiny::getDefaultReactiveDomain()`.} } diff --git a/tests/testthat/app-002.R b/tests/testthat/app-002.R index f6c4ff0..a421fac 100644 --- a/tests/testthat/app-002.R +++ b/tests/testthat/app-002.R @@ -30,7 +30,7 @@ shinyApp( observePath("/explore/:animal", { state$explore <- div( - h5("Explore", param("animal")) + h5("Explore", blaze:::param("animal")) ) }) diff --git a/tests/testthat/test-blaze.R b/tests/testthat/test-blaze.R new file mode 100644 index 0000000..488607e --- /dev/null +++ b/tests/testthat/test-blaze.R @@ -0,0 +1,3 @@ +test_that("blaze()", { + expect_s3_class(blaze(), "html_dependency") +})