inst/shiny-examples/journals/app.R

In andrewjpfeiffer/journalr: Produces markdown journals with R

library(shiny)
library(magrittr)
library(lubridate)
library(journalr)
library(glue)

options(shiny.sanitize.errors = FALSE)
min_date <- floor_date(today(), "year")
max_date <- ymd(20991231)
all_dates <- seq(min_date, max_date, by = 1)
ff_bad_dates_st <- all_dates[day(all_dates) != 1]
ff_bad_dates_end <- all_dates[day(all_dates + 1) != 1]
tc_bad_dates_st <- all_dates[wday(all_dates) %in% 3:7] # Not Sundays or Mondays
format_date_shiny <- function(x) format(x, "%d %B %Y")


# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Create Journals"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(
        sidebarPanel(
            # Select Freeform or Tactics template type
            selectInput("template_type_in", "Select journal type to use",
                        choices = c(" " = "",
                                    "Freeform" = "Freeform",
                                    "Tactics" = "Tactics"),
                        selected = FALSE),

            uiOutput("start_date_input"),

            uiOutput("end_date_input"),

            uiOutput("file_uploader_input"),

            uiOutput("download_input")
        ),

        mainPanel(
            uiOutput("dropdown_output"),

            verbatimTextOutput("example_output")
        )
    )
)

server <- function(input, output) {
    # Create reactives
    template_type_react <- reactive(input$template_type_in)

    output$start_date_input <- renderUI({
        if (template_type_react() == "Freeform") {
            list(
                hr(),
                p("You have selected the 'Freeform' journal template."),
                p("This will generate a different journal file for each month."),
                hr(),
                p("Please select a start date that is the 1st of the month"),
                dateInput(
                    "start_date_in", "Choose a start date",
                    value = as.Date(NA),
                    datesdisabled = as.Date(ff_bad_dates_st)
                )
            )
        } else if (template_type_react() == "Tactics") {
            list(
                hr(),
                p("You have selected the 'Tactics' journal template."),
                p("This will generate a different journal file for each week."),
                hr(),
                p("Please select a start date that is a Sunday or Monday"),
                dateInput(
                    "start_date_in", "Choose a start date",
                    value = as.Date(NA),
                    datesdisabled = as.Date(tc_bad_dates_st)
                )
            )
        }
    })

    # Depending on the template type, output text instructing the user about the period
    # and then return a date start box accordingly


    # Make the start date reactive to use it in the end date
    start_date_react <- reactive(input$start_date_in)

    # Return the end date UI based on the start date
    output$end_date_input <- renderUI({
        req(start_date_react())

        if (template_type_react() == "Freeform") {
            list(
                hr(),
                p(paste("Please select an end date after",
                        format_date_shiny(start_date_react()),
                        "that is the last day of the month")),
                dateInput(
                    "end_date_in", "Choose an end date",
                    value = as.Date(NA),
                    datesdisabled = c(ff_bad_dates_end, all_dates[all_dates < start_date_react()])
                )
            )
        } else if (template_type_react() == "Tactics") {
            list(
                hr(),
                p(paste("Please select an end date after", format_date_shiny(start_date_react()))),
                p(paste0("Since this day is a ", wday(start_date_react(), label = TRUE, abbr = FALSE),
                         ", select a ", wday(start_date_react() - 1, label = TRUE, abbr = FALSE))),
                dateInput(
                    "end_date_in", "Choose an end date",
                    value = as.Date(NA),
                    datesdisabled = all_dates[all_dates < start_date_react() | wday(all_dates) != wday(start_date_react() - 1)]
                )
            )
        }
    })

    end_date_react <- reactive(input$end_date_in)

    # If the template type is "Tactics", return extra text.
    output$file_uploader_input <- renderUI({
        req(end_date_react())

        if (template_type_react() == "Freeform") {
            NULL
        } else if (template_type_react() == "Tactics") {
            list(
                p("Markdown items will be passed as tactics"),
                fileInput("template_file_in", "Tactics",
                          multiple = FALSE, accept = "text")
            )
        }
    })

    # Run the journal
    journal_output_react <- reactive({
        req(end_date_react())

        if (template_type_react() == "Freeform") {
            journal_freeform(date_start = start_date_react(), date_end = end_date_react())
        } else if (template_type_react() == "Tactics") {
            req(input$template_file_in$datapath)
            readr::read_file(input$template_file_in$datapath) %>%
                journal_tactics(date_start = start_date_react(), date_end = end_date_react())
        }

    })

    # Get the dropdown for the preview
    dropdown_output_react <- reactive({
        req(journal_output_react())

        dropdown_names <- purrr::map_chr(journal_output_react()$file_contents,
                                         readr::read_lines, n_max = 1)

        seq_along(dropdown_names) %>%
            rlang::set_names(stringr::str_match(dropdown_names, "# (.*)")[,2])
    })

    output$dropdown_output <- renderUI({
        selectInput("index_to_display_input", "Select journal to preview",
                    choices = dropdown_output_react(), width = "100%")
    })

    # Get the index - need to convert to numeric
    input_idx_react <- reactive({
        req(input$index_to_display_input)
        return(as.numeric(input$index_to_display_input))
    })

    # Return the example output
    output$example_output <- renderText({
        journal_output_react()$file_contents[input_idx_react()]
    })

    # File downloader
    output$zip_downloader_input <- downloadHandler(
        filename = function() "output.zip",
        content = function(fname){
            setwd(tempdir())
            for (i in seq_along(dropdown_output_react())) {
                readr::write_lines(journal_output_react()$file_contents[i],
                                   journal_output_react()$filename[i])
            }
            zip(zipfile = fname, files = journal_output_react()$filename)
        },
        contentType = "application/zip"
    )

    # Download button that only appears when the template is selected
    output$download_input <- renderUI({
        req(journal_output_react())

        list(hr(),
             strong("Download ZIP archive of journal templates"),
             br(),
             downloadButton("zip_downloader_input"))
    })
}

# Run the application
shinyApp(ui = ui, server = server)