Nothing
#' @title Obtain the module information
#' @param root_path the root path of the website project
#' @param settings_file the settings file containing the module information
#' @param request 'HTTP' request string
#' @param env environment to load module variables into
#' @return A data frame with the following columns that contain the module
#' information:
#' \describe{
#' \item{\code{id}}{module id, folder name}
#' \item{\code{order}}{display order in side-bar}
#' \item{\code{group}}{group menu name if applicable, otherwise \code{NA}}
#' \item{\code{label}}{the readable label to be displayed on the side-bar}
#' \item{\code{icon}}{icon that will be displayed ahead of label, will be
#' passed to \code{\link{as_icon}}}
#' \item{\code{badge}}{badge text that will be displayed
#' following the module label, will be passed to \code{\link{as_badge}}}
#' \item{\code{url}}{the relative 'URL' address of the module.}
#' }
#' @details The module files are stored in \code{modules/} folder in your
#' project. The folder names are the module id. Within each folder,
#' there should be one \code{"server.R"}, \code{R/}, and a
#' \code{"module-ui.html"}.
#'
#' The \code{R/} folder stores R code files that generate variables,
#' which will be available to the other two files. These variables, along
#' with some built-ins, will be used to render \code{"module-ui.html"}.
#' The built-in functions are
#' \describe{
#' \item{ns}{shiny name-space function; should be used to generate the id for
#' inputs and outputs. This strategy avoids conflict id effectively.}
#' \item{.module_id}{a variable of the module id}
#' \item{module_title}{a function that returns the module label}
#' }
#'
#' The \code{"server.R"} has access to all the code in \code{R/} as well.
#' Therefore it is highly recommended that you write each 'UI' component
#' side-by-side with their corresponding server functions and call
#' these server functions in \code{"server.R"}.
#'
#' @examples
#'
#' library(shiny)
#' module_info()
#'
#' # load master module
#' load_module()
#'
#' # load specific module
#' module_data <- load_module(
#' request = list(QUERY_STRING = "/?module=module_id"))
#' env <- module_data$environment
#'
#' if(interactive()){
#'
#' # get module title
#' env$module_title()
#'
#' # generate module-specific shiny id
#' env$ns("input1")
#'
#' # generate part of the UI
#' env$ui()
#'
#' }
#'
#' @export
module_info <- function(root_path = template_root(),
settings_file = "modules.yaml"){
settings <- yaml::read_yaml(file.path(root_path, settings_file))
# settings <- yaml::read_yaml('modules.yaml')
groups <- names(settings$groups)
groups <- groups[groups != ""]
modules <- settings$modules
modules_ids <- names(settings$modules)
groups <- unique(groups)
group_level <- factor(groups, levels = groups, ordered = TRUE)
module_tbl <- do.call('rbind', lapply(modules_ids, function(mid){
x <- modules[[mid]]
y <- x[!names(x) %in% c('order', 'group', 'label', 'icon', 'badge', 'module', 'hidden')]
y$module <- mid
url <- httr::modify_url("?module=", query = y)
if(length(x$group) == 1 && x$group %in% group_level){
x$group <- group_level[group_level == x$group][[1]]
} else {
x$group <- NA
}
data.frame(
id = mid,
group = x$group,
label = ifelse(length(x$label) == 1, x$label, ""),
icon = ifelse(length(x$icon) == 1, x$icon, ""),
badge = ifelse(length(x$badge) == 1, x$badge, ""),
url = gsub("^[^\\?]+", "/", url),
stringsAsFactors = FALSE
)
}))
module_tbl
}
load_module_resource <- function(root_path = template_root(), module_id = NULL, env = parent.frame()){
root_path <- normalizePath(root_path, mustWork = TRUE)
re <- list(
environment = env,
has_module = FALSE,
root_path = root_path,
template_path = file.path(root_path, "index.html")
)
module_info <- list(
id = module_id,
server = function(input, output, session, ...){},
template_path = NULL
)
r_folder <- file.path(root_path, "R")
if(dir.exists(r_folder)){
fs <- list.files(r_folder, pattern = "\\.R$", ignore.case = TRUE,
recursive = FALSE, include.dirs = FALSE,
no.. = TRUE, all.files = TRUE, full.names = TRUE)
for(f in fs){
if(startsWith(basename(f), "shared-")) {
source(f, local = env, chdir = TRUE)
} else {
source(f, local = env, chdir = FALSE)
}
}
}
if(length(module_id)){
if(length(module_id) > 1){
stop("length of `module_id` must not exceed one.")
}
module_root <- file.path(root_path, 'modules', module_id)
module_info$template_path <- file.path(module_root, "module-ui.html")
if(dir.exists(module_root)){
re$has_module <- TRUE
env$ns <- shiny::NS(module_id)
env$.module_id <- module_id
env$module_title <- function(){
modules <- module_info()
modules$label[modules$id == module_id]
}
r_folder <- file.path(module_root, 'R')
if(dir.exists(r_folder)){
fs <- list.files(r_folder, pattern = "\\.R$", ignore.case = TRUE,
recursive = FALSE, include.dirs = FALSE,
no.. = TRUE, all.files = TRUE, full.names = TRUE)
for(f in fs){
if(startsWith(basename(f), "shared-")) {
source(f, local = env, chdir = TRUE)
} else {
source(f, local = env, chdir = FALSE)
}
}
}
module_handler <- file.path(root_path, 'modules', module_id, 'server.R')
if(file.exists(module_handler)){
# server_env <- new.env(parent = env)
server_env <- env
server_source <- source(module_handler, local = server_env)
server_function <- server_source$value
if(!is.function(server_function)){
server_function <- server_env$server
}
if(!is.function(server_function)){
stop("Module `", module_id, "` has server.R, but cannot detect server function.")
}
module_info$server <- server_function
}
# make sure `ns` and `.module_id` are consistent
env$ns <- shiny::NS(module_id)
env$.module_id <- module_id
}
}
re$module <- module_info
re
}
#' @rdname module_info
#' @export
load_module <- function(
root_path = template_root(),
request = list(QUERY_STRING = "/"),
env = parent.frame()){
force(env)
query_str <- request$QUERY_STRING
if(length(query_str) != 1) {
query_str <- '/'
}
query_list <- httr::parse_url(query_str)
module_id <- query_list$query$module
shared_id <- query_list$query$shared_id
shared_id <- tolower(shared_id)
shared_id <- gsub("[^a-z0-9_]", "", shared_id)
if(length(shared_id) != 1 || nchar(shared_id) ){
shared_id <- rand_string(26)
}
env$.request <- request
env$.shared_id <- shared_id
load_module_resource(root_path, module_id, env)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.