Support for meta tags in Dash for R (#142)

rpkyle · web-flow · commit f866d38f8935 · 2019-11-05T11:14:20.000-05:00
* ✨ initial support for meta tags

* support arbitrary tags

* 🚨 add tests

* 🔬 add asserts

* add reference to meta tag PR

* ⏩ indent meta tags
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -3,6 +3,7 @@ All notable changes to this project will be documented in this file.
 
 ## Unreleased
 ### Added
+- Support for adding `<meta>` tags to index [#142](https://github.com/plotly/dashR/pull/142)
 - Hot reloading now supported in debug mode [#127](https://github.com/plotly/dashR/pull/127)
 - Support for displaying Dash for R applications within RStudio's viewer pane when `use_viewer = TRUE`
 - Clientside callbacks written in JavaScript are now supported [#130](https://github.com/plotly/dashR/pull/130)
diff --git a/R/dash.R b/R/dash.R
@@ -11,6 +11,7 @@
 #'   assets_url_path = '/assets',
 #'   assets_ignore = '',
 #'   serve_locally = TRUE,
+#'   meta_tags = NULL,
 #'   routes_pathname_prefix = '/',
 #'   requests_pathname_prefix = '/',
 #'   external_scripts = NULL,
@@ -34,6 +35,9 @@
 #'   cannot use this to prevent access to sensitive files. \cr
 #'   `serve_locally` \tab \tab Whether to serve HTML dependencies locally or
 #'   remotely (via URL).\cr
+#'   `meta_tags` \tab \tab List of lists. HTML `<meta>`tags to be added to the index page.
+#'   Each list element should have the attributes and values for one tag, eg:
+#'   `list(name = 'description', content = 'My App')`.\cr
 #'   `routes_pathname_prefix` \tab \tab a prefix applied to the backend routes.\cr
 #'   `requests_pathname_prefix` \tab \tab a prefix applied to request endpoints
 #'   made by Dash's front-end.\cr
@@ -158,6 +162,7 @@ Dash <- R6::R6Class(
                           assets_url_path = '/assets',
                           assets_ignore = '',
                           serve_locally = TRUE,
+                          meta_tags = NULL,
                           routes_pathname_prefix = NULL,
                           requests_pathname_prefix = NULL,
                           external_scripts = NULL,
@@ -181,6 +186,7 @@ Dash <- R6::R6Class(
       private$suppress_callback_exceptions <- suppress_callback_exceptions
       private$app_root_path <- getAppPath()
       private$app_launchtime <- as.integer(Sys.time())
+      private$meta_tags <- meta_tags
 
       # config options
       self$config$routes_pathname_prefix <- resolve_prefix(routes_pathname_prefix, "DASH_ROUTES_PATHNAME_PREFIX")
@@ -815,6 +821,7 @@ Dash <- R6::R6Class(
     # private fields defined on initiation
     name = NULL,
     serve_locally = NULL,
+    meta_tags = NULL,
     assets_folder = NULL,
     assets_url_path = NULL,
     assets_ignore = NULL,
@@ -1231,17 +1238,21 @@ Dash <- R6::R6Class(
       css_tags <- paste(c(css_deps,
                           css_external,
                           css_assets),
-                        collapse = "\n")
+                        collapse = "\n            ")
 
       scripts_tags <- paste(c(scripts_deps,
                               scripts_external,
                               scripts_assets,
                               scripts_invoke_renderer),
-                            collapse = "\n")
+                            collapse = "\n              ")
 
+      meta_tags <- paste(generate_meta_tags(private$meta_tags),
+                         collapse = "\n            ")
+      
       return(list(css_tags = css_tags,
                   scripts_tags = scripts_tags,
-                  favicon = favicon))
+                  favicon = favicon,
+                  meta_tags = meta_tags))
     },
 
     index = function() {
@@ -1257,11 +1268,14 @@ Dash <- R6::R6Class(
       # retrieve script tags for serving in the index
       scripts_tags <- all_tags[["scripts_tags"]]
 
+      # insert meta tags if present
+      meta_tags <- all_tags[["meta_tags"]]
+      
       private$.index <- sprintf(
         '<!DOCTYPE html>
         <html>
           <head>
-            <meta charset="UTF-8"/>
+            %s
             <title>%s</title>
             %s
             %s
@@ -1278,6 +1292,7 @@ Dash <- R6::R6Class(
             </footer>
           </body>
         </html>',
+        meta_tags,
         private$name,
         favicon,
         css_tags,
diff --git a/R/utils.R b/R/utils.R
@@ -607,6 +607,32 @@ generate_js_dist_html <- function(href,
   }
 }
 
+generate_meta_tags <- function(metas) {
+  has_ie_compat <- any(vapply(metas, function(x) 
+    x$name == "http-equiv" && x$content == "X-UA-Compatible", 
+    logical(1)), na.rm=TRUE)
+  has_charset <- any(vapply(metas, function(x) 
+    "charset" %in% names(x), 
+    logical(1)), na.rm=TRUE)
+  
+  # allow arbitrary tags with varying numbers of keys
+  tags <- vapply(metas, 
+                 function(tag) sprintf("<meta %s>", paste(sprintf("%s=\"%s\"", 
+                                                                  names(tag), 
+                                                                  unlist(tag, use.names = FALSE)), 
+                                                          collapse=" ")),
+                 character(1))
+  
+  if (!has_ie_compat) {
+    tags <- c('<meta http-equiv=\"X-UA-Compatible\" content=\"IE=edge\">', tags)
+  }
+  
+  if (!has_charset) {
+    tags <- c('<meta charset=\"UTF-8\">', tags)
+  }
+  return(tags)
+}
+
 # This function takes the list object containing asset paths
 # for all stylesheets and scripts, as well as the URL path
 # to search, then returns the absolute local path (when
@@ -970,7 +996,7 @@ modtimeFromPath <- function(path, recursive = FALSE, asset_path="") {
     }
   } else {
     # check if the path is for a directory or file, and handle accordingly
-    if (dir.exists(path))
+    if (length(path) == 1 && dir.exists(path))
       modtime <- as.integer(max(file.info(list.files(path, full.names = TRUE))$mtime, na.rm=TRUE))
     else
       modtime <- as.integer(file.info(path)$mtime)
diff --git a/tests/integration/test_meta.py b/tests/integration/test_meta.py
@@ -0,0 +1,58 @@
+from selenium.webdriver.support.select import Select
+import time, os
+
+
+app = """
+library(dash)
+library(dashHtmlComponents)
+
+app <- Dash$new(meta_tags = list(list(name = "description", content = "some content")))
+
+app$layout(
+  htmlDiv(children = "Hello world!",
+          id = "hello-div"
+  )
+)
+
+app$run_server()
+"""
+
+
+def test_rstm001_test_meta(dashr):
+    dashr.start_server(app)
+    dashr.wait_for_text_to_equal(
+        "#hello-div",
+        "Hello world!"
+    )
+    assert dashr.find_element("meta[name='description']").get_attribute("content") == "some content"
+    assert dashr.find_element("meta[charset='UTF-8']")
+    assert dashr.find_element("meta[http-equiv='X-UA-Compatible']").get_attribute("content") == "IE=edge"
+
+
+app2 = """ 
+library(dash)
+library(dashHtmlComponents)
+
+app <- Dash$new(meta_tags = list(list(charset = "ISO-8859-1"), 
+                                 list(name = "keywords", content = "dash,pleasant,productive"), 
+                                 list(`http-equiv` = 'content-type', content = 'text/html')))
+
+app$layout(
+  htmlDiv(children = "Hello world!",
+          id = "hello-div"
+  )
+)
+
+app$run_server()
+"""
+
+
+def test_rstm002_test_meta(dashr):
+    dashr.start_server(app2)
+    dashr.wait_for_text_to_equal(
+        "#hello-div",
+        "Hello world!"
+    )
+    assert dashr.find_element("meta[charset='ISO-8859-1']")
+    assert dashr.find_element("meta[name='keywords']").get_attribute("content") == "dash,pleasant,productive"
+    assert dashr.find_element("meta[http-equiv='content-type']").get_attribute("content") == "text/html"
