Nothing
#' A shiny app for creating a rosr project
#'
#' @return a shinyapp which can be displayed in a web browser.
#' @import shiny
#' @export
#' @examples
#' \dontrun{
#' create_ui()
#' }
create_ui <- function(){
return(shiny::shinyApp(ui = rosr_ui, server = rosr_server))
}
#' UI for the Shiny app create_ui
#'
#' @return A UI function
rosr_ui <- function(){
sidebarLayout(
mainPanel(
fluidPage(
wellPanel(
fluidRow(
column(2,
checkboxGroupInput('demo', 'demo',
choices = sub_projects()[1:8],
selected = sub_projects()[1:8]),
actionLink("demo_all","Select All"),
hr(),
checkboxGroupInput('unclassified', 'unclassified',
choices = templates()$templates[templates()$sub_project == 'unclassified'],
selected = 'letter_moderncv'),
actionLink("unclassified_all","Select All")
),
column(2, checkboxGroupInput('manuscript', 'manuscript',
choices = templates()$templates[templates()$sub_project == 'manuscript'],
selected = 'copernicus_article'),
actionLink("manuscript_all","Select All")),
column(2,
checkboxGroupInput('poster', 'poster',
choices = templates()$templates[templates()$sub_project == 'poster'],
selected = 'drposter'),
actionLink("poster_all","Select All"),
hr(),
checkboxGroupInput('slide', 'slide',
choices = templates()$templates[templates()$sub_project == 'slide'],
selected = 'xaringan'),
actionLink("slide_all","Select All")),
column(2, checkboxGroupInput('book', 'book',
choices = templates()$templates[templates()$sub_project == 'book'],
selected = 'demo'),
actionLink("book_all","Select All"),
hr(),
checkboxGroupInput('bookdownoutput', 'output',
choices = bookdownplus::get_output(),
selected = '')),
column(2, checkboxGroupInput('website', 'website',
choices = templates()$templates[templates()$sub_project == 'website'],
selected = 'yihui/hugo-lithium'),
actionLink("website_all","Select All"),
br(),
br(),
textInput('text_website', label = 'Or another template:', value = '', placeholder = 'chipsenkbeil/grid-side'))
),
fluidRow(
column(12, align="right",
actionButton('select_all', 'Select all'),
actionButton('select_suggested', 'Default')
)
)
)
)
),
sidebarPanel(
wellPanel(
textInput('proj', 'Project', 'new_project'),
textInput('path', 'Path', file.path(getwd(), 'new_project')),
radioButtons('if_render', 'Render', choices = c('Yep', 'Nope'), selected = 'Nope')
),
fluidRow(
column(12, align="right",
actionButton('create', 'Create!')
)
)
),
position = 'left'
)
}
#' Server for the Shiny app create_ui
#'
#' @param input The input of the server.
#' @param output The output of the server.
#' @param session The session of the server.
rosr_server <- function(input, output, session) {
template_df <- templates()
install_packages()
sub_project <- sub_projects()[9:14]
sub_project_label <- sub_project
template_selected <- c('copernicus_article', 'drposter', 'xaringan', 'demo', 'yihui/hugo-lithium', 'letter_moderncv')
observeEvent(input$create, {
# Create a Progress object
progress <- shiny::Progress$new()
# Make sure it closes when we exit this reactive, even if there's an error
on.exit(progress$close())
progress$set(message = "Creating...", detail = 'demo...', value = 0)
pr <- sum(sapply(c('demo', sub_project), function(x) length(input[[x]])))
# create demos
create_rosr(project = input$proj, dest_dir = input$path,
if_render = input$if_render == 'Yep',
sub_project = input$demo, overwrite = TRUE)
# create manuscript, slide, poster
for (j in 2:4){
if(length(input[[sub_project[j - 1]]]) != 0)
for(i in input[[sub_project[j - 1]]]){
progress$inc(1/pr, detail = paste0(sub_project[j - 1], ' ', i, '...'))
create_rmd(to = file.path(input$path, sub_project[j - 1]),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep')
}
}
# create book
if(length(input$book) != 0)
for(i in input$book) {
progress$inc(1/pr, detail = paste0('book ', i, '...'))
create_book(to = file.path(input$path, 'book'),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep',
bdp_output = input$bookdownoutput)
}
# create website
if(length(input$website) != 0)
for(i in input$website){
progress$inc(1/pr, detail = paste0('website ', i, '...'))
create_website(to = file.path(input$path, 'website'),
theme = i)
}
if(input$text_website != ''){
progress$inc(1/pr, detail = paste0('website ', input$text_website, '...'))
create_website(to = file.path(input$path, 'website'),
theme = input$text_website)
}
# create unclassified documents
if(length(input$unclassified) != 0)
for(i in input[['unclassified']]){
progress$inc(1/pr, detail = paste0('uncassified ', i, '...'))
create_rmd(to = file.path(input$path, 'unclassified'),
template = i,
package = template_df$package[template_df$templates == i],
if_render = input$if_render == 'Yep')
}
progress$inc(1/pr, detail = 'Done!')
}
)
# function as a short version of updateCheckboxGroupInput()
select_all <- function(sub_project = 'manuscript', all = FALSE){
sub_project_lab <- sub_project
if(sub_project == 'demo'){
mychoices <- sub_projects()[1:8]
} else {
mychoices <- template_of_sub_project(sub_project = sub_project)
}
if(all) {
myselected <- mychoices
} else{
myselected <- NULL
}
return(
updateCheckboxGroupInput(session, sub_project, sub_project_lab,
choices = mychoices,
selected = myselected)
)
}
# function controlling the update rule of the check boxes
observe_select_all <- function(sub_project = 'manuscript'){
input_id <- paste0(sub_project, '_all')
if(input[[input_id]] == 0) return(NULL)
if(input[[input_id]]%%2 == 0) return(select_all(sub_project = sub_project, all = TRUE))
return(select_all(sub_project = sub_project, all = FALSE))
}
# update the check boxex
observe({observe_select_all(sub_project = 'demo')})
observe({observe_select_all(sub_project = 'manuscript')})
observe({observe_select_all(sub_project = 'slide')})
observe({observe_select_all(sub_project = 'poster')})
observe({observe_select_all(sub_project = 'book')})
observe({observe_select_all(sub_project = 'website')})
observe({observe_select_all(sub_project = 'unclassified')})
observe({
if(input$select_all == 0) return(NULL)
else if (input$select_all%%2 == 0) {
lapply(c('demo', sub_project), function(x) select_all(x, all = FALSE))
} else {
lapply(c('demo', sub_project), function(x) select_all(x, all = TRUE))
}
})
observe({
if(input$select_suggested == 0) return(NULL)
select_all('demo', all = TRUE)
for(k in 1:6)
updateCheckboxGroupInput(session, sub_project[k], sub_project_label[k],
choices = template_of_sub_project(sub_project = sub_project[k]),
selected = template_selected[k])
# }
})
}
#' Get the template name of the given sub-project name
#'
#' @param sub_project the name of the sub-project
#'
#' @return the name of the template
template_of_sub_project <- function(sub_project){
templates()$templates[templates()$sub_project == sub_project]
}
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.