From e2236c26aee9052ac9c4bb251dba4d3a0b9a85cb Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Wed, 1 Nov 2023 09:35:05 -0400 Subject: [PATCH] generate title from path; update title from server --- NEWS.md | 10 ++- R/deploymentTarget.R | 53 +++---------- R/deployments.R | 2 +- R/title.R | 13 +-- tests/testthat/test-deploymentTarget.R | 105 ++++++------------------- 5 files changed, 45 insertions(+), 138 deletions(-) diff --git a/NEWS.md b/NEWS.md index 22f619c3..dedb27e0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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 diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 0bc8f09f..8f4e4213 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -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, @@ -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)) @@ -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, diff --git a/R/deployments.R b/R/deployments.R index 076455bb..a4abd028 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -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, diff --git a/R/title.R b/R/title.R index 16d725b7..015a1455 100644 --- a/R/title.R +++ b/R/title.R @@ -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 diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 7591ce29..8a8e8412 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -362,22 +362,19 @@ 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) { @@ -385,7 +382,8 @@ confirm_existing_app_used <- function(server) { 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 @@ -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", { @@ -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 -----------------------------------------------------------------