Support for index page templating (#168)

Author: HammadTheOne

DESCRIPTION

@@ -1,14 +1,14 @@
 Package: dash
 Title: An Interface to the Dash Ecosystem for Authoring Reactive Web Applications
-Version: 0.2.0
+Version: 0.3.0
 Authors@R: c(person("Chris", "Parmer", role = c("aut"), email = "[email protected]"), person("Ryan Patrick", "Kyle", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5829-9867"), email = "[email protected]"), person("Carson", "Sievert", role = c("aut"), comment = c(ORCID = "0000-0002-4958-2844")), person(family = "Plotly Technologies", role = "cph")) 
 Description: A framework for building analytical web applications, Dash offers a pleasant and productive development experience. No JavaScript required.
 Depends:
   R (>= 3.0.2)
 Imports:
   dashHtmlComponents (== 1.0.2),
-  dashCoreComponents (== 1.6.0),
-  dashTable (== 4.5.1),
+  dashCoreComponents (== 1.8.0),
+  dashTable (== 4.6.0),
   R6,
   fiery (> 1.0.0),
   routr (> 0.2.0),
@@ -32,8 +32,8 @@ Collate:
   'print.R'
   'internal.R'
 Remotes: plotly/dash-html-components@55c3884,
-  plotly/dash-core-components@c107e0f,
-  plotly/dash-table@3058bd5
+  plotly/dash-core-components@fc153b4,
+  plotly/dash-table@79d46ca
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -27,4 +27,4 @@ importFrom(routr,RouteStack)
 importFrom(routr,ressource_route)
 importFrom(stats,setNames)
 importFrom(tools,file_ext)
-importFrom(utils,getFromNamespace)
+importFrom(utils,getFromNamespace)

R/dash.R

@@ -5,7 +5,7 @@
 #' @usage Dash
 #'
 #' @section Constructor: Dash$new(
-#'   name = "dash",
+#'   name = NULL,
 #'   server = fiery::Fire$new(),
 #'   assets_folder = 'assets',
 #'   assets_url_path = '/assets',
@@ -24,7 +24,7 @@
 #' @section Arguments:
 #' \tabular{lll}{
 #'   `name` \tab \tab Character. The name of the Dash application (placed in the `<title>`
-#'   of the HTML page).\cr
+#'   of the HTML page). DEPRECATED; please use `index_string()` or `interpolate_index()` instead.\cr
 #'   `server` \tab \tab The web server used to power the application.
 #'   Must be a [fiery::Fire] object.\cr
 #'   `assets_folder` \tab \tab Character. A path, relative to the current working directory,
@@ -100,6 +100,9 @@
 #'     from the Dash backend. The latter may offer improved performance relative
 #'     to callbacks written in R.
 #'   }
+#'   \item{`title("dash")`}{
+#'     The title of the app. If no title is supplied, Dash for R will use 'dash'.
+#'   }
 #'   \item{`callback_context()`}{
 #'     The `callback_context` method permits retrieving the inputs which triggered
 #'     the firing of a given callback, and allows introspection of the input/state
@@ -114,7 +117,63 @@
 #'     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{`run_server(host =  Sys.getenv('HOST', "127.0.0.1"),
+#'  \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,
+#'     are some examples of features that can be modified.
+#'     This method will present a warning if your HTML template is missing any necessary elements
+#'     and return an error if a valid index is not defined. The following interpolation keys are
+#'     currently supported:
+#'     \describe{
+#'          \item{`{%metas%}`}{Optional - The registered meta tags.}
+#'          \item{`{%favicon%}`}{Optional - A favicon link tag if found in assets.}
+#'          \item{`{%css%}`}{Optional - Link tags to css resources.}
+#'          \item{`{%config%}`}{Required - Config generated by dash for the renderer.}
+#'          \item{`{%app_entry%}`}{Required - The container where dash react components are rendered.}
+#'          \item{`{%scripts%}`}{Required - Collected dependencies scripts tags.}
+#'          }
+#'     \describe{
+#'          \item{Example of a basic HTML index string:}{
+#'          \preformatted{
+#' "<!DOCTYPE html>
+#' <html>
+#'  <head>
+#'   \{\%meta_tags\%\}
+#'      <title>\{\{%css\%\}\}</title>
+#'      \{\%favicon\%\}
+#'      \{\%css_tags\%\}
+#'  </head>
+#'   <body>
+#'     \{\%app_entry\%\}
+#'     <footer>
+#'      \{\%config\%\}
+#'      \{\%scripts\%\}
+#'     </footer>
+#'   </body>
+#' </html>"
+#'              }
+#'          }
+#'      }
+#'  }
+#'  \item{`interpolate_index(template_index, ...)`}{
+#'     With the `interpolate_index` method, we can pass a custom index with template string
+#'     variables that are already evaluated. We can directly pass arguments to the `template_index`
+#'     by assigning them to variables present in the template. This is similar to the `index_string` method
+#'     but offers the ability to change the default components of the Dash index as seen in the example below:
+#'     \preformatted{
+#'     app$interpolate_index(
+#'       template_index, 
+#'       metas = "<meta_charset='UTF-8'/>", 
+#'       renderer = renderer, 
+#'       config = config)
+#'     }
+#'     \describe{
+#'     \item{template_index}{Character. A formatted string with the HTML index string. Defaults to the initial template}
+#'     \item{...}{Named List. The unnamed arguments can be passed as individual named lists corresponding to the components
+#'     of the Dash html index. These include the same arguments as those found in the `index_string()` template.}
+#'     }
+#'  } 
+#'  \item{`run_server(host =  Sys.getenv('HOST', "127.0.0.1"),
 #'    port = Sys.getenv('PORT', 8050), block = TRUE, showcase = FALSE, ...)`}{
 #'     The `run_server` method has 13 formal arguments, several of which are optional:
 #'     \describe{
@@ -174,7 +233,7 @@ Dash <- R6::R6Class(
     config = list(),
 
     # i.e., the Dash$new() method
-    initialize = function(name = "dash",
+    initialize = function(name = NULL,
                           server = fiery::Fire$new(),
                           assets_folder = 'assets',
                           assets_url_path = '/assets',
@@ -191,13 +250,18 @@ Dash <- R6::R6Class(
                           suppress_callback_exceptions = FALSE) {
 
       # argument type checking
-      assertthat::assert_that(is.character(name))
       assertthat::assert_that(inherits(server, "Fire"))
       assertthat::assert_that(is.logical(serve_locally))
       assertthat::assert_that(is.logical(suppress_callback_exceptions))
 
       # save relevant args as private fields
-      private$name <- name
+      if (!is.null(name)) {
+        warning(sprintf(
+          "The supplied application title, '%s', should be set using the title() method, or passed via index_string() or interpolate_index(); it has been ignored, and 'dash' will be used instead.",
+          name),
+          call. = FALSE
+        )
+      }
       private$serve_locally <- serve_locally
       private$eager_loading <- eager_loading
       # remove leading and trailing slash(es) if present
@@ -763,11 +827,44 @@ Dash <- R6::R6Class(
                         sep="/")))
     },
 
+    # ------------------------------------------------------------------------
+    # specify a custom index string
+    # ------------------------------------------------------------------------
+    index_string = function(string) {
+      private$custom_index <- validate_keys(string)
+    },
+    
+    # ------------------------------------------------------------------------
+    # modify the templated variables by using the `interpolate_index` method. 
+    # ------------------------------------------------------------------------
+    interpolate_index = function(template_index = private$template_index[[1]], ...) {
+      template = template_index
+      kwargs <- list(...)
+      
+      for (name in names(kwargs)) {
+        key = paste0('\\{\\%', name, '\\%\\}')
+        template = sub(key, kwargs[[name]], template)
+      } 
+      
+      invisible(validate_keys(names(kwargs)))
+      
+      private$template_index <- template
+    },
+    
+    # ------------------------------------------------------------------------
+    # specify a custom title
+    # ------------------------------------------------------------------------
+    title = function(string = "dash") {
+      assertthat::assert_that(is.character(string))
+      private$name <- string
+    },
+        
     # ------------------------------------------------------------------------
     # convenient fiery wrappers
     # ------------------------------------------------------------------------
     run_server = function(host = Sys.getenv('HOST', "127.0.0.1"),
                           port = Sys.getenv('PORT', 8050),
+
                           block = TRUE,
                           showcase = FALSE,
                           use_viewer = FALSE,
@@ -1266,6 +1363,24 @@ Dash <- R6::R6Class(
 
     # akin to https://github.com/plotly/dash/blob/d2ebc837/dash/dash.py#L338
     # note discussion here https://github.com/plotly/dash/blob/d2ebc837/dash/dash.py#L279-L284
+    custom_index = NULL,
+    template_index = c(
+    "<!DOCTYPE html>
+        <html>
+          <head>
+            {%meta_tags%}
+            <title>{%title%}</title>
+            {%favicon%}
+            {%css_tags%}
+          </head>
+          <body>
+            {%app_entry%}
+            <footer>
+              {%config%}
+              {%scripts%}
+            </footer>
+          </body>
+        </html>", NA),
     .index = NULL,
 
     generateReloadHash = function() {
@@ -1434,13 +1549,32 @@ Dash <- R6::R6Class(
       css_tags <- all_tags[["css_tags"]]
 
       # retrieve script tags for serving in the index
-      scripts_tags <- all_tags[["scripts_tags"]]
+      scripts <- all_tags[["scripts_tags"]]
 
       # insert meta tags if present
       meta_tags <- all_tags[["meta_tags"]]
+      
+      # define the react-entry-point
+      app_entry <- "<div id='react-entry-point'><div class='_dash-loading'>Loading...</div></div>"
+      # define the dash default config key
+      config <- sprintf("<script id='_dash-config' type='application/json'> %s </script>", to_JSON(self$config))
+
+      if (is.null(private$name))
+        private$name <- 'dash'
+      
+      if (!is.null(private$custom_index)) {
+        string_index <- glue::glue(private$custom_index, .open = "{%", .close = "%}")
+        
+        private$.index <- string_index
+      }
+      
+      else if (length(private$template_index) == 1) {
+        private$.index <- private$template_index
+      }
 
-      private$.index <- sprintf(
-        '<!DOCTYPE html>
+      else {
+        private$.index <- sprintf(
+       '<!DOCTYPE html>
         <html>
           <head>
             %s
@@ -1450,23 +1584,22 @@ Dash <- R6::R6Class(
           </head>
 
           <body>
-            <div id="react-entry-point">
-              <div class="_dash-loading">Loading...</div>
-            </div>
-
+            %s
             <footer>
-              <script id="_dash-config" type="application/json"> %s </script>
+              %s
               %s
             </footer>
           </body>
         </html>',
-        meta_tags,
-        private$name,
-        favicon,
-        css_tags,
-        to_JSON(self$config),
-        scripts_tags
-      )
+          meta_tags,
+          private$name,
+          favicon,
+          css_tags,
+          app_entry,
+          config,
+          scripts
+        )
+      }
     }
   )
 )

R/utils.R

@@ -1270,3 +1270,33 @@ tryCompress <- function(request, response) {
   }
   return(response$compress())
 }
+
+interpolate_str <- function(index_template, ...) {
+  # This function takes an index string, along with
+  # user specified keys for the html keys of the index
+  # and sets the default values of the keys to the 
+  # ones specified by the keys themselves, returning
+  # the custom index template. 
+  template = index_template 
+  kwargs <- list(...)
+  
+  for (name in names(kwargs)) {
+    key = paste0('\\{', name, '\\}')
+    
+    template = sub(key, kwargs[[name]], template)
+  } 
+  return(template)
+}
+
+validate_keys <- function(string) {
+  required_keys <- c("app_entry", "config", "scripts")
+  
+  keys_present <- vapply(required_keys, function(x) grepl(x, string), logical(1))
+  
+  if (!all(keys_present)) {
+    stop(sprintf("Did you forget to include %s in your index string?", 
+                 paste(names(keys_present[keys_present==FALSE]), collapse = ", ")))
+  } else {
+    return(string)
+  }
+}

README.md

@@ -1,4 +1,4 @@
-[![CircleCI](https://circleci.com/gh/plotly/dashR/tree/dev.svg?style=svg)](https://circleci.com/gh/plotly/dashR/tree/dev)
+[![CircleCI](https://circleci.com/gh/plotly/dashR/tree/master.svg?style=svg)](https://circleci.com/gh/plotly/dashR/tree/master)
 [![GitHub](https://img.shields.io/github/license/plotly/dashR.svg?color=dark-green)](https://github.com/plotly/dashR/blob/master/LICENSE)
 [![GitHub commit activity](https://img.shields.io/github/commit-activity/y/plotly/dashR.svg?color=dark-green)](https://github.com/plotly/dashR/graphs/contributors)