Add shiny app template (#47)

* create shiny app function * add css code * add gitignore * debug func * Allow overwriting of existing app * add rstudio template for shiny app * Getting images needed for favicon and logo Downloading them from this repo on Github - will need changed to master branch before merge * overwrite doc * bugfix - specify utils package * add v basic uis for each page * add readme and open it up by default * use app name in app preamble * add overwrite for phs project * update fontawesome version * move things to inst * add overwrite as arg * keep author style same as phsproject * neatening up where text loaded from * remove newline * move rproj text to communal file * load shiny app files from inst * document * load gitignore from inst * fix suggestions from alan * rename .gitignore -> gitignore.txt * update readme * update links * Update README.md * increment version
Public-Health-Scotland · Aug 31, 2022 · e59b770 · e59b770
1 parent f7eff09
commit e59b770
Show file tree

Hide file tree

Showing 26 changed files with 716 additions and 83 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -1,8 +1,7 @@
+^\\.git$
+^\\.gitignore$
 ^README\.Rmd$
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\.github$
-^\\.git$
-^\\.gitignore$
-
 
diff --git a/.gitignore b/.gitignore
@@ -1,3 +1,25 @@
 .Rproj.user
 .Rhistory
 .RData
+.Ruserdata
+
+# 'data' folder #
+data/
+
+# Common text files that may contain data #
+*.[cC][sS][vV]
+
+# Excel files #
+*.[xX][lL][sS]*
+
+# SPSS formats #
+*.[sS][aA][vV]
+*.[zZ][sS][aA][vV]
+
+# R data files #
+*.[rR][dD][aA][tT][aA]
+*.[rR][dD][sS]
+
+# MacOS folder attributes files #
+.DS_Store
+
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,9 +2,10 @@ Package: phstemplates
 Title: PHS R Templates
 Authors@R: c(
     person("Alan", "Yeung", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5226-3695")),
-    person("Anna", "Price", email = "[email protected]", role = "aut")
+    person("Anna", "Price", email = "[email protected]", role = "aut"),
+    person("Rosalyn", "Pearson", email="[email protected]", role="aut")
     )
-Version: 1.0.1
+Version: 1.1.0
 Description: Templates for Public Health Scotland.
 Depends: R (>= 3.2.0)
 License: GPL (>= 2)
@@ -27,4 +28,5 @@ Imports:
     magrittr,
     rmarkdown (>= 2.12),
     officer,
-    renv
+    renv,
+    utils
diff --git a/NAMESPACE b/NAMESPACE
@@ -6,4 +6,5 @@ export(compile_report)
 export(new_script)
 export(phs_report_docx)
 export(phsproject)
+export(phsshinyapp)
 importFrom(magrittr,"%>%")
diff --git a/R/add_gitignore.R b/R/add_gitignore.R
@@ -19,33 +19,7 @@ add_gitignore <- function(path = rstudioapi::selectDirectory(caption = "Select f
   }
 
   # gitignore content to add
-  gitignore <- c(
-    ".Rproj.user",
-    ".Rhistory",
-    ".RData",
-    ".Ruserdata",
-    "",
-    "# 'data' folder #",
-    "data/",
-    "",
-    "# Common text files that may contain data #",
-    "*.[cC][sS][vV]",
-    "*.[tT][xX][tT]",
-    "",
-    "# Excel files #",
-    "*.[xX][lL][sS]*",
-    "",
-    "# SPSS formats #",
-    "*.[sS][aA][vV]",
-    "*.[zZ][sS][aA][vV]",
-    "",
-    "# R data files #",
-    "*.[rR][dD][aA][tT][aA]",
-    "*.[rR][dD][sS]",
-    "",
-    "# MacOS folder attributes files #",
-    ".DS_Store"
-  )
+  gitignore <- readLines(system.file(package="phstemplates", "text", "gitignore.txt"))
 
   # collect into single text string
   gitignore <- paste(gitignore, collapse = "\n")

diff --git a/R/phsproject.R b/R/phsproject.R
@@ -6,15 +6,30 @@
 #' @param n_scripts Number of code files to start the project with.
 #' @param git Initialise the project with Git.
 #' @param renv Initialise the project with package management using renv.
+#' @param overwrite Logical: Whether to overwrite directory at existing path when creating directory.
 #' @return New project created according to the PHS R project structure.
 #' @export
 #' @examples
 #' \dontrun{
 #' phsproject(path = file.path(getwd(), "testproj"), author = "A Person", n_scripts = 1)
 #' }
-phsproject <- function(path, author, n_scripts = 1, git = FALSE, renv = FALSE) {
+phsproject <- function(path, author, n_scripts = 1, git = FALSE, renv = FALSE, overwrite = FALSE) {
+    # Checking if path already exists
     if (dir.exists(path)) {
-        stop("This directory already exists")
+      if (overwrite){
+        message("Overwriting existing directory")
+      } else {
+        overwrite <- rstudioapi::showQuestion(title = "Overwrite existing directory?",
+                                              message = "Path already exists. Overwrite existing directory?",
+                                              "Yes", "No")
+      }
+      if (overwrite){
+        # Delete files so they can be overwritten
+        deletefiles <- list.files(path, include.dirs = F, full.names = T, recursive = T)
+        file.remove(deletefiles)
+      } else {
+        stop("Directory already exists")
+      }
     }
 
     n_scripts <- as.numeric(n_scripts)
@@ -27,33 +42,7 @@ phsproject <- function(path, author, n_scripts = 1, git = FALSE, renv = FALSE) {
     dir.create(file.path(path, "data", "output"), showWarnings = FALSE)
     dir.create(file.path(path, "data", "temp"), showWarnings = FALSE)
 
-    gitignore <- c(
-        ".Rproj.user",
-        ".Rhistory",
-        ".RData",
-        ".Ruserdata",
-        "",
-        "# 'data' folder #",
-        "data/",
-        "",
-        "# Common text files that may contain data #",
-        "*.[cC][sS][vV]",
-        "*.[tT][xX][tT]",
-        "",
-        "# Excel files #",
-        "*.[xX][lL][sS]*",
-        "",
-        "# SPSS formats #",
-        "*.[sS][aA][vV]",
-        "*.[zZ][sS][aA][vV]",
-        "",
-        "# R data files #",
-        "*.[rR][dD][aA][tT][aA]",
-        "*.[rR][dD][sS]",
-        "",
-        "# MacOS folder attributes files #",
-        ".DS_Store"
-    )
+    gitignore <- readLines(system.file(package="phstemplates", "text", "gitignore.txt"))
 
     r_code <- script_template(author = author)
 
@@ -68,21 +57,7 @@ phsproject <- function(path, author, n_scripts = 1, git = FALSE, renv = FALSE) {
         r_code <- paste0(r_code_part1, r_code_part2, collapse = "")
     }
 
-    rproj_settings <- c(
-        "Version: 1.0",
-        "",
-        "RestoreWorkspace: No",
-        "SaveWorkspace: No",
-        "AlwaysSaveHistory: Default",
-        "",
-        "EnableCodeIndexing: Yes",
-        "UseSpacesForTab: Yes",
-        "NumSpacesForTab: 2",
-        "Encoding: UTF-8",
-        "",
-        "RnwWeave: Sweave",
-        "LaTeX: pdfLaTeX"
-    )
+    rproj_settings <- readLines(system.file(package="phstemplates", "text", "rproject_settings.txt"))
 
     # collect into single text string
     gitignore <- paste(gitignore, collapse = "\n")

diff --git a/R/phsshinyapp.R b/R/phsshinyapp.R
@@ -0,0 +1,131 @@
+#' phsshinyapp
+#' @description Create new shiny app according to the PHS R project structure.
+#' This function is meant to be used within RStudio by going to the File menu, then New Project.
+#'
+#' @param path String: Filepath for the project.
+#' @param author String: Name of the main author for the project.
+#' @param app_name String: name of application.
+#' @param git Logical: Initialise the project with Git.
+#' @param renv Logical: Initialise the project with package management using renv.
+#' @param overwrite Logical: Whether to overwrite directory at existing path when creating directory.
+#' @return New project created according to the PHS R project structure.
+#' @export
+#' @examples
+#' \dontrun{
+#' phsshinyapp(path = file.path(getwd(), "testproj"), app_name = "My lovely app",
+#' author = "A Person", n_scripts = 1)
+#' }
+phsshinyapp <- function(path, author = Sys.info()[['user']], app_name = "WRITE APP NAME HERE",
+                           git = FALSE, renv = FALSE, overwrite = FALSE) {
+
+  # Checking if path already exists
+  if (dir.exists(path)) {
+    if (overwrite){
+      message("Overwriting existing directory")
+    } else {
+      overwrite <- rstudioapi::showQuestion(title = "Overwrite existing directory?",
+                               message = "Path already exists. Overwrite existing directory?",
+                               "Yes", "No")
+    }
+    if (overwrite){
+      # Delete files so they can be overwritten
+      deletefiles <- list.files(path, include.dirs = F, full.names = T, recursive = T)
+      file.remove(deletefiles)
+    } else {
+      stop("Directory already exists")
+    }
+  }
+
+  # Making directory structure
+  dir.create(path, recursive = TRUE, showWarnings = FALSE)
+  dir.create(file.path(path, "data"), showWarnings = FALSE)
+  dir.create(file.path(path, "pages"), showWarnings = FALSE)
+  dir.create(file.path(path, "functions"), showWarnings = FALSE)
+  dir.create(file.path(path, "www"), showWarnings = FALSE)
+
+
+  # Getting text from inst/
+  gitignore <- readLines(system.file(package="phstemplates", "text", "gitignore.txt"))
+  rproj_settings <- readLines(system.file(package="phstemplates", "text", "rproject_settings.txt"))
+
+  # Getting shiny files from inst/
+  readme <- readLines(system.file(package="phstemplates", "text", "shiny", "README.md"))
+  setup_code <- readLines(system.file(package="phstemplates", "text", "shiny", "setup.R"))
+  css_code <- readLines(system.file(package="phstemplates", "text", "shiny", "shiny_css.css"))
+  core_functions <- readLines(system.file(package="phstemplates", "text", "shiny", "core_functions.R"))
+  intro_page_code <- readLines(system.file(package="phstemplates", "text", "shiny", "intro_page.R"))
+  page_1_code <- readLines(system.file(package="phstemplates", "text", "shiny", "page_1.R"))
+  page_1_functions <- readLines(system.file(package="phstemplates", "text", "shiny", "page_1_functions.R"))
+  app_code <- readLines(system.file(package="phstemplates", "text", "shiny", "app.R"))
+
+  # Collect into single text string
+  gitignore <- paste(gitignore, collapse = "\n")
+  rproj_settings <- paste(rproj_settings, collapse = "\n")
+  css_code <- paste(css_code, collapse="\n")
+  readme <- paste(readme, collapse = "\n")
+  setup_code <- paste(setup_code, collapse = "\n")
+  core_functions <- paste(core_functions, collapse = "\n")
+  intro_page_code <- paste(intro_page_code, collapse = "\n")
+  page_1_code <- paste(page_1_code, collapse = "\n")
+  page_1_functions <- paste(page_1_functions, collapse = "\n")
+  app_code <- paste(app_code, collapse = "\n")
+
+  # Getting app preamble
+  app_preamble <- shiny_app_template(app_name = app_name, author = author)
+  app_code <- paste(app_preamble, app_code, collapse = "\n")
+
+
+  # Write to index file
+  if (!renv) {
+    writeLines("", con = file.path(path, ".Rprofile"))
+  }
+  if (git){
+    writeLines(gitignore, con = file.path(path, ".gitignore"))
+  }
+  writeLines(readme, con = file.path(path, "README.md"))
+  writeLines(rproj_settings, con = file.path(path, paste0(basename(path), ".Rproj")))
+  writeLines(app_code, con = file.path(path, "app.R"))
+  writeLines(setup_code, con = file.path(path, "setup.R"))
+
+  writeLines("", con = file.path(path, "functions", "intro_page_functions.R"))
+  writeLines(page_1_functions, con = file.path(path, "functions", "page_1_functions.R"))
+  writeLines(core_functions, con = file.path(path, "functions", "core_functions.R"))
+
+  writeLines(intro_page_code, con = file.path(path, "pages", "intro_page.R"))
+  writeLines(page_1_code, con = file.path(path, "pages", "page_1.R"))
+
+  writeLines(css_code, con = file.path(path, "www", "styles.css"))
+
+  # Getting images needed for shiny app from inst
+  logo <- file.copy(
+    from = system.file(package="phstemplates", "images", "phs-logo.png"),
+    to = file.path(path, "www", "phs-logo.png"))
+  favicon <- file.copy(
+    from = system.file(package="phstemplates", "images", "favicon_phs.ico"),
+    to = file.path(path, "www", "favicon_phs.ico"))
+
+
+  if (!logo | !favicon){
+    message("PHS logo and favicon could not be copied. Please obtain these images for them to show in the shiny app.")
+  }
+
+
+  if (git) {
+    if (Sys.info()[["sysname"]] == "Windows") {
+      shell(paste("cd", path, "&&", "git init"))
+    } else {
+      system(paste("cd", path, "&&", "git init"))
+    }
+  }
+
+  if (renv) {
+    if (!"renv" %in% utils::installed.packages()[, 1]) {
+      warning("renv is not installed. Now attempting to install...",
+              immediate. = TRUE)
+      utils::install.packages("renv")
+    }
+
+    options(renv.consent = TRUE)
+    renv::init(project = file.path(getwd(), path))
+  }
+}
diff --git a/R/shiny_app_template.R b/R/shiny_app_template.R
@@ -0,0 +1,44 @@
+shiny_app_template <- function(app_name="WRITE APP NAME HERE",
+                               author = Sys.info()[['user']]) {
+
+    author <- paste("# Original author(s):", author)
+    orig_date <- paste('# Original date:', Sys.Date())
+    run_on <- paste0('# Written/run on RStudio ' , RStudio.Version()$mode, ' ',
+                     RStudio.Version()$version, ' and R ',
+                     version$major, '.', version$minor)
+
+    r_code <- c(
+      '##########################################################',
+      paste0('# ', app_name),
+      author,
+      orig_date,
+      run_on,
+      '# Description of content',
+      '##########################################################',
+      '',
+      '',
+      '# Get packages',
+      'source("setup.R")',
+      '',
+      '# UI',
+      'ui <- fluidPage(',
+      'tagList(',
+      '# Specify most recent fontawesome library - change version as needed',
+      'tags$style("@import url(https://use.fontawesome.com/releases/v6.1.2/css/all.css);"),',
+      'navbarPage(',
+      '    id = "intabset", # id used for jumping between tabs',
+      '    title = div(',
+      '        tags$a(img(src = "phs-logo.png", height = 40),',
+      '               href = "https://www.publichealthscotland.scot/",',
+      '               target = "_blank"), # PHS logo links to PHS website',
+      '    style = "position: relative; top: -5px;"),',
+      paste0('    windowTitle = ', '"', app_name,  '"',  ",", '# Title for browser tab'),
+      '    header = tags$head(includeCSS("www/styles.css"),  # CSS stylesheet',
+      '    tags$link(rel = "shortcut icon", href = "favicon_phs.ico") # Icon for browser tab',
+      '),'
+    )
+
+  r_code <- paste(r_code, collapse = '\n')
+
+  return(r_code)
+}