/
get_syllabus.R
113 lines (101 loc) · 3.51 KB
/
get_syllabus.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
#' Create a syllabus for the lesson
#'
#' This function is generally for internal use, but may be useful for those who
#' whish to automate creation of their own home pages.
#'
#' @param path the path to a lesson
#' @param questions if `TRUE`, the questions in the episodes will be added to
#' the table. Defaults to `FALSE`.
#' @param use_built if `TRUE` (default), the rendered episodes will be used to
#' generate the syllabus
#' @return a data frame containing the syllabus for the lesson with the timing,
#' links, and questions associated
#' @keywords internal
#' @export
get_syllabus <- function(path = ".", questions = FALSE, use_built = TRUE) {
# The home page contains three things:
# 0. The main title as a header
# 1. the content of index.md from the top level of the lesson directory
# 2. The computed syllabus
#
# The syllabus is a table containing timings, links, and questions associated
# with each episode.
this_lesson(path)
if (!is.null(instructor_globals$get()$syllabus)) {
return(instructor_globals$get()$syllabus)
}
sched <- .resources$get()[["episodes"]] %||%
get_resource_list(path, trim = TRUE, subfolder = "episodes")
create_syllabus(sched, this_lesson(path), path, questions)
}
create_syllabus <- function(episodes, lesson, path, questions = TRUE) {
if (is.null(episodes)) {
out <- data.frame(
episode = character(0),
timings = character(0),
path = character(0),
percents = character(0),
stringsAsFactors = FALSE
)
return(out)
}
sched <- fs::path_file(episodes)
# We have to invalidate the cache if the syllabus is mis-matched
cache_invalid <- !setequal(sched, names(lesson$episodes))
if (cache_invalid) {
lesson <- set_this_lesson(path)
}
episodes <- lesson$episodes[sched]
quest <- if (questions) vapply(episodes, get_questions, character(1)) else NULL
timings <- vapply(episodes, get_timings, numeric(1))
titles <- vapply(episodes, get_titles, character(1))
# NOTE: This assumes a flat file structure for the website.
paths <- fs::path_ext_set(sched, "html")
start <- as.POSIXlt("00:00", format = "%H:%M", tz = "UTC")
# Note: we are creating a start time of 0 and adding "Finish" to the end.
if (any(timings < 0)) {
bad <- which(timings < 0)
msg <- c("There are missing timings from {length(bad)} episode{?s}.",
"*" = "{.file {sched[bad]}}",
"i" = "The default value of {.emph 5 minutes} will be used for teaching and exercises.")
cli::cli_warn(msg)
}
cumulative_minutes <- cumsum(c(0, abs(timings))) * 60L
out <- data.frame(
episode = c(titles, "Finish"),
timings = format(start + cumulative_minutes, "%Hh %Mm"),
path = c(paths, ""),
percents = sprintf("%1.0f", 100 * (cumulative_minutes / max(cumulative_minutes))),
stringsAsFactors = FALSE
)
if (questions) {
out$questions <- c(quest, "")
}
return(out)
}
get_titles <- function(ep) {
yaml <- ep$get_yaml()
yaml$title
}
get_timings <- function(ep) {
yaml <- ep$get_yaml()
coerce_integer <- function(i, default = -5L) {
not_integer <- !grepl("^[0-9]+$", i)
# NULL will return logical(0)
if (length(not_integer) == 0 || not_integer) {
i <- default
}
return(as.integer(i))
}
times <- c(coerce_integer(yaml$teaching), coerce_integer(yaml$exercises), coerce_integer(yaml[["break"]], 0L))
signs <- any(times < 0)
res <- as.integer(sum(abs(times), na.rm = TRUE))
if (signs) {
-res
} else {
res
}
}
get_questions <- function(ep) {
paste(ep$questions, collapse = "\n")
}