Nothing
context("templates")
# Searches for an html dependency of format name[version], as in "d3[3.5.10]",
# within the html-dependencies script tag
findDep <- function(x, name, version) {
deps <- sub(
'.*<script type="application/html-dependencies">([^<]*)</script>.*',
"\\1",
x
)
grepl(paste0(name, "[", version, "]"), deps, fixed = TRUE)
}
test_that("Code blocks are evaluated and rendered correctly", {
template <- htmlTemplate(test_path("template-document.html"),
x = div(class = "foo", "bar")
)
html <- renderDocument(template)
expect_true(grepl('<div class="foo">bar</div>', html))
# With text_ argument
template <- htmlTemplate(text_ = "a {{ foo + 1 }} b", foo = 10)
expect_identical(as.character(as.character(template)), "a 11 b")
# Make char vectors are pasted together
template <- htmlTemplate(text_ = c("a", "{{ foo + 1 }} b"), foo = 10)
expect_identical(as.character(as.character(template)), "a\n11 b")
})
test_template <- function(){
template <- htmlTemplate(test_path("template-document.html"), x = "")
html <- renderDocument(template)
expect_identical(Encoding(html), "UTF-8")
# Create the string 'Δ★😎', making sure it's UTF-8 encoded on all platforms.
# These characters are 2, 3, and 4 bytes long, respectively.
pat <- rawToChar(as.raw(c(0xce, 0x94, 0xe2, 0x98, 0x85, 0xf0, 0x9f, 0x98, 0x8e)))
Encoding(pat) <- "UTF-8"
expect_true(grepl(pat, html))
# If template is passed text_ argument, make sure it's converted from native
# to UTF-8.
latin1_str <- rawToChar(as.raw(0xFF))
Encoding(latin1_str) <- "latin1"
text <- as.character(htmlTemplate(text_ = latin1_str))
expect_identical(charToRaw(text), as.raw(c(0xc3, 0xbf)))
}
test_that("UTF-8 characters in templates with default locale", {
# The default locale
loc <- ""
withr::with_locale(c(LC_COLLATE=loc, LC_CTYPE=loc, LC_MONETARY=loc, LC_TIME=loc), test_template())
})
test_that("UTF-8 characters in templates with Chinese locale", {
# Chinese locale
loc <- "Chinese"
testthat::skip_if_not(is_locale_available(loc), "Chinese locale not available")
withr::with_locale(c(LC_COLLATE=loc, LC_CTYPE=loc, LC_MONETARY=loc, LC_TIME=loc), test_template())
})
test_that("UTF-8 characters in template head but not body", {
# On Windows, a string with "中文" will automatically be marked as UTF-8.
ui <- tagList(
tags$head(tags$script("alert('中文')")),
"test"
)
html <- htmlTemplate(test_path("template-basic.html"), body = ui)
res <- renderDocument(html)
expect_identical(Encoding(res), "UTF-8")
expect_true(grepl("中文", res, fixed = TRUE))
# On Windows, a string with "á" will automatically be marked as latin1.
ui <- tagList(
tags$head(tags$script("alert('á')")),
"test"
)
html <- htmlTemplate(test_path("template-basic.html"), body = ui)
res <- renderDocument(html)
expect_identical(Encoding(res), "UTF-8")
expect_true(grepl("á", res, fixed = TRUE))
})
test_that("Dependencies are added properly", {
dep <- htmlDependency("d3", "3.5.10", c(href="shared"), script = "d3.js")
# Add dependency by inserting a tag with a dependency
template <- htmlTemplate(test_path("template-document.html"),
x = attachDependencies(div(), dep)
)
html <- renderDocument(template)
expect_true(findDep(html, "d3", "3.5.10"))
expect_true(grepl('<script src="shared/d3.js"></script>', html, fixed = TRUE))
# Add dependency via a renderDocument
template <- htmlTemplate(test_path("template-document.html"), x = "")
html <- renderDocument(template, dep)
expect_true(findDep(html, "d3", "3.5.10"))
expect_true(grepl('<script src="shared/d3.js"></script>', html, fixed = TRUE))
})
test_that("Dependencies can be suppressed", {
# The template includes suppressDependencies("jquery"), so we shouldn't see
# this dependency in the final output.
dep <- htmlDependency("jquery", "1.11.3", c(href="shared"), script = "jquery.js")
# Add dependency by inserting a tag with a dependency
template <- htmlTemplate(test_path("template-document.html"),
x = attachDependencies(div(), dep)
)
html <- renderDocument(template)
expect_true(findDep(html, "jquery", "9999"))
expect_false(grepl('<script[^>]+jquery[^>]+>', html))
# Add dependency via a renderDocument
template <- htmlTemplate(test_path("template-document.html"), x = "")
html <- renderDocument(template, dep)
expect_true(findDep(html, "jquery", "9999"))
expect_false(grepl('<script[^>]+jquery[^>]+>', html))
})
test_that("Errors for mismatched brackets", {
# Error if unmatched opening brackets
expect_error(htmlTemplate(text_ = "text {{ code"))
# No error if we didn't open a code block
expect_identical(
as.character(htmlTemplate(text_ = "code }} text")),
"code }} text"
)
# Error if unmatched brackets, when no leading or trailing space
expect_error(htmlTemplate(text_ = "{{ code"))
# No error if we didn't open a code block
expect_identical(
as.character(htmlTemplate(text_ = "code }}")),
"code }}"
)
})
test_that("Brackets at start or end of text", {
# Code and text
expect_identical(
as.character(htmlTemplate(text_ = "text {{ code }} text", code = 1)),
"text 1 text"
)
expect_identical(
as.character(htmlTemplate(text_ = "text{{code}}text", code = 1)),
"text1text"
)
# No brackets
expect_identical(
as.character(htmlTemplate(text_ = "text", code = 1)),
"text"
)
# No leading or trailing text
expect_identical(
as.character(htmlTemplate(text_ = "{{ code }}", code = 1)),
"1"
)
expect_identical(
as.character(htmlTemplate(text_ = " {{ code }}", code = 1)),
" 1"
)
expect_identical(
as.character(htmlTemplate(text_ = "{{ code }} ", code = 1)),
"1 "
)
# Edge cases
expect_identical(as.character(htmlTemplate(text_ = "")), "")
expect_identical(as.character(htmlTemplate(text_ = "X")), "X")
expect_identical(as.character(htmlTemplate(text_ = " ")), " ")
expect_identical(as.character(htmlTemplate(text_ = "{{}}")), "")
expect_identical(as.character(htmlTemplate(text_ = " {{}} ")), " ")
expect_identical(as.character(htmlTemplate(text_ = "{{ }}")), "")
expect_identical(as.character(htmlTemplate(text_ = "{{}}{{}}")), "")
expect_identical(as.character(htmlTemplate(text_ = "{{1}}{{2}}")), "12")
expect_error(as.character(htmlTemplate(text_ = "{{")))
expect_error(as.character(htmlTemplate(text_ = " {{")))
expect_error(as.character(htmlTemplate(text_ = "{{ ")))
expect_identical(as.character(htmlTemplate(text_ = "}}")), "}}")
expect_identical(as.character(htmlTemplate(text_ = " }}")), " }}")
expect_identical(as.character(htmlTemplate(text_ = "}} ")), "}} ")
})
test_that("Template DFA edge cases", {
# Single quotes
expect_identical(as.character(htmlTemplate(text_ = "{{ '' }}")), "")
expect_identical(as.character(htmlTemplate(text_ = " {{ '' }} ")), " ")
expect_identical(as.character(htmlTemplate(text_ = "{{ '\\'' }}")), "'")
expect_identical(as.character(htmlTemplate(text_ = "{{ '\\\\' }}")), "\\")
expect_identical(as.character(htmlTemplate(text_ = "{{ '}}' }}")), "}}")
# Double quotes
expect_identical(as.character(htmlTemplate(text_ = '{{ "" }}')), '')
expect_identical(as.character(htmlTemplate(text_ = ' {{ "" }} ')), ' ')
expect_identical(as.character(htmlTemplate(text_ = '{{ "\\"" }}')), '"')
expect_identical(as.character(htmlTemplate(text_ = '{{ "\\\\" }}')), '\\')
expect_identical(as.character(htmlTemplate(text_ = '{{ "}}" }}')), '}}')
# Backticks in code
expect_identical(as.character(htmlTemplate(text_ = "{{ `}}`<-1 }}")), "1")
expect_identical(as.character(htmlTemplate(text_ = "{{ `x\\`x`<-1 }}")), "1")
# Percent operator - various delimiters in percent operator
expect_identical(
as.character(htmlTemplate(text_ = "a{{ `%'%` <- function(x, y) 1; 2 %'% 3 }}b")),
"a1b"
)
expect_identical(
as.character(htmlTemplate(text_ = "a{{ `%}}%` <- function(x, y) 1; 2 %}}% 3 }}b")),
"a1b"
)
# Comments
expect_identical(
as.character(htmlTemplate(text_ = "a{{ 1 #2 }}b")),
"a1b"
)
expect_identical(
as.character(htmlTemplate(text_ = "a{{ 1 #2\n3 }}b")),
"a3b"
)
expect_identical(
as.character(htmlTemplate(text_ = "a{{ 1 #2'3 }}b")),
"a1b"
)
expect_identical(
as.character(htmlTemplate(text_ = "a{{ 1 #2}3 }}b")),
"a1b"
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.