generate title and name; name is normalized

NEWS.md

@@ -4,6 +4,14 @@
   content was incorrectly published to a new location rather than reusing an
   existing deployment. (#981, #1007, #1013, #1019)
 
+* 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
   records. (#985, #989)

R/deploymentTarget.R

@@ -91,7 +91,13 @@ 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 <- generateAppName(appTitle, recordPath, accountDetails$name, unique = FALSE)
+  appTitle <- generateTitle(recordPath = recordPath, title = appTitle)
+  appName <- generateAppName(
+    appTitle = appTitle,
+    appPath = recordPath,
+    account = accountDetails$name,
+    unique = FALSE
+  )
   return(findDeploymentTargetByAppName(
     recordPath = recordPath,
     appName = appName,
@@ -315,30 +321,30 @@ updateDeployment <- function(previous, appTitle = NULL, envVars = NULL) {
   )
 }
 
-defaultAppName <- function(recordPath, server = NULL) {
+# Generate a title from a content path.
+titleFromPath <- function(recordPath) {
   if (isDocumentPath(recordPath)) {
-    name <- file_path_sans_ext(basename(recordPath))
-    if (name == "index") {
-      # parent directory will give more informative name
-      name <- basename(dirname(recordPath))
+    title <- file_path_sans_ext(basename(recordPath))
+    if (title == "index") {
+      # parent directory will give more informative name+title
+      title <- basename(dirname(recordPath))
     } else {
       # deploying a document
     }
   } else {
     # deploying a directory
-    name <- basename(recordPath)
+    title <- basename(recordPath)
   }
+  title
+}
 
-  if (isShinyappsServer(server)) {
-    # Replace non-alphanumerics with underscores, trim to length 64
-    name <- tolower(gsub("[^[:alnum:]_-]+", "_", name, perl = TRUE))
-    name <- gsub("_+", "_", name)
-    if (nchar(name) > 64) {
-      name <- substr(name, 1, 64)
-    }
+# 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,

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,

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

tests/testthat/test-deploymentTarget.R

@@ -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
@@ -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,21 +435,43 @@ test_that("can find existing application on shinyapps.io & not use it", {
   confirm_existing_app_not_used("shinyapps.io")
 })
 
-# defaultAppName ----------------------------------------------------------
+# generateTitle ---------------------------------------------------------
 
-test_that("defaultAppName works with sites, documents, and directories", {
-  expect_equal(defaultAppName("foo/bar.Rmd"), "bar")
-  expect_equal(defaultAppName("foo/index.html"), "foo")
-  expect_equal(defaultAppName("foo/bar"), "bar")
-})
+test_that("generateTitle works with sites, documents, and directories", {
+  expect_equal(
+    generateTitle("foo/bar.Rmd", "This/is/a/TITLE"),
+    "This/is/a/TITLE"
+  )
+  expect_equal(
+    generateTitle("foo/bar.Rmd", "NO"),
+    "NO"
+  )
 
-test_that("defaultAppName reifies appNames for shinyApps", {
-  expect_equal(defaultAppName("a b c", "shinyapps.io"), "a_b_c")
-  expect_equal(defaultAppName("a!b!c", "shinyapps.io"), "a_b_c")
-  expect_equal(defaultAppName("a  b  c", "shinyapps.io"), "a_b_c")
+  expect_equal(
+    generateTitle("foo/bar.Rmd"),
+    "bar"
+  )
+  expect_equal(
+    generateTitle("foo/index.html"),
+    "foo"
+  )
+  expect_equal(
+    generateTitle("foo/bar"),
+    "bar"
+  )
 
-  long_name <- strrep("abcd", 64 / 4)
-  expect_equal(defaultAppName(paste(long_name, "..."), "shinyapps.io"), long_name)
+  expect_equal(
+    generateTitle("foo/Awesome Document.Rmd"),
+    "Awesome Document"
+  )
+  expect_equal(
+    generateTitle("My Report/index.html"),
+    "My Report"
+  )
+  expect_equal(
+    generateTitle("foo/The-Application"),
+    "The-Application"
+  )
 })
 
 # helpers -----------------------------------------------------------------