From c28edfd78229950f236468b64b284b4550ba30dd Mon Sep 17 00:00:00 2001
From: Mark Edmondson <github@markedmondson.me>
Date: Tue, 26 Jan 2021 15:37:05 +0100
Subject: [PATCH] add ga_model_refresh #362 and a shinythemes examples #358

---
 NAMESPACE                                    |  1 +
 R/model_shiny_templates.R                    | 30 +++++++++++++----
 R/models.R                                   | 35 ++++++++++++++++++++
 inst/models/shiny_templates/shinythemes/ui.R | 35 ++++++++++++++++++++
 man/ga_model_refresh.Rd                      | 14 ++++++++
 man/ga_model_shiny.Rd                        | 11 ++++++
 6 files changed, 120 insertions(+), 6 deletions(-)
 create mode 100644 inst/models/shiny_templates/shinythemes/ui.R
 create mode 100644 man/ga_model_refresh.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 2e38a6de..ef1e5f30 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -80,6 +80,7 @@ export(ga_model_edit)
 export(ga_model_example)
 export(ga_model_load)
 export(ga_model_make)
+export(ga_model_refresh)
 export(ga_model_save)
 export(ga_model_shiny)
 export(ga_model_shiny_load)
diff --git a/R/model_shiny_templates.R b/R/model_shiny_templates.R
index 74417ea7..ead4eeee 100644
--- a/R/model_shiny_templates.R
+++ b/R/model_shiny_templates.R
@@ -65,6 +65,7 @@ ga_model_shiny_template <- function(name = "list", read_lines = FALSE){
 #'  \item{\code{\{\{\{ scopes \}\}\}}}{- Adds Google Oauth2 scopes for the API calls}
 #'  \item{\code{\{\{\{ deployed_url \}\}\}}}{- Adds \code{option(googleAuthR.redirect)} option for deployed Shiny apps}
 #'  \item{\code{\{\{\{ model_load \}\}\}}}{- Adds \link{ga_model_load} calls loading all models in the list passed to this function's \code{models} argument.  It creates R objects called 'model1', 'model2' etc. in the Shiny app code}
+#'  \item{\code{\{\{\{ model_list \}\}\}}}{- Adds a list of the model objects after model_load.  Useful for creating custom functions in themes that can loop over model objects}
 #'  \item{\code{\{\{\{ shiny_title \}\}\}}}{- Adds the title to the Shiny app}
 #'  \item{\code{\{\{\{ auth_ui \}\}\}}}{- Adds the correct dropdown Shiny module for picking a GA4 or Universal Analytics properties}
 #'  \item{\code{\{\{\{ date_range \}\}\}}}{- Adds a \code{shiny::dateInput()} date selector with id "date_range" for use in model's data fetching functions}
@@ -170,6 +171,16 @@ ga_model_shiny_template <- function(name = "list", read_lines = FALSE){
 #'      ui_f = shinydashboard_ui, 
 #'      model_tabs = shinydashboard_ui_menu(models))
 #' }
+#' 
+#' # you can include the ui_f embedded within the template file instead
+#' # use \{\{\{ model_list \}\}\} to work with the models in the ui.R
+#' 
+#' # below adds custom macro 'theme' but puts its ui_f within the template
+#' ga_model_shiny(models, auth_dropdown = "universal", 
+#'                template = ga_model_shiny_template("shinythemes"), 
+#'                theme = "yeti")
+#' 
+#' 
 #' @family GA modelling functions
 ga_model_shiny <- function(
   models,
@@ -220,7 +231,7 @@ ga_model_shiny <- function(
   
   myMessage("passed template values:\n", 
             paste(names(values),"=",values, collapse = "\n"),
-            level = 3)
+            level = 2)
   
   render <- lapply(txt, whisker.render, data = values)
 
@@ -270,19 +281,19 @@ write_template_object <- function(output, destination_folder){
 
   if(!is.null(output$app) && nzchar(output$app)){
     loc <- file.path(destination_folder, "app.R")
-    myMessage("Writing Shiny app.R to ", loc, level = 3)
+    myMessage("Writing Shiny app.R to ", loc, level = 2)
     writeLines(output$app, loc)
   }
   
   if(!is.null(output$ui) && nzchar(output$ui)){
     loc <- file.path(destination_folder, "ui.R")
-    myMessage("Writing Shiny ui.R to ", loc, level = 3)
+    myMessage("Writing Shiny ui.R to ", loc, level = 2)
     writeLines(output$ui, loc)
   }
   
   if(!is.null(output$server) && nzchar(output$server)){
     loc <- file.path(destination_folder, "server.R")
-    myMessage("Writing Shiny server.R to ", loc, level = 3)
+    myMessage("Writing Shiny server.R to ", loc, level = 2)
     writeLines(output$server, loc)
   }
   
@@ -309,7 +320,7 @@ ga_model_shiny_template_make <- function(template, header_boilerplate = TRUE){
   if(header_boilerplate){
     myMessage(
       "Adding ga_model_shiny_template('header_boilerplate.R') to Shiny code",
-      level = 3)
+      level = 2)
     # add the header boiler plate
     hdr_txt <- ga_model_shiny_template("boilerplate/header_boilerplate.R", 
                                        read_lines = TRUE)
@@ -413,13 +424,20 @@ make_model_template <- function(model_locations,
       collapse = "\n")
   }
   
+  # models in a list that can be used in theme templates
+  model_list <- paste("list(", 
+                      paste(names(model_locations), 
+                            collapse = ",", sep = ","),
+                      ")")
+  
   list(
     model_load = paste(
       sprintf("%s <- ga_model_shiny_load('%s')", 
               names(model_locations), model_locations), 
       collapse = "\n"),
     model_ui = ga_model_shiny_ui_f(names(model_locations)),
-    model_server = model_server
+    model_server = model_server,
+    model_list = model_list
   )
   
 }
diff --git a/R/models.R b/R/models.R
index 15ee83fd..987cf22c 100644
--- a/R/models.R
+++ b/R/models.R
@@ -581,3 +581,38 @@ write_f <- function(name, f){
   c(name, deparse(f))
 }
 
+#' Refresh a model
+#' 
+#' Sometimes necessary if functions were created under differing package versions
+#' 
+#' @param model Model or file location of model .gamr file
+#' 
+#' @export
+ga_model_refresh <- function(model){
+  save_me <- ""
+  if(is.character(model)){
+    save_me <- model
+    model <- ga_model_load(model)
+  }
+  
+  new_model <- ga_model_edit(model,
+    data_f = model$data_f,
+    required_columns = model$required_columns,
+    model_f = model$model_f,
+    required_packages = model$required_packages,
+    description = model$description,
+    outputShiny = model$outputShiny,
+    renderShiny = model$renderShiny,
+    inputShiny = model$inputShiny,
+    output_f = model$output_f
+  )
+  
+  if(nzchar(save_me)){
+    ga_model_save(new_model, filename = save_me)
+  }
+  
+  new_model
+  
+  
+}
+
diff --git a/inst/models/shiny_templates/shinythemes/ui.R b/inst/models/shiny_templates/shinythemes/ui.R
new file mode 100644
index 00000000..b8bdeaff
--- /dev/null
+++ b/inst/models/shiny_templates/shinythemes/ui.R
@@ -0,0 +1,35 @@
+library(shinythemes)
+## basic ui.R
+theme <- "{{ theme }}"
+if(!nzchar(theme)) theme <- "cerulean"
+
+the_theme <- shinytheme(theme)
+
+# a list of the model objects
+models <- {{ model_list }}
+
+# uses models (a list of models) to create the model UI 
+shinytheme_tabPanel <- function(models){
+  model_n <- paste0("model", seq_along(models)) 
+  tabPanels <- mapply(function(x,y) tabPanel(y$model$description, y$ui(x)), 
+                      x=model_n, y=models, 
+                      SIMPLIFY = FALSE)
+  do.call(tabsetPanel, args = unname(tabPanels))
+}
+
+navbarPage(
+  title = "{{ shiny_title }}",
+  theme = the_theme,
+  tabPanel("Models",
+    {{ auth_ui }},
+    sidebarPanel(
+      {{{ date_range }}}
+    ),
+    mainPanel(
+      shinytheme_tabPanel(models)
+    )
+  )
+)
+
+
+
diff --git a/man/ga_model_refresh.Rd b/man/ga_model_refresh.Rd
new file mode 100644
index 00000000..f9b6f060
--- /dev/null
+++ b/man/ga_model_refresh.Rd
@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/models.R
+\name{ga_model_refresh}
+\alias{ga_model_refresh}
+\title{Refresh a model}
+\usage{
+ga_model_refresh(model)
+}
+\arguments{
+\item{model}{Model or file location of model .gamr file}
+}
+\description{
+Sometimes necessary if functions were created under differing package versions
+}
diff --git a/man/ga_model_shiny.Rd b/man/ga_model_shiny.Rd
index 1d75fc81..be0572e0 100644
--- a/man/ga_model_shiny.Rd
+++ b/man/ga_model_shiny.Rd
@@ -69,6 +69,7 @@ By default the Shiny app is launched which in most cases will prompt authorisati
  \item{\code{\{\{\{ scopes \}\}\}}}{- Adds Google Oauth2 scopes for the API calls}
  \item{\code{\{\{\{ deployed_url \}\}\}}}{- Adds \code{option(googleAuthR.redirect)} option for deployed Shiny apps}
  \item{\code{\{\{\{ model_load \}\}\}}}{- Adds \link{ga_model_load} calls loading all models in the list passed to this function's \code{models} argument.  It creates R objects called 'model1', 'model2' etc. in the Shiny app code}
+ \item{\code{\{\{\{ model_list \}\}\}}}{- Adds a list of the model objects after model_load.  Useful for creating custom functions in themes that can loop over model objects}
  \item{\code{\{\{\{ shiny_title \}\}\}}}{- Adds the title to the Shiny app}
  \item{\code{\{\{\{ auth_ui \}\}\}}}{- Adds the correct dropdown Shiny module for picking a GA4 or Universal Analytics properties}
  \item{\code{\{\{\{ date_range \}\}\}}}{- Adds a \code{shiny::dateInput()} date selector with id "date_range" for use in model's data fetching functions}
@@ -170,6 +171,16 @@ ga_model_shiny(models, auth_dropdown = "universal",
      ui_f = shinydashboard_ui, 
      model_tabs = shinydashboard_ui_menu(models))
 }
+
+# you can include the ui_f embedded within the template file instead
+# use \{\{\{ model_list \}\}\} to work with the models in the ui.R
+
+# below adds custom macro 'theme' but puts its ui_f within the template
+ga_model_shiny(models, auth_dropdown = "universal", 
+               template = ga_model_shiny_template("shinythemes"), 
+               theme = "yeti")
+
+
 }
 \seealso{
 Other GA modelling functions: