Shiny app to create a yaml file for a research project

create_yml.R

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(tidyverse)
library(yaml)

update_name <- function(name){yaml_obj$`project_name` <- name; yaml_obj}

new_person <- function(name, inst, email, role, date){
    new_id <- str_c("person_",sum(str_count(names(yaml_obj),"person_")) + 1)
    yaml_obj[[new_id]] <- list(name = name,
                               institute = inst,
                               email = email,
                               role = role,
                               date = str_c(date, collapse = " - "))
    yaml_obj <<- yaml_obj
}

new_location <- function(country, region, park, field_station, lat_log){
    new_id <- str_c("location_",sum(str_count(names(yaml_obj),"location_")) + 1)
    yaml_obj[[new_id]] <- list(country = country,
                               region = region,
                               park = park,
                               field_station = field_station,
                               lat_log = lat_log)
    yaml_obj <<- yaml_obj
}

new_data_type <- function(data_type){
    if( sum(str_count(names(yaml_obj),"data_file_type_overview")) == 0 ){ 
        yaml_obj$data_file_type_overview <- list()
        }
    
    new_id <- str_c("file_type_",sum(str_count(names(yaml_obj$data_file_type_overview),"file_type_")) + 1)
    
    yaml_obj$data_file_type_overview <- c(yaml_obj$data_file_type_overview, new_id = data_type)
    
    names(yaml_obj$data_file_type_overview)[names(yaml_obj$data_file_type_overview) == "new_id"] <- new_id
    yaml_obj <<- yaml_obj
}

new_data_desc <- function(data_desc){
    if( sum(str_count(names(yaml_obj),"data_description")) == 0 ){ 
        yaml_obj$data_description <- list()
    }
    
    new_id <- str_c("data_desc_",sum(str_count(names(yaml_obj$data_description),"data_desc_")) + 1)
    
    yaml_obj$data_description <- c(yaml_obj$data_description, new_id = data_desc)
    
    names(yaml_obj$data_description)[names(yaml_obj$data_description) == "new_id"] <- new_id
    yaml_obj <<- yaml_obj
}


new_fund <- function(fund_id){
    if( sum(str_count(names(yaml_obj),"funding_sources")) == 0 ){ 
        yaml_obj$funding_sources <- list()
    }
    
    new_id <- str_c("fund_",sum(str_count(names(yaml_obj$funding_sources),"fund_")) + 1)
    
    yaml_obj$funding_sources <- c(yaml_obj$funding_sources, new_id = fund_id)
    
    names(yaml_obj$funding_sources)[names(yaml_obj$funding_sources) == "new_id"] <- new_id
    yaml_obj <<- yaml_obj
}

new_date <- function(date_id, date_date){
    if( sum(str_count(names(yaml_obj),"dates")) == 0 ){ 
        yaml_obj$dates <- list()
    }
    
    yaml_obj$dates <- c(yaml_obj$dates, new_id = date_date)
    
    names(yaml_obj$dates)[names(yaml_obj$dates) == "new_id"] <- date_id
    yaml_obj <<- yaml_obj
}

yaml_obj <- list( project_name = "")
# Define UI for application that draws a histogram
ui <- fluidPage(
    
    # App title ----
    titlePanel("Downloading Data"),
    
    # Sidebar layout with input and output definitions ----
    sidebarLayout(
        
        # Sidebar panel for inputs ----
        sidebarPanel(
            textInput("proj_lab", "Project Name", value = "new_project", 
                      width = NULL, placeholder = NULL),
            # Input: Choose dataset ----
            
            selectInput("next_field", "Next Field",
                        c(person = "person", location = "location", 
                          file_types = "data_file_type_overview",
                          data_description = "data_description",
                          dates = "dates",
                          funding_sources = "funding_sources"
                          )
            ),
            conditionalPanel(
                condition = "input.next_field == 'person'",
                textInput("person_name", "Person Name", value = "", width = NULL, placeholder = NULL),
                textInput("person_institution", "Institution", value = "", width = NULL, placeholder = NULL),
                textInput("person_email", "Email", value = "", width = NULL, placeholder = NULL),
                selectInput("person_role", "Role", c("PI", "collaborator")),
                # textInput("person_role", "Role", value = "", width = NULL, placeholder = NULL),
                dateRangeInput("person_date", "Field Date"),
                actionButton("add_person", "Add Field")
                ),
            conditionalPanel(
                condition = "input.next_field == 'location'",
                textInput("loc_country", "Country", value = "", width = NULL, placeholder = NULL),
                textInput("loc_region", "Region", value = "", width = NULL, placeholder = NULL),
                textInput("loc_park", "Park", value = "", width = NULL, placeholder = NULL),
                textInput("loc_field_station", "Field Station", value = "", width = NULL, placeholder = NULL),
                textInput("loc_lat_log", "Lat/Long", value = "", width = NULL, placeholder = NULL),
                actionButton("add_location", "Add Field")
            ),
            conditionalPanel(
                condition = "input.next_field == 'data_file_type_overview'",
                textInput("data_type", "Data Type", value = "", width = NULL, placeholder = NULL),
                actionButton("add_type", "Add Field")
            ),
            conditionalPanel(
                condition = "input.next_field == 'data_description'",
                textInput("data_desc", "Data description", value = "", width = NULL, placeholder = NULL),
                actionButton("add_desc", "Add Field")
            ),
            conditionalPanel(
                condition = "input.next_field == 'dates'",
                textInput("date_id", "Date Specifier", value = "", width = NULL, placeholder = NULL),
                dateInput(inputId = "date_date",label = "Date"),
                actionButton("add_date", "Add Field")
            ),
            conditionalPanel(
                condition = "input.next_field == 'funding_sources'",
                textInput("fund_src", "Funding Source", value = "", width = NULL, placeholder = NULL),
                actionButton("add_fund", "Add Field")
            ),
            # fileInput("load_file", "Open Yaml", multiple = FALSE, accept = NULL, width = NULL),
            # Button
            # actionButton("loadData", "Open File"),
            downloadButton("downloadData", "Download")
            
        ),
        
        # Main panel for displaying outputs ----
        mainPanel(
            tags$h1(textOutput("title")),
            tags$code(htmlOutput("yaml"))#,
            # tableOutput("table")
        )
        
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    
    # Downloadable csv of selected dataset ----
    output$downloadData <- downloadHandler(
        filename = function() {
            paste(input$proj_lab, ".yml", sep = "")
        },
        content = function(file) {
            tmp_file <- tempfile()
            write_lines(x = str_c("# Project Metadata: ", input$proj_lab), file = file)
            write_yaml(x = update_name(input$proj_lab), file = tmp_file)
            write_lines(read_lines(tmp_file), file = file, append = TRUE)
            unlink(tmp_file)
        }
    )
        
    output$title <- renderText(paste0("Project Title: ",input$proj_lab))
    
    # yaml_obj <- reactive({inFile <- input$file1
    # 
    # if (is.null(inFile))
    #     return(test)
    # 
    # read_yaml(inFile$datapath)
    # })
    
    observeEvent(input$add_person, {
        new_person(name = input$person_name,
                   inst = input$person_institution, 
                   email = input$person_email,
                   role = input$person_role,
                   date = input$person_date)
        
        output$yaml <- renderText(str_replace_all(string = as.yaml(update_name(input$proj_lab),
                                                                   indent = 6),
                                                  pattern = "\\n", replacement = "<br>") %>% 
                                      str_replace_all(" ", "&nbsp"))
    })
    
    observeEvent(input$add_location, {
        new_location(country = input$loc_country,
                   region = input$loc_region, 
                   park = input$loc_park,
                   field_station = input$loc_field_station,
                   lat_log = input$loc_lat_log)
        
        output$yaml <- renderText(str_replace_all(string = as.yaml(update_name(input$proj_lab),
                                                                   indent = 6),
                                                  pattern = "\\n", replacement = "<br>") %>% 
                                      str_replace_all(" ", "&nbsp"))
    })
    
    observeEvent(input$add_type, {
        new_data_type(data_type = input$data_type)
        
        output$yaml <- renderText(str_replace_all(string = as.yaml(update_name(input$proj_lab),
                                                                   indent = 6),
                                                  pattern = "\\n", replacement = "<br>") %>% 
                                      str_replace_all(" ", "&nbsp"))
    })
    
    observeEvent(input$add_desc, {
        new_data_desc(data_desc = input$data_desc)
        
        output$yaml <- renderText(str_replace_all(string = as.yaml(update_name(input$proj_lab),
                                                                   indent = 6),
                                                  pattern = "\\n", replacement = "<br>") %>% 
                                      str_replace_all(" ", "&nbsp"))
    })

    observeEvent(input$add_date, {
        new_date(date_id = input$date_id, date_date = as.character(input$date_date))
        
        output$yaml <- renderText(str_replace_all(string = as.yaml(update_name(input$proj_lab),
                                                                   indent = 6),
                                                  pattern = "\\n", replacement = "<br>") %>% 
                                      str_replace_all(" ", "&nbsp"))
    })
        
    observeEvent(input$add_fund, {
        new_fund(fund_id = input$fund_src)
        
        output$yaml <- renderText(str_replace_all(string = as.yaml(update_name(input$proj_lab),
                                                                   indent = 6),
                                                  pattern = "\\n", replacement = "<br>") %>% 
                                      str_replace_all(" ", "&nbsp"))
    })
    
    # output$yaml <- renderText(as.yaml(list(foo = list(bar = 'baz')), indent = 3))
    output$yaml <- renderText(str_replace_all(string = as.yaml(update_name(input$proj_lab),
                                                               indent = 6),
                                          pattern = "\\n", replacement = "<br>") %>% 
                                  str_replace_all(" ", "&nbsp"))
}
# Run the application 
shinyApp(ui = ui, server = server)

species and open text field still need to be added

the app has the following dependencies:

library(shiny)
library(tidyverse)
library(yaml)