R/update.R

In leprechaun: Create Simple 'Shiny' Applications as Packages

#' Update
#' 
#' Update the scaffolded code to a new version of 
#' leprechaun.
#' 
#' This reads the content of the `.leprechaun` lock file
#' and updates it too.
#' 
#' @param force Force update, ignore safety checks.
#' 
#' @examples 
#' \dontrun{update_scaffold()}
#' 
#' @importFrom cli cli_alert_success cli_alert_warning cli_alert_danger
#' 
#' @return Invisibly returns a boolean indicating whether
#' the scaffold was updated.
#' 
#' @export 
update_scaffold <- function(force = !interactive()){
	check_is_leprechaun()

	# check whether an update is even required
	identical_versions <- compare_versions()

	if(!force && identical_versions){
		cli_alert_warning(
			"Scaffold version and installed leprechaun version match ({.field {get_pkg_version()}}): nothing to update"
		)
		return(invisible(FALSE))
	}

	proceed <- confirm_update(force)

	if(!proceed){
		cli_alert_danger("Aborting update")
		return(invisible(FALSE))
	}

	cli_alert_success(
		"Updating to leprechaun version {.field {get_pkg_version()}}"
	)

	update_r()
	update_use()
	update_main()

	invisible(TRUE)
}

#' @noRd 
#' @keywords internal
#' @importFrom cli cli_alert_info
update_config <- function(){
	cli_alert_info("Updating {.file R/config.R}")
	use_config_overwritable()
}

#' @noRd 
#' @keywords internal
#' @importFrom cli cli_alert_info
update_sass <- function(){
	cli_alert_info("Updating {.file inst/dev/sass.R}")
	use_sass_overwritable()
}

#' @noRd 
#' @keywords internal
#' @importFrom cli cli_alert_info
update_packer <- function(){
	cli_alert_info("Updating {.file R/assets.R}")
	use_packer(TRUE)
}

# Update Main version
update_main <- function(){
	conf <- lock_read()
	conf$version <- get_pkg_version()
	lock_write(conf)
}

#' Compare Global Versions
#' 
#' Compare the installed version of leprechaun with
#' the version set in the lockfile to assess whether
#' an update is necessary.
#' 
#' @examples 
#' \dontrun{compare_versions()}
#' 
#' @return boolean indicating whether the versions are identical
#' 
#' @noRd 
#' @keywords internal
compare_versions <- function(){
	version_current <- get_pkg_version()
	version_set <- lock_read()[["version"]]

	identical(version_current, version_set)
}

#' Update Use
#' 
#' @noRd 
#' @keywords internal
update_use <- function(){
	version <- get_pkg_version()

	conf <- lock_read()
	confuse <- conf[["uses"]]

	if(!length(confuse))
		return()

	for(i in 1:length(confuse)){
		# update functions write to the lockfile
		# we read it at every loop
		conf <- lock_read()
		confuse <- conf[["uses"]]

		# it's already on the latest version
		if(confuse[[i]] == version)
			next;

		switch(
			names(confuse)[i],
			"js-utils" = update_js_utils(),
			"html-utils" = update_html_utils(),
			"endpoint-utils" = update_endpoint_utils(),
			"sass" = update_sass(),
			"packer" = update_packer(),
			"config" = update_config(),
			"inputs" = update_inputs()
		)
	}
}

#' Update JS Utils
#' 
#' @noRd 
#' @keywords internal
update_js_utils <- function(){
	cli_alert_info("Updating {.file R/utils-js.R} and {.file srcjs/leprechaun-utils.js}")
	use_js_utils(overwrite = TRUE, quiet = TRUE)
}

#' Update HTML Utils
#' 
#' @noRd 
#' @keywords internal
update_html_utils <- function(){
	cli_alert_info("Updating {.file R/html-utils.R}")
	use_html_utils(overwrite = TRUE, quiet = TRUE)
}

#' Update Endpoint Utils
#' 
#' @noRd 
#' @keywords internal
update_endpoint_utils <- function(){
	cli_alert_info("Updating {.file R/endpoint-utils.R}")
	use_endpoints_utils(overwrite = TRUE, quiet = TRUE)
}

#' Update R
#' 
#' Updates relevant files in the R directory.
#' 
#' @noRd 
#' @keywords internal
update_r <- function(){
	version <- get_pkg_version()
	conf <- lock_read()
	confr <- conf[["r"]]

	for(i in 1:length(confr)){
		# update functions write to the lockfile
		# we read it at every loop
		conf <- lock_read()
		confr <- conf[["r"]]

		# it's already on the latest version
		if(confr[[i]] == version)
			next;

		switch(
			names(confr)[i],
			"zzz" = update_onload(),
			"assets" = update_assets(),
			"leprechaun-utils" = update_utils()
		)
	}
}

#' @noRd 
#' @keywords internal
#' @importFrom cli cli_alert_info
update_onload <- function(){
	cli_alert_info("Updating {.file R/zzz.R}")
	create_onload(TRUE)
}

#' @noRd 
#' @keywords internal
#' @importFrom cli cli_alert_info
update_assets <- function(){
	cli_alert_info("Updating {.file R/assets.R}")
	create_assets(TRUE)
}

#' @noRd 
#' @keywords internal
#' @importFrom cli cli_alert_info
update_utils <- function(){
	cli_alert_info("Updating {.file R/leprechaun-utils.R}")
	create_utils(TRUE)
}

#' @noRd 
#' @keywords internal
#' @importFrom cli cli_alert_info
update_inputs <- function(){
	cli_alert_info("Updating {.file R/input-handlers.R}")
	create_onload(TRUE)
}

#' Confirm Update
#' 
#' Confirm with user that updates need to nbe made.
#' Prints useful messages to decide whether to update.
#' 
#' @param force Force update, ignore safety checks.
#' 
#' @return Boolean indicating whether the user wants to
#' proceed.
#' 
#' @importFrom cli cli_h1 cli_alert_info cli_h2 cli_li
#' 
#' @noRd 
#' @keywords internal
confirm_update <- function(force = FALSE){
	conf <- lock_read()

	cli_h1("Updating leprechaun application")
	cat("\n")
	cli_alert_info(
		"Will attempt to bump code from version {.field {conf$version}} to {.field {get_pkg_version()}}"
	)

	cli_h2("R files")
	li <- names(conf$r)
	li <- paste0("R/", li, ".R")
	cli_li(li)

	cli_h2("Uses")
	li <- names(conf$uses)
	cli_li(li)

	cat("\n")

	if(force)
		return(TRUE)

	ask()	
}

#' Prompt the user for confirmation update
#' 
#' @keywords internal
#' @noRd 
ask <- function(){

	response <- readline("Do you want to proceed? (y/n)\n")
	
	if(response != "y")
		return(FALSE)

	TRUE
}