Skip to content

Commit

Permalink
generate title from path; update title from server
Browse files Browse the repository at this point in the history
  • Loading branch information
@aronatkins
aronatkins committed Nov 1, 2023
1 parent 48c7970 commit e2236c2
Show file tree
Hide file tree
Showing 5 changed files with 45 additions and 138 deletions.
10 changes: 7 additions & 3 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,9 +4,13 @@
content was incorrectly published to a new location rather than reusing an
existing deployment. (#981, #1007, #1013, #1019)

* Generated application names are always normalized and lower-cased when
deploying to shinyapps.io. The name is derived from an incoming title, when
provided, and otherwise from the content path. (#1022)
* When `deployApp()` is not given `appName`, the name is generated from an
incoming title, when provided. When the title is not provided, a title is
generated from the content path, which is then used to generate the
normalized application name. (#1022)

* The application title recorded in the deployment record is updated with
server data. (#1008)

* `showLogs()`, `configureApp()`, `setProperty()`, and `unsetProperty()`
search for the application by name when there are no matching deployment
Expand Down
53 changes: 13 additions & 40 deletions R/deploymentTarget.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,10 +91,12 @@ findDeploymentTarget <- function(
# Otherwise, identify a target account (given just one available or prompted
# by the user), generate a name, and locate the deployment.
accountDetails <- findAccountInfo(account, server, error_call = error_call)
appName <- generateDefaultName(
recordPath = recordPath,
title = appTitle,
server = accountDetails$server
appTitle <- generateTitle(recordPath = recordPath, title = appTitle)
appName <- generateAppName(
appTitle = appTitle,
appPath = recordPath,
account = accountDetails$name,
unique = FALSE
)
return(findDeploymentTargetByAppName(
recordPath = recordPath,
Expand Down Expand Up @@ -319,25 +321,7 @@ updateDeployment <- function(previous, appTitle = NULL, envVars = NULL) {
)
}

normalizeName <- function(name, server = NULL) {
if (is.null(name)) {
return("")
}

if (isShinyappsServer(server)) {
name <- tolower(name)
}

# Replace non-alphanumerics with underscores, trim to length 64
name <- gsub("[^[:alnum:]_-]+", "_", name, perl = TRUE)
name <- gsub("_+", "_", name)
if (nchar(name) > 64) {
name <- substr(name, 1, 64)
}

name
}

# Generate a title from a content path.
titleFromPath <- function(recordPath) {
if (isDocumentPath(recordPath)) {
title <- file_path_sans_ext(basename(recordPath))
Expand All @@ -354,24 +338,13 @@ titleFromPath <- function(recordPath) {
title
}

# Determine name given a file or directory path and (optional) title.
#
# Prefer generating the name from the incoming title when provided and
# fall-back to one derived from the target filename.
#
# Name is guaranteed to conform to [a-zA-Z0-9_-]{0,64}. Minimum length is
# enforced by the server.
#
# Names produced for Shinyapps.io deployments are lower-cased.
generateDefaultName <- function(recordPath, title = NULL, server = NULL) {
name <- normalizeName(title, server = server)

if (nchar(name) < 3) {
title <- titleFromPath(recordPath)
name <- normalizeName(title, server = server)
# Generate a title when a title was not already specified.
generateTitle <- function(recordPath, title = NULL) {
if (is.null(title)) {
titleFromPath(recordPath)
} else {
title
}

name
}

shouldUpdateApp <- function(application,
Expand Down
2 changes: 1 addition & 1 deletion R/deployments.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ saveDeployment <- function(recordDir,
addToHistory = TRUE) {
deployment <- deploymentRecord(
name = deployment$name,
title = deployment$title,
title = application$title %||% deployment$title,
username = deployment$username,
account = deployment$account,
server = deployment$server,
Expand Down
13 changes: 1 addition & 12 deletions R/title.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -57,18 +57,7 @@ generateAppName <- function(appTitle, appPath = NULL, account = NULL, unique = T
# if we wound up with too few characters, try generating from the directory
# name instead
if (nchar(name) < 3 && !is.null(appPath) && file.exists(appPath)) {
# strip extension if present
base <- basename(appPath)
if (nzchar(tools::file_ext(base))) {
base <- file_path_sans_ext(base)

# if we stripped an extension and the name is now "index", use the parent
# folder's name
if (identical(base, "index")) {
base <- basename(dirname(appPath))
}
}
name <- munge(base)
name <- munge(titleFromPath(appPath))
}

# validate that we wound up with a valid name
Expand Down
105 changes: 23 additions & 82 deletions tests/testthat/test-deploymentTarget.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -362,30 +362,28 @@ test_that("succeeds if there are no deployments and a single account", {
expect_equal(deployment$server, "example.com")
})

test_that("default title is the empty string", {
test_that("default name and title derived from path", {
local_temp_config()
addTestServer()
addTestAccount("ron")
local_mocked_bindings(
getAppByName = function(...) data.frame(
name = "remotename",
url = "app-url",
stringsAsFactors = FALSE
)
getAppByName = function(...) NULL
)

app_dir <- withr::local_tempdir()
app_dir <- dirCreate(file.path(withr::local_tempdir(), "MyApplication"))
target <- findDeploymentTarget(app_dir, forceUpdate = TRUE)
deployment <- target$deployment
expect_equal(deployment$title, "")
expect_equal(deployment$title, "MyApplication")
expect_equal(deployment$name, "myapplication")
})

confirm_existing_app_used <- function(server) {
local_temp_config()
addTestServer()
addTestAccount("ron", server = server)
local_mocked_bindings(getAppByName = function(...) data.frame(
name = "my_app",
name = "remoteapp",
title = "Remote Application",
id = 123,
url = "http://example.com/test",
stringsAsFactors = FALSE
Expand All @@ -397,6 +395,8 @@ confirm_existing_app_used <- function(server) {
target <- findDeploymentTarget(app_dir, appName = "my_app", server = server)
deployment <- target$deployment
expect_equal(deployment$appId, 123)
expect_equal(deployment$name, "remoteapp")
expect_equal(deployment$title, "Remote Application")
}

test_that("can find existing application on server & use it", {
Expand Down Expand Up @@ -435,102 +435,43 @@ test_that("can find existing application on shinyapps.io & not use it", {
confirm_existing_app_not_used("shinyapps.io")
})

# generateDefaultName ---------------------------------------------------------
# generateTitle ---------------------------------------------------------

test_that("generateDefaultName works with sites, documents, and directories", {
test_that("generateTitle works with sites, documents, and directories", {
expect_equal(
generateDefaultName("foo/bar.Rmd", "This/is/a/TITLE"),
"This_is_a_TITLE"
generateTitle("foo/bar.Rmd", "This/is/a/TITLE"),
"This/is/a/TITLE"
)
expect_equal(
generateDefaultName("foo/bar.Rmd", "NO"),
"bar"
generateTitle("foo/bar.Rmd", "NO"),
"NO"
)

expect_equal(
generateDefaultName("foo/bar.Rmd"),
generateTitle("foo/bar.Rmd"),
"bar"
)
expect_equal(
generateDefaultName("foo/index.html"),
generateTitle("foo/index.html"),
"foo"
)
expect_equal(
generateDefaultName("foo/bar"),
generateTitle("foo/bar"),
"bar"
)

expect_equal(
generateDefaultName("foo/Awesome Document.Rmd"),
"Awesome_Document"
generateTitle("foo/Awesome Document.Rmd"),
"Awesome Document"
)
expect_equal(
generateDefaultName("My Report/index.html"),
"My_Report"
generateTitle("My Report/index.html"),
"My Report"
)
expect_equal(
generateDefaultName("foo/The-Application"),
generateTitle("foo/The-Application"),
"The-Application"
)

long_name <- strrep("AbCd", 64 / 4)
even_longer_name <- paste(long_name, "...")
expect_equal(
generateDefaultName(even_longer_name),
long_name
)
expect_equal(
generateDefaultName("short-file-path", even_longer_name),
long_name
)
})

test_that("generateDefaultName lower-cases names shinyApps", {
expect_equal(
generateDefaultName("foo/bar.Rmd", "This/is/a/TITLE", server = "shinyapps.io"),
"this_is_a_title"
)
expect_equal(
generateDefaultName("foo/bar.Rmd", "NO", server = "shinyapps.io"),
"bar"
)

expect_equal(
generateDefaultName("foo/bar.Rmd", server = "shinyapps.io"),
"bar"
)
expect_equal(
generateDefaultName("foo/index.html", server = "shinyapps.io"),
"foo"
)
expect_equal(
generateDefaultName("foo/bar", server = "shinyapps.io"),
"bar"
)

expect_equal(
generateDefaultName("foo/Awesome Document.Rmd", server = "shinyapps.io"),
"awesome_document"
)
expect_equal(
generateDefaultName("My Report/index.html", server = "shinyapps.io"),
"my_report"
)
expect_equal(
generateDefaultName("foo/The-Application", server = "shinyapps.io"),
"the-application"
)

long_name <- strrep("AbCd", 64 / 4)
even_longer_name <- paste(long_name, "...")
expect_equal(
generateDefaultName(even_longer_name, server = "shinyapps.io"),
tolower(long_name)
)
expect_equal(
generateDefaultName("short-file-path", even_longer_name, server = "shinyapps.io"),
tolower(long_name)
)
})

# helpers -----------------------------------------------------------------
Expand Down

0 comments on commit e2236c2

Please sign in to comment.