feat(observePath): param() and query() helpers

nteetor · Nov 20, 2020 · 0adb2ec · 0adb2ec
1 parent eb1ac2a
commit 0adb2ec
Show file tree

Hide file tree

Showing 6 changed files with 152 additions and 35 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -12,7 +12,7 @@ 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,

diff --git a/NAMESPACE b/NAMESPACE
@@ -5,6 +5,7 @@ export(observePath)
 export(param)
 export(pathLink)
 export(pushPath)
+export(query)
 importFrom(fs,dir_create)
 importFrom(fs,dir_delete)
 importFrom(fs,dir_exists)

diff --git a/R/paths.R b/R/paths.R
@@ -50,13 +50,24 @@ paths <- function(...) {
       d <- paste0("/", d)
     }
 
-    cat(file = index, sprintf("
+    # Preserving query string and hash fragment was first brought up by
+    # garrick in #1
+    cat(file = index, "
       <!DOCTYPE html>
       <html>
-      <head><script>window.location.replace(\"/?redirect=%s\")</script></head>
+      <head>
+      <script>
+      (function() {
+        let {origin, pathname, search, hash} = window.location;
+        let redirect = `redirect=${ pathname }`;
+        let uri = `${ origin }${ search }${ search ? '&' : '?' }${ redirect }${ hash }`;
+        window.location.replace(uri);
+      })();
+      </script>
+      </head>
       <body>Redirecting</body>
-      </html>", d
-    ))
+      </html>"
+    )
   })
 
   invisible(tmp)

diff --git a/R/url.R b/R/url.R
@@ -21,6 +21,25 @@
 #' @param domain A reactive context, defaults to
 #'   `shiny::getDefaultReactiveDomain()`.
 #'
+#' @param x A bare name specifying a URL
+#'
+#' @section `param()` and `query()`:
+#'
+#' You may want a handler expression to use information from or pieces of a URL.
+#' Currently, two helper functions exist to extract information from the URL.
+#'
+#' With `param()` we can capture pieces of the URL path if `path` is a regular
+#' expression. To capture a portion of the URL we need to use regular expression
+#' named capture groups. Here is an example, `"/about/(?<subject>[a-z]+)"`. In
+#' this example we have a param named subject. To get this value we can call
+#' `param(subject)` in the handler expression.
+#'
+#' With `query()` we can check for values in the URL's query string. In the URL
+#' `https://demo.org/?p=10&view=all` the query string contains `p` and `view`
+#' with values `10` and `"all"`, respectively. To check for these values we can
+#' call `query(p)` and `query(view)` inside our handler expression. If the values
+#' are not present in the query string `NULL` is returned.
+#'
 #' @export
 observePath <- function(path, handler, env = parent.frame(), quoted = FALSE,
                         ..., domain = getDefaultReactiveDomain()) {
@@ -31,14 +50,15 @@ observePath <- function(path, handler, env = parent.frame(), quoted = FALSE,
 
   o <- observe({
     url <- domain$clientData$url_state
+    search <- domain$clientData$url_search_object
 
     req(!is.null(url))
 
     is_match <- grepl(pattern = path, x = url, ..., perl = TRUE)
 
     req(is_match)
 
-    mask <- mask_params(path, url)
+    mask <- url_mask(path, url, search)
 
     isolate(rlang::eval_tidy(h_quo, mask, env))
   }, domain = domain)
@@ -69,33 +89,47 @@ as_route <- function(x) {
   x
 }
 
-mask_params <- function(path, url) {
+url_mask <- function(path, url, search) {
   matches <- re_match(url, path)
+  e <- rlang::new_environment()
+
+  if (NCOL(matches) > 2) {
+    params <- as.list(matches[1, seq_len(NCOL(matches) - 2)])
 
-  if (NCOL(matches) == 2) {
-    return(NULL)
+    param_local <- function(x) {
+      sym_x <- rlang::ensym(x)
+      name_x <- rlang::as_name(sym_x)
+      params[[name_x]]
+    }
+
+    e$param <- param_local
   }
 
-  params <- as.list(matches[1, seq_len(NCOL(matches) - 2)])
+  if (length(search) > 0) {
+    search <- as.list(search)
+
+    query_local <- function(x) {
+      sym_x <- rlang::ensym(x)
+      name_x <- rlang::as_name(sym_x)
+      search[[name_x]]
+    }
+
+    e$query <- query_local
+  }
 
-  # not good
-  list(param = function(x) {
-    sym_x <- rlang::ensym(x)
-    name_x <- rlang::as_name(sym_x)
-    params[[name_x]]
-  })
+  rlang::new_data_mask(bottom = e)
 }
 
 #' @rdname observePath
 #' @export
-param <- function(x, params = peek_params()) {
-  sym_x <- rlang::ensym(x)
-  name_x <- rlang::as_name(sym_x)
-  params[[name_x]]
+param <- function(x) {
+  invisible()
 }
 
-peek_params <- function() {
-  emptyenv()
+#' @rdname observePath
+#' @export
+query <- function(x) {
+  invisible()
 }
 
 #' Path utilities

diff --git a/inst/www/js/blaze.js b/inst/www/js/blaze.js
@@ -1,19 +1,67 @@
 (function($, Shiny) {
-  var sendState = function(value) {
-    Shiny.setInputValue(".clientdata_url_state", value, { priority: "event" });
+  let URLSearchObject = function(search) {
+    let params = new URLSearchParams(search);
+    return Array.from(params).map(p => ({ [p[0]]: p[1] }));
+  };
+
+  // Original author garrick, see #1
+  var getURLComponents = function() {
+    const params = new URLSearchParams(window.location.search);
+    params.delete("redirect");
+    return {
+      params: params,
+      pathname: window.location.pathname,
+      hash: window.location.hash
+    };
+  };
+
+  // Original author garrick, see #1
+  var pathURI = function(redirect) {
+    if (!redirect || redirect == window.location.pathname) {
+      return false;
+    }
+
+    let {params, hash} = getURLComponents();
+
+    if (params.toString()) {
+      redirect += `?${ params }`;
+    }
+
+    return `${ redirect }${ hash }`;
+  };
+
+  var pushState = function(path) {
+    path = pathURI(path);
+    history.pushState(path, null, path);
+  };
+
+  var replaceState = function(path) {
+    path = pathURI(path);
+    history.replaceState(path, null, path);
+  };
+
+  var sendState = function(path) {
+    Shiny.setInputValue(".clientdata_url_state", path, { priority: "event" });
+  };
+
+  let sendParams = function(search) {
+    const o = URLSearchObject(search);
+    console.log(o);
+    Shiny.setInputValue(".clientdata_url_search_object", o, { priority: "event" });
   };
 
   (function() {
     const params = new URLSearchParams(window.location.search);
     const redirect = params.get("redirect") || "/";
 
     if (redirect !== "/") {
-      history.replaceState(redirect, null, redirect);
+      replaceState(redirect);
     }
 
     window.addEventListener("DOMContentLoaded", function() {
       $(document).one("shiny:sessioninitialized", function() {
         sendState(redirect);
+        sendParams(window.location.search);
       });
     });
   })();
@@ -29,29 +77,28 @@
       if (target !== event.currentTarget) {
         event.preventDefault();
 
-        var uri = target.getAttribute("href");
+        let href = target.getAttribute("href");
+        let uri = new URL(href, window.location.origin);
 
-        if (uri !== window.location.pathname) {
-          sendState(uri);
-          history.pushState(uri, null, uri);
+        if (uri.pathname !== window.location.pathname) {
+          sendState(uri.pathname);
+          sendParams(uri.search);
+          history.pushState(href, null, href);
         }
       }
 
       event.stopPropagation();
     });
 
     Shiny.addCustomMessageHandler("blaze:pushstate", function(msg) {
-      var _path = function(path) {
-        history.pushState(path, null, path);
-      };
-
       if (msg.path) {
-        _path(msg.path);
+        pushState(msg.path);
       }
     });
   });
 
   window.addEventListener("popstate", function(event) {
     sendState(event.state || "/");
+    sendParams(window.location.search);
   });
 })(window.jQuery, window.Shiny);
diff --git a/man/observePath.Rd b/man/observePath.Rd