#' List available assignments
#'
#' @param pkg path to course package
#'
#' @return character vector with assignment names
#' @export
listAssignments <- function(pkg) {
.listAssignments(pkg)
}
#' Start an assignment
#'
#' This function will create an RMD file that you can use to start working on
#' solutions for an assignment. It also refreshes the data files in your data/
#' directory.
#'
#' @param name name of the assignment to start
#' @param overwrite if TRUE this function will overwrite any existing work
#' you've done on this asignment already
#' @param path optional path to your course project folder
#' @param pkg path to course package
#'
#' @return new file path
#'
#' @export
startAssignment <- function(name, overwrite = FALSE, path = getwd(), pkg) {
taskPath <- file.path(pkg, "data", "assignments")
tryCatch( source <- getRMDFile(name, taskPath, exists = TRUE)
, error = function(e) {
stop(e$message, "\n\nThere is no assignment with that name. Try `listAssignments()`.")
}
)
dest <- getRMDFile(name, path, exists = FALSE)
if (file.exists(dest) && !overwrite) {
stop("An excercise of that name already exists; use overwrite = TRUE if you'd like to erase your current copy.")
}
message("Copying assignment file to: ", dest)
file.copy(from = source, to = dest, overwrite = overwrite)
message("Refreshing `data/` folder")
file.copy( from = file.path(taskPath, "data/") # TODO check hashes
, to = file.path(path)
, recursive = TRUE
)
dest
}
#' Check an assignment
#'
#' Allows you to check your current progress on an assignment against a
#' reference solution.
#'
#' @param name name of the assignment to check
#' @param path optional path to your course project folder
#' @param autoknit if TRUE your assignment Rmd files will automatically be
#' re-knitted when you save changes
#' @param pkg path to course package
#'
#' @return true if we don't find anything dodgy
#' @export
checkAssignment <- function(name, path = getwd(), autoknit = TRUE, pkg) {
file <- getRMDFile(name, path)
message("Knitting ", name)
rmarkdown::render(file, envir = new.env())
if (grepl(".[Rr]md$", name)) {
name <- substring(name, 1, nchar(name) - 4)
}
launchStudentUI(pkg = pkg, page = name, autoknit = autoknit, wd = path)
}
#' Submit an assignment
#'
#' Submits the last version of the assignment that was checked with
#' \code{\link{checkAssignment}} or \code{\link{checkAssignments}}.
#'
#' @param name name of the assignment to submit
#' @param path optional path to your course project folder
#' @param pkg path to course package
#'
#' @export
submitAssignment <- function(name, path = getwd(), pkg) {
source <- rdsPath(name, studentPath(pkg))
if (!file.exists(source)) {
stop("It doesn't look like you've ever checked your answers to this assignment. Please do so with the `checkAssignment` function.")
}
data <- readRDS(source)
file <- data$sourceRMD
if (!file.exists(file) || data$sourceHASH != hash(file)) {
warning("It looks like you've changed your source file for this assignment since the last time you checked it. You are currently submitting the last CHECKED version. You may want to run `checkAssignment` to check your current source file and then resubmit.")
}
dest <- rdsPath(name, file.path(studentPath(pkg), "submitted"))
saveRDS(object = data, file = dest)
message("Assignment submitted (Version: ", substring(data$sourceHASH, 1, 7), ")")
}
#' Check assignments
#'
#'
#' This function behaves differently when called from a student versus
#' instructor account. For students, it shows your current progress on all
#' assignments; for instructors a grading interface.
#'
#' @param path optional path to your course project folder
#' @param autoknit if TRUE your assignment Rmd files will automatically be
#' re-knitted when you save changes; ignored in instructor mode.
#' @param pkg path to course package
#'
#' @export
checkAssignments <- function(path = getwd(), autoknit = TRUE, pkg) {
config <- loadConfig(file.path(pkg, "data"))
user <- getUser()
if (!is.null(config$`instructor-user`) && user %in% config$`instructor-user`) {
launchInstructorUI(pkg = pkg)
} else if (config$`student-users` == "*" || user %in% config$`student-users`) {
launchStudentUI(pkg = pkg, page = 'overview', autoknit = autoknit, wd = path)
} else {
message("Your username does not appear to be an instructor or student in this course.")
}
}
#' Open course website
#'
#' This convenience function will open the course website in the RStudio Viewer
#' panel. Only works if run from within RStudio.
#'
#' @param pkg path to course package
#'
#' @export
website <- function(pkg) {
config <- loadConfig(file.path(pkg, "data"))
rstudio::viewer(config$build$site$url)
}
#' Publish the current version of a Shiny app project hosted on the course's
#' Bio-185 GitHub organization to the RNA Shiny server.
#'
#' @param projectName string with your group's project name. This must match
#' your group's repository name on GitHub.
#' @param remove if TRUE will remove the old version of your app and update.
#' @param pkg path to course package
#'
#' @export
publishApp <- function(projectName, remove = TRUE, pkg) {
config <- loadConfig(file.path(pkg, "data"))
basePath <- config$build$projects$publishPath
path <- file.path(basePath, projectName)
if (dir.exists(path) && remove) {
message("Removing old version...")
unlink(path, recursive = TRUE, force = TRUE)
} else if (dir.exists(path) && !remove) {
message("Can't publish; an app with that name already exists. Try 'remove = TRUE'.")
}
gitURL <- paste0("https://github.com/", config$build$projects$githubOrg, "/", projectName, ".git")
message("Trying to clone: ", gitURL)
system(paste0( "git clone "
, gitURL
, " "
, path
)
)
system(paste0("chmod -R g+w ", path))
system(paste0("chown -R :", config$`course-group`, " ", path))
message("If there were no errors, your app was published to:")
message(paste0(config$projects$shinyServer, projectName, "/"))
}
#' Copies any current error logs for your published shiny app into your current
#' working directory so that you can view them. Note the source log files are
#' only available while your app is still running; when you close the window the
#' they are erased.
#'
#' @param projectName string with your group's project name. This must match
#' your group's repository name on GitHub.
#' @param pkg path to course package
#'
#' @export
copyErrorLogs <- function(projectName, pkg) {
config <- loadConfig(file.path(pkg, "data"))
s <- paste0("cp ", config$build$projects$logPath, projectName, "*.log ./")
message("Trying to copy error logs...")
system(s)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.