/
app_data_paths.R
158 lines (139 loc) · 4.81 KB
/
app_data_paths.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
# data server ----
# @param data_sheet_id google sheets id with the app data
# @param data_folder_id google drive folder id for file storage
module_data_paths_server <- function(input, output, session, data_sheet_id, gs_key_file) {
# namespace
ns <- session$ns
# reactive values =========
values <- reactiveValues(
load_data = 1L,
file_path = NULL,
error = FALSE
)
# data tables =========
get_local_file <- reactive({ values$file_path })
report_error <- function() {
values$error <- TRUE
}
# classes
classes <- callModule(
module_data_table_server, id = "classes",
data_sheet_id = data_sheet_id, gs_key_file = gs_key_file, local_file = get_local_file,
report_error = report_error, reload_data = reload_data,
sheet = "classes",
cols = c("class", "title", "credits" = "integer", "inactive" = "logical")
)
# path recommendations
paths <- callModule(
module_data_table_server, id = "paths",
data_sheet_id = data_sheet_id, gs_key_file = gs_key_file, local_file = get_local_file,
report_error = report_error, reload_data = reload_data,
sheet = "paths",
cols = c("path", "category", "category_description", "rec_min", "class", "reason")
)
# schedule
schedule <- callModule(
module_data_table_server, id = "schedule",
data_sheet_id = data_sheet_id, gs_key_file = gs_key_file, local_file = get_local_file,
report_error = report_error, reload_data = reload_data,
sheet = "schedule",
cols = c("term", "class", "section", "subtitle", "instructor_id", "enrollment_cap" = "integer", "building", "room", "days", "start_time", "end_time", "deleted" = "datetime", "canceled" = "logical", "confirmed" = "logical", "notes")
)
# (re-) load data event =====
reload_data <- function() {
# enforce reload even for dev mode
if (is_dev_mode() && file.exists(get_local_path()))
file.remove(get_local_path())
values$load_data <- values$load_data + 1L
}
observeEvent(input$reload, reload_data())
# download data event =========
observeEvent(values$load_data, {
# lock when this cascade starts
lock_app()
log_info(ns = ns, "requesting google spreadsheet data", user_msg = "Fetching data")
values$file_path <-
tryCatch({
# don't download from scratch every time if in development mode
if (is_dev_mode() && file.exists(get_local_path())) {
file_path <- get_local_path()
log_debug(ns = ns, "in DEV mode, using local data file")
} else
file_path <- download_gs(data_sheet_id, gs_key_file = gs_key_file)
# save locally if in dev mode
if (is_dev_mode() && !file.exists(get_local_path())) {
file.copy(file_path, get_local_path())
log_debug(ns = ns, "in DEV mode, saving downloaded data to local file")
}
file_path
},
error = function(e) {
log_error(ns = ns, "download failed", user_msg = "Data loading error", error = e)
values$error <- TRUE
NULL
})
}, priority = 10L)
# read data event =========
observeEvent(values$load_data, {
req(!values$error)
log_debug(ns = ns, "file path: ", values$file_path)
log_info(ns = ns, "loading data from xlsx file", user_msg = "Loading data")
# reading data sheets
tryCatch({
classes$read_data(ignore_other_cols = TRUE)
paths$read_data(ignore_other_cols = TRUE)
schedule$read_data(ignore_other_cols = TRUE)
},
error = function(e) {
log_error(ns = ns, "data read failed", user_msg = "Data reading error", error = e)
values$error <- TRUE
})
}, priority = 9L)
# always authenticate
is_authenticated <- reactive({ TRUE })
# lock/unlock events ====
observe({
# triggers
values$load_data
values$locked
values$error
# unlock if authenticated
isolate({
if (is_authenticated() && values$locked && !values$error) {
values$locked <- FALSE
} else if (!values$locked) {
unlock_app()
} else {
# reset
classes$reset()
paths$reset()
#shinyjs::hide("menu", asis = TRUE)
log_info(ns = ns, "app stays locked")
}
})
}, priority = 1L)
lock_app <- function() {
log_info(ns = ns, "locking app")
values$locked <- TRUE
values$error <- FALSE
}
unlock_app <- function() {
log_info(ns = ns, "unlocking app")
shinyjs::show("menu", asis = TRUE)
log_success(ns = ns, "loading all done", user_msg = "Complete")
}
# return function ====
list(
reload_data = reload_data,
is_authenticated = is_authenticated,
classes = classes,
paths = paths,
schedule = schedule
)
}
# data ui components - reload button ------
module_data_paths_reload_button <- function(id) {
ns <- NS(id)
actionButton(ns("reload"), "Reload", icon = icon("rotate")) |>
add_tooltip("Reload all data")
}