Add support for config-aware relative paths

R/dash.R

@@ -117,6 +117,27 @@
 #'     present a warning and return `NULL` if the Dash app was not loaded via `source()`
 #'     if the `DASH_APP_PATH` environment variable is undefined.
 #'   }
+#'   \item{`get_relative_path(path, requests_pathname_prefix)`}{
+#'     The `get_relative_path` method simplifies the handling of URLs and pathnames for apps
+#'     running locally and on a deployment server such as Dash Enterprise. It handles the prefix 
+#'     for requesting assets similar to the `get_asset_url` method, but can also be used for URL handling 
+#'     in components such as `dccLink` or `dccLocation`. For example, `app$get_relative_url("/page/")`
+#'     would return `/app/page/` for an app running on a deployment server. The path must be prefixed with
+#'     a `/`.
+#'     \describe{
+#'       \item{path}{Character. A path string prefixed with a leading `/` which directs at a path or asset directory.}
+#'       \item{requests_pathname_prefix}{Character. The pathname prefix for the app on a deployed application. Defaults to the environment variable set by the server, or `""` if run locally.}
+#'   }
+#'   \item{`strip_relative_path(path, requests_pathname_prefix)`}{
+#'     The `strip_relative_path` method simplifies the handling of URLs and pathnames for apps
+#'     running locally and on a deployment server such as Dash Enterprise. It acts almost opposite the `get_relative_path`
+#'     method, by taking a `relative path` as an input, and returning the `path` stripped of the `requests_pathname_prefiex`,
+#'     and any leading or trailing `/`. For example, a path string `/app/homepage/`, would be returned as 
+#'     `homepage`. This is particularly useful for `dccLocation` URL routing. 
+#'     \describe{
+#'       \item{path}{Character. A path string prefixed with a leading `/` and `requests_pathname_prefix` which directs at a path or asset directory.}
+#'       \item{requests_pathname_prefix}{Character. The pathname prefix for the app on a deployed application. Defaults to the environment variable set by the server, or `""` if run locally.}
+#'   }
 #'  \item{`index_string(string)`}{
 #'     The `index_string` method allows the specification of a custom index by changing
 #'     the default `HTML` template that is generated by the Dash UI. Meta tags, CSS, Javascript,
@@ -828,6 +849,24 @@ Dash <- R6::R6Class(
     },
 
     # ------------------------------------------------------------------------
+    # return relative asset URLs
+    # ------------------------------------------------------------------------
+
+    get_relative_path = function(path, requests_pathname_prefix = self$config$requests_pathname_prefix) {
+      asset = get_relative_path(requests_pathname = requests_pathname_prefix, path = path)
+      return(asset)
+    },
+
+
+    # ------------------------------------------------------------------------
+    # return relative asset URLs
+    # ------------------------------------------------------------------------
+
+    strip_relative_path = function(path, requests_pathname_prefix = self$config$requests_pathname_prefix) {
+      asset = strip_relative_path(requests_pathname = requests_pathname_prefix, path = path)
+      return(asset)
+    },
+
     # specify a custom index string
     # ------------------------------------------------------------------------
     index_string = function(string) {
@@ -945,7 +984,6 @@ Dash <- R6::R6Class(
         self$server$on('cycle-end', function(server, ...) {
           # handle case where assets are not present, since we can still hot reload the app itself
           #
-          # private$last_refresh is set after the asset_map is refreshed
           # private$last_reload stores the time of the last hard or soft reload event
           # private$last_cycle will be set when the cycle-end handler terminates
           #

R/utils.R

@@ -1271,6 +1271,48 @@ tryCompress <- function(request, response) {
   return(response$compress())
 }
 
+get_relative_path <- function(requests_pathname, path) {
+  # Returns a path with the config setting 'requests_pathname_prefix' prefixed to
+  # it. This is particularly useful for apps deployed on Dash Enterprise, which makes
+  # it easier to serve apps under both URL prefixes and localhost. 
+
+  if (requests_pathname == "/" && path == "") {
+    return("/")
+  }
+  else if (requests_pathname != "/" && path == "") {
+    return(requests_pathname)
+  }
+  else if (!startsWith(path, "/")) {
+    stop(sprintf(paste0("Unsupported relative path! Paths that aren't prefixed" ,
+                        "with a leading '/' are not supported. You supplied '%s'."),
+                 path))
+  }
+  else {
+    return(paste(gsub("/$", "", requests_pathname), gsub("^/", "", path), sep = "/"))
+  }
+}
+
+strip_relative_path <- function(requests_pathname, path) {
+  # Returns a relative path with the `requests_pathname_prefix` and leadings and trailing
+  # slashes stripped from it. This function is particularly relevant to dccLocation pathname routing.
+
+  if (is.null(path)) {
+    return(NULL)
+  }
+  else if ((requests_pathname != "/" && !startsWith(path, gsub("/$", "", requests_pathname)))
+          || (requests_pathname == "/" && !startsWith(path, "/"))) {
+    stop(sprintf(paste0("Unsupported relative path! Path's that are not prefixed ",
+                        "with a leading 'requests_pathname_prefix` are not suported. ",
+                        "You supplied '%s', and requests_pathname_prefix was '%s'."),
+                 path, requests_pathname
+                 ))
+  }
+  else if (requests_pathname != "/" && startsWith(path, gsub("/$", "", requests_pathname))) {
+    path = sub(gsub("/$", "", requests_pathname), "", path)
+  }
+  return(trimws(gsub("/", "", path)))
+}
+
 interpolate_str <- function(index_template, ...) {
   # This function takes an index string, along with
   # user specified keys for the html keys of the index
@@ -1299,4 +1341,4 @@ validate_keys <- function(string) {
   } else {
     return(string)
   }
-}
+}