I am quite new to writing shinyapps so please bear with me:
I have written an app that allows a gsheet to be read to display a roster ladder. This can be updated if one of my co-workers have done an emergency shift to cover sickness absence. The ladder will display a temporary the new ladder and a backup is created on Google Drive when the submit button is hit. However, I find that if I re-open the app in close succession, the app will not read the latest gsheet but instead display the last copy of the roster. I looked into adding something such as this to server:
session$onSessionEnded(function() {
stopApp()
})
to end the session on Submit but it rendered the app unusable. Is there anything I can do to force the app to read from the Google drive?
library(shiny)
library(shinydashboard)
library(shinymanager)
library(tidyverse)
library(lubridate)
library(knitr)
library(kableExtra)
library(shinyjs)
library(googlesheets4)
library(googledrive)
options(
# whenever there is one account token found, use the cached token
gargle_oauth_email = TRUE,
# specify auth tokens should be stored in a hidden directory ".hidden"
gargle_oauth_cache = ".hidden"
)
credentials <- data.frame(
user = "abc",
password = "123",
comment = "Use the username and password to access",
stringsAsFactors = FALSE
)
disaster <- googledrive::drive_get("disaster_rota_latest") %>%
read_sheet(sheet = "Sheet1")
current_id <- googledrive::drive_get("disaster_rota_latest")$id
disaster_backup <- disaster
consultants_list <- disaster$name
# Moved this to inside eventReactive to prevent a back up being made each time the app is opened:
# ss <- gs4_create(paste0("disaster_backup_", Sys.Date(), Sys.time()),
# sheets = list(disaster_backup))
rearrange <- function(cons, covered_date, rota){
new_row <- tibble(name = cons,
order = nrow(rota),
date_of_cover = covered_date,
mobile = rota %>%
filter(name == cons) %>%
select(mobile))
rota_temp <- rota %>%
filter(name != cons) %>%
rbind(new_row)
rota_NA <- rota_temp %>%
filter(is.na(date_of_cover))
rota_past_shifts <- rota_temp %>%
filter(!is.na(date_of_cover)) %>%
arrange(date_of_cover)
rota_new <- rota_NA %>%
rbind(rota_past_shifts) %>%
mutate(order = 1:nrow(rota))
return(rota_new)
}
disaster <- disaster %>%
mutate(date_of_cover = as_date(date_of_cover)) %>%
mutate(order = as.numeric(order)) %>%
mutate(mobile = as.character(mobile)) %>%
arrange(order)
ui <- dashboardPage(
dashboardHeader(title = "Disaster Rota"),
dashboardSidebar(disable = TRUE),
dashboardBody(
useShinyjs(),
h2("Department Emergency Cover Rota"),
fluidRow(
box(title = "Please Read:",
collapsible = F,
solidHeader = T,
status = "danger",
width = 7,
helpText("You can view the current rota below."),
helpText("To add a shift you covered, expand the box below by clicking on the cross on the right."),
helpText("Only submit one shift at a time and close the app after,
the new rota will save to Google Drive when you close the browser
but the rota below should be updated."),
helpText("If you have made a mistake or noticed the app not working as intended,
please let me know as soon as possible.")
)
),
fluidRow(
div(id = "submission",
box(title = "Update with a new shift covered (Only for Weekends and Nights, not Evenings)",
collapsible = T,
collapsed = T,
solidHeader = T,
status = "primary",
width = 7,
fluidRow(
column(width = 6,
selectizeInput("consultant", label = "Consultant Name",
choices = list("Begin by Typing Your name" = "",
"Name" = sort(consultants_list)),
multiple = FALSE, selected = "")
),
),
fluidRow(
column(width = 6,
dateInput("shift_date",
label = "Date of Shift Covered",
value = Sys.Date()
)
)
),
fluidRow(
column(width = 12,
helpText("Please make sure the name and date of the shift are correct before submitting,
mistakes can only be un-done manually by going back to a backup"),
actionButton("submit", label = "Submit")
)
)
)
)
),
fluidRow(
box(title = "Current Rota",
collapsible = F,
solidHeader = T,
status = "primary",
width = 7,
column(width = 12,
div(id = "legacy_rota",
htmlOutput("rota.kable.legacy")
),
shinyjs::hidden(
div(id = "new_rota",
htmlOutput("rota.kable.new")
)
)
)
)
)
)
)
ui <- secure_app(ui, theme = shinythemes::shinytheme("sandstone"))
set_labels(
language = "en",
"Please authenticate" = "Please login"
)
server <- function(input, output, session){
res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
new_rota <- eventReactive(
input$submit,{
disaster_backup <- disaster
ss <- gs4_create(paste0("disaster_backup_", Sys.Date(), Sys.time()),
sheets = list(disaster_backup))
disaster_new <-
rearrange(input$consultant, input$shift_date, disaster)
return(disaster_new)
}
)
observeEvent(
input$submit, {
sheet_write(data = new_rota(),
ss = current_id,
sheet = "Sheet1")
shinyjs::toggle(id = "submission", anim = T)
shinyjs::toggle(id = "legacy_rota", anim = T)
shinyjs::toggle(id = "new_rota", anim = T)
}
)
output$rota.kable.legacy <- renderText({
data <- disaster %>%
select(Position = order,
Name = name,
"Mobile No" = mobile,
"Date of Last Cover" = date_of_cover)
kable(data, format = "html", escape = F) %>%
kable_styling(full_width = T, font_size = 14) %>%
column_spec(1, bold = T)
})
output$rota.kable.new <- renderText({
data <- new_rota() %>%
select(Position = order,
Name = name,
"Mobile No" = mobile,
"Date of Last Cover" = date_of_cover)
kable(data, format = "html", escape = F) %>%
kable_styling(full_width = T, font_size = 14) %>%
column_spec(1, bold = T)
})
}
shinyApp(ui, server)
...