R/set_assignment.R

In MansMeg/markmyassignment: Automatic Marking of R Assignments

#' @title
#' Set and remove assignments
#' 
#' @description
#' Sets the assignment to mark and downloads necessary files.
#' 
#' @param path
#' Path to the yml file
#' @param auth 
#' Authorization object generated by \code{httr::authenticate()}. See \code{authenticate} and \url{https://github.com/r-lib/httr/blob/master/demo/oauth2-github.r} on details on how to use \code{authenticate()}.
#' 
#' @examples
#' assignment_path <- 
#'   file.path(system.file(package = "markmyassignment"), 
#'             "/extdata/example_assignment01.yml")
#' set_assignment(assignment_path)
#' 
#' @export
set_assignment <- function(path, auth = NULL){
  checkmate::assert_string(path)
  if(!is.null(auth)){
    checkmate::assert_class(auth, "request")
    checkmate::assert_names(names(auth$options), permutation.of = c("httpauth", "userpwd"))
  }
  
  # Get path_type object 
  # path <- markmyassignment:::path_type(path, auth = NULL)
  path <- path_type(path, auth)
  
  # Create a new temporary markmyassignment temp folder
  temp_folder_check_create()
  temp_file <- tempfile()
  on.exit(unlink(temp_file))
  
  # Remove previous assignment (if set)
  if(is_assignment_set()) remove_assignment()
  
  dir.create(mark_my_assignment_dir(), recursive = TRUE, showWarnings = FALSE)
  dest <- paste0(mark_my_assignment_dir(), "/assignment_config.yml")
  get_file(path = path, dest = temp_file)
  assignment <- read_assignment_yml(yml_path = temp_file)

  # Download all tasks and store locally
  assignment <- download_assignment(assignment, path)
  
  # Write final yml config file 
  write_assignment_yml(assignment, dest)
  
  # Check that packages is installed
  check_installed_packages(assignment)
  
  message(construct_assignment_description(assignment))
  invisible(dest)
}

#' @rdname set_assignment
#' @export
remove_assignment <- function() {
  unlink(mark_my_assignment_dir(), recursive = TRUE, force = TRUE)
}

#' @rdname set_assignment
#' @export
is_assignment_set <- function(){
  file.exists(mark_my_assignment_dir())
}

#' @rdname set_assignment
#' @export
show_assignment <- function(){
  cat(construct_assignment_description())
}

#' Construct assignment description
#' 
#' @param assignment an assignment to create description for.
#' 
#' @keywords internal
construct_assignment_description <- function(assignment = NULL){
  if(!is.null(assignment)) {
    checkmate::assert_class(assignment, "assignment_config")
  } else {
    assignment <- read_assignment_yml()
  }
  
  if(length(assignment$tasks) > 1){
    task_contain <- paste0("The assignment contain the following (", length(assignment$tasks), ") tasks:\n")
  } else {
    task_contain <- paste0("The assignment contain the following task:\n")
  }

  task_descriptions <- paste0("- ", names(assignment$tasks))
  for(i in seq_along(task_descriptions)){
    desc <- as.character(assignment$tasks[[i]]$description)
    if(length(desc) > 0) task_descriptions[i] <- paste0(task_descriptions[i], ": ", desc)
  }
  task_descriptions <- paste0(paste0(task_descriptions, "\n"), collapse = "")

  paste0(paste0("Assignment set:\n", assignment$name, ": ", assignment$description, "\n"),
         task_contain,
         task_descriptions)

}


#' Download assignment and store in temporary folder
#' 
#' @description
#' Downloads the test files for the current assignment and save them to 
#' temp directory.
#' 
#' @keywords internal
download_assignment <- function(assignment, path){
  checkmate::assert_class(assignment, "assignment_config")
  checkmate::assert_class(path, "path_type")
  
  dir.create(path = mark_my_tasks_dir(), recursive = TRUE, showWarnings = FALSE)
  dir.create(path = mark_my_run_code_dir(), recursive = TRUE, showWarnings = FALSE)

  # assignment <- markmyassignment:::read_assignment_yml("inst/extdata/example_assignment01.yml")
  assignment_path_df <- assignment_paths_and_files(assignment)

  # Download all task test files
  for(j in seq_along(assignment$tasks)) {
    assignment$tasks[[j]]$local_tmp_path <- character(0)
    for(i in seq_along(assignment$tasks[[j]]$url)){
      dest <- paste0(mark_my_tasks_dir(), "/", assignment_path_df[assignment_path_df$i == i & 
                                                                    assignment_path_df$j == j & 
                                                                    assignment_path_df$class == "tasks", "test_file"])
      assignment$tasks[[j]]$local_tmp_path[i] <- dest
      assignment_path <- get_assignment_full_subpath(assignment$tasks[[j]]$url[i], path)
      get_file(path = assignment_path, dest = dest)
    }
  }

  # Download all mandatory test files
  if("mandatory" %in% names(assignment)){
    assignment$mandatory$local_tmp_path <- character(0)
    for(i in seq_along(assignment$mandatory$url)){
      dest <- paste0(mark_my_tasks_dir(), "/", assignment_path_df[assignment_path_df$i == i & assignment_path_df$class == "mandatory", "test_file"])
      assignment$mandatory$local_tmp_path[i] <- dest
      assignment_path <- get_assignment_full_subpath(assignment$mandatory$url[i], path)
      get_file(path = assignment_path, dest = dest)
    }
  }
  
  # Download all run_code files
  if("run_code" %in% names(assignment)){
    for(j in seq_along(assignment$run_code)) {
      assignment$run_code[[j]]$local_tmp_path <- character(0)
      for(i in seq_along(assignment$run_code[[j]]$url)){
        dest <- paste0(mark_my_run_code_dir(), "/", assignment_path_df[assignment_path_df$i == i &assignment_path_df$j == j & assignment_path_df$class == "run_code", "test_file"])
        assignment$run_code[[j]]$local_tmp_path[i] <- dest
        assignment_path <- get_assignment_full_subpath(assignment$run_code[[j]]$url[i], path)
        get_file(path = assignment_path, dest = dest)
      }
    }
  }
  
  return(assignment)
}





#' @title
#'  Check and create folder if missing.
#' 
#' @description
#'   Checks if markmyassignment folder exist in R temp directory.
#'   If not, the folder is created.
#'   
#' @keywords internal
#' 
temp_folder_check_create <- function() {
  if(!"markmyassignment" %in% dir(tempdir())){
    dir.create(path = mark_my_base_dir())
  }
}


#' @title
#' Get the path type.
#' 
#' @description
#' Check the path type. 
#' 
#' @param path Character element of url or local search path.
#' @param auth an auth request class with options \code{httpauth} and \code{userpwd}.
#' 
#' @return \code{path_type} object with c("path_local", "path_http", "path_error")
#' 
#' @keywords internal
#' 

path_type <- function(path, auth = NULL){
  checkmate::assert_string(path)
  if(!is.null(auth)){
    checkmate::assert_class(auth, "request")
    checkmate::assert_names(names(auth$options), permutation.of = c("httpauth", "userpwd"))
  }

  #path <- "example_mandatory.R"
  path_obj <- list(path = path)
  
  if(file.exists(path_obj$path)){
    class(path_obj) <- c("path_local", "path_type", "list")
    return(path_obj)
  } 
  
  is_github <- is_github_path(path_obj$path)
  if (is_github){
    if(is_github == "api_git") stop(path, " is an incorrect github URL (it is a git_url).")
    if(!(names(is_github) == "raw" & is.null(auth))){
      gpi <- get_github_path_info(path_obj$path)
      path_obj$auth <- auth
      path_obj$owner <- gpi$owner
      path_obj$repo <- gpi$repo
      path_obj$branch <- gpi$branch
      path_obj$subpath <- gpi$path
      class(path_obj) <- c("path_github", "path_type", "list")
      return(path_obj)      
    }
  }
  
  try_http <- try(identical(httr::status_code(httr::HEAD(path_obj$path)), 200L), silent = TRUE)
  if (!methods::is(try_http, "try-error") && try_http){
    path_obj$auth <- auth
    class(path_obj) <- c("path_http", "path_type", "list")
    return(path_obj)
  } 
  
  stop("'", path, "' is an incorrect path.")
}

#' @title
#' Get the file from the path
#' 
#' @description
#' Get/download the file from the path.
#' 
#' @param path
#'   Path object
#' @param dest
#'   Destination for the file
#' @param ...
#'   Further arguments to send to \code{httr::GET()}.
#' 
#' @keywords internal
get_file <- function(path, dest, ...){
  checkmate::assert_class(path, "path_type")
  UseMethod("get_file")
}

#' @rdname get_file
#' @keywords internal
get_file.path_local <- function(path, dest, ...){
  file.copy(from = path$path, to = dest, overwrite = TRUE)
}

#' @rdname get_file
#' @keywords internal
get_file.path_http <- function(path, dest, ...){
  if(is.null(path$auth)){
    request <- httr::GET(path$path, ...)
  } else {
    request <- httr::GET(path$path, path$auth, ...)
  }
  httr::stop_for_status(request)
  writeBin(httr::content(request, "raw"), dest)
}

#' @rdname get_file
#' @keywords internal
get_file.path_github <- function(path, dest, ...){
  if(is.null(path$auth)){
    request <- httr::GET(create_github_download_url(path), ...)
  } else {
    request <- httr::GET(create_github_download_url(path), path$auth, ...)
  }
  httr::stop_for_status(request)
  writeBin(httr::content(request, "raw"), dest)
}





#' @title
#' Read assignment information
#' 
#' @description
#' Check if there exist an assignmentfile and then load it.
#' 
#' @param yml_path \code{path object} from \code{\link{path_type}}
#' 
#' @return assignment object
#' 
#' @keywords internal
#' 
read_assignment_yml <- function(yml_path = NULL){
  if(is.null(yml_path)){
    assignment_file <- file.path(mark_my_assignment_dir(), "assignment_config.yml")
  } else {
    assignment_file <- yml_path
  }
  if(file.exists(assignment_file)){
    res <- suppressWarnings(yaml::yaml.load_file(assignment_file))
    res <- assignment_config(x = res)
    return(res)
  } else {
    stop("No assignment has been set. Please use set_assignment().", call. = FALSE)
  }
}

#' @title
#' Read assignment information
#' 
#' @description
#' Check if there exist an assignmentfile and then load it.
#' 
#' @param assignment a \code{assignment_config} object to write
#' @param yml_path a \code{path} to write yml file to
#' 
#' @keywords internal
write_assignment_yml <- function(assignment, yml_path){
  checkmate::assert_class(assignment, "assignment_config")
  checkmate::assert_path_for_output(yml_path, overwrite = TRUE)

  writeLines(suppressWarnings(yaml::as.yaml(assignment)), yml_path)
  return(invisible(NULL))
}


#' @title 
#' Constructor for \code{assignment_config} object
#' 
#' @description 
#' Constructor for \code{assignment_config} object.
#' 
#' @param x a list to convert to a \code{assignment_config} object.
#' 
#' @keywords internal
#' 
assignment_config <- function(x){
  class(x) <- c("assignment_config", "list")
  assert_assignment_config(x)
  x
}


#' @title
#' Assert a \code{assignment_config} object.
#' 
#' @description 
#' Check assignment yml file that it is a correct assignment file.
#' 
#' @param assignment object to test.
#' 
#' @return a checked \code{assignment_config} object.
#'   
#' @keywords internal
assert_assignment_config <- function(assignment){
  checkmate::assert_class(assignment, c("list", "assignment_config"))
  # The yml contain at most 6 slots.
  checkmate::assert_names(names(assignment), 
                          must.include = c("name", "description", "tasks"),
                          subset.of = c("name", "description", "reporter", "tasks", "mandatory", "packages", "run_code"))
  # The name and description is of length 1
  checkmate::assert_string(assignment$name)
  checkmate::assert_string(assignment$description)
  
  # Assert that url exists
  for(i in seq_along(assignment$tasks)){
    checkmate::assert_names(names(assignment$tasks[[i]]), must.include = "url", subset.of = c("url", "description", "local_tmp_path"))
    checkmate::assert_character(assignment$tasks[[i]]$url)
    checkmate::assert_character(assignment$tasks[[i]]$description, null.ok = TRUE)
  }
  
  # Assert mandatory
  if("mandatory" %in% names(assignment)) {
    checkmate::assert_names(names(assignment$mandatory), must.include = "url", subset.of = c("url", "description", "local_tmp_path"))
    checkmate::assert_character(assignment$mandatory$url)
    checkmate::assert_character(assignment$mandatory$description, null.ok = TRUE)
  }
  
  if("packages" %in% names(assignment)) {
    checkmate::assert_character(assignment$packages)
  }
  
  if("reporter" %in% names(assignment)) {
    .Deprecated(old = "'reporter' in yml", new = "... in mark_my_assignment() or mark_my_file()")
    checkmate::assert_string(assignment$reporter)
  }
  
  if("run_code" %in% names(assignment)) {
    for(i in seq_along(assignment$run_code)){
      checkmate::assert_names(names(assignment$run_code), subset.of = c("before", "after"))
      checkmate::assert_names(names(assignment$run_code[[i]]), must.include = "url", subset.of = c("url", "local_tmp_path"))
      checkmate::assert_character(assignment$run_code[[i]]$url)
    }
  }
  
  assignment
}


#' @title
#'   Get the name of the tasks in the assignment.
#' 
#' @description
#'   Get the name of the tasks in the assignment.
#'   
#' @examples
#' # We first set the assignment
#' assignment_path <- 
#'  file.path(system.file(package = "markmyassignment"), "extdata/example_assignment01.yml")
#' set_assignment(assignment_path)
#'  
#' show_tasks()
#' 
#' @export
show_tasks <- function(){
  assignment <- read_assignment_yml()
  names(assignment$task)
}


#' @title
#'  Check whether required packages are installed and loaded.
#' 
#' @description
#'   Checks if the packages listed in assignment file are loaded and installed.
#'   If not, a warning message is printed.
#' @param assignment
#'   \code{assignment_config} to check packages for.
#'   
#' @keywords internal
#'   
check_installed_packages <- function(assignment) {
  checkmate::assert_class(assignment, "assignment_config")
  if(is.null(assignment$packages)) return(invisible(TRUE))
  
  packages <- assignment$packages
  
  if(all(paste("package:", packages, sep="") %in% search())){
    # All packages are loaded and installed
  }else{
    if(all(packages %in% rownames(utils::installed.packages()))){
      warning("The following packages should be loaded:\n",
              paste(packages[!paste("package:", packages, sep="") %in% search()], collapse = ", "), call. = FALSE)
    }
    else{
      warning("The following packages need to be installed and then loaded:\n",
              paste(packages[!packages %in% rownames(utils::installed.packages())], collapse=", "), call. = FALSE)
    }
  }
  
  return(invisible(TRUE))
}



#' Get the full path from assignment paths 
#' 
#' @description 
#' The individual paths of assignmentfiles etc can be specified both in full and relative to the assignment file.
#' This function computes the full path.
#' 
#' @param sub_path the url to compute the full path for.
#' @param path the assignment \code{path_type}.
#' 
#' @keywords internal
get_assignment_full_subpath <- function(sub_path, path){
  checkmate::assert_class(path, "path_type")
  checkmate::assert_string(sub_path)
  
  # Compute base path (that the other is relative to)
  base_path <- strsplit(path$path, "/")[[1]]
  base_path <- file.path(paste(base_path[-length(base_path)], collapse = "/"))
  
  # test that is of same path_type and file exist -> otherwise assume a relative path to original path
  sub_path_type <- try(path_type(sub_path), silent = TRUE)
  if(methods::is(sub_path_type, "try-error")) {
    return(path_type(file.path(base_path, sub_path)))
  } else {
    return(sub_path_type)
  }
}

#' @title
#'  Functions to create directories
#'  
#' @description
#'  Functions to create directories
#'  
#' @name directories
#' 
#' @keywords internal
#' 
mark_my_base_dir <- function() file.path(tempdir(), "markmyassignment")

#' @rdname directories
#' @param no assignment number
#' @keywords internal
mark_my_assignment_dir <- function(no = 1) file.path(mark_my_base_dir(), paste0("assignment", no))

#' @rdname directories
#' @param ... to send to \code{\link{mark_my_assignment_dir}}
#' @keywords internal
mark_my_tasks_dir <- function(...) file.path(mark_my_assignment_dir(...), "tasks")

#' @rdname directories
#' @param ... to send to \code{\link{mark_my_assignment_dir}}
#' @keywords internal
mark_my_run_code_dir <- function(...) file.path(mark_my_assignment_dir(...), "run_code")



#' Get assignment paths and files
#'
#' @param assignment a \code{assignment_config} object.
#' @keywords internal
assignment_paths_and_files <- function(assignment = NULL){
  if(!is.null(assignment)){
    checkmate::assert_class(assignment, "assignment_config")
  } else {
    # assignment <- markmyassignment:::read_assignment_yml("inst/extdata/example_assignment_full.yml")
    assignment <- read_assignment_yml()
  }
  
  task_name <- path_name <- test_file_name <- js <- is <- list()
  for(j in seq_along(assignment[["tasks"]])) {
    task_name[[j]] <- path_name[[j]] <- test_file_name[[j]] <- js[[j]] <- is[[j]] <- list()
    for(i in seq_along(assignment[["tasks"]][[j]]$url)){
      fn <- strsplit(assignment[["tasks"]][[j]]$url[i], "/")[[1]]
      path_name[[j]][[i]] <- fn[length(fn)]
      test_file_name[[j]][[i]] <- paste0("test-task-", j, "-subtask-", i, "-tests.R")
      task_name[[j]][[i]] <- names(assignment[["tasks"]])[j]
      js[[j]][[i]] <- j
      is[[j]][[i]] <- i
    }
  }
  df <- data.frame(name = unlist(task_name), path_file = unlist(path_name), test_file = unlist(test_file_name), class = "tasks", j = unlist(js), i = unlist(is))
  
  task_name <- test_file_name <- class_name <- is <- list()
  for(i in seq_along(assignment[["mandatory"]]$url)) {
    fn <- strsplit(assignment[["mandatory"]]$url[i], "/")[[1]]
    task_name[[i]] <- fn[length(fn)]
    test_file_name[[i]] <- paste0("test-mandatory-", i, ".R")
    class_name[[i]] <- "mandatory"
    is[[i]] <- i
  }
  df <- rbind(df, data.frame(name = unlist(class_name), path_file = unlist(task_name), test_file = unlist(test_file_name), class = unlist(class_name), j = rep(NA, length(unlist(task_name))), i = unlist(is)))
  
  task_name <- path_name <- test_file_name <- js <- is <- list()
  for(j in seq_along(assignment[["run_code"]])) {
    task_name[[j]] <- path_name[[j]] <- test_file_name[[j]] <- js[[j]] <- is[[j]] <- list()
    for(i in seq_along(assignment[["run_code"]][[j]]$url)){
      fn <- strsplit(assignment[["run_code"]][[j]]$url[i], "/")[[1]]
      path_name[[j]][[i]] <- fn[length(fn)]
      task_name[[j]][[i]] <- names(assignment[["run_code"]])[j]
      test_file_name[[j]][[i]] <- paste0("run_code-", task_name[[j]][[i]], "-", i, ".R")
      js[[j]][[i]] <- j
      is[[j]][[i]] <- i
    }
  }
  df <- rbind(df, data.frame(name = unlist(task_name), path_file = unlist(path_name), test_file = unlist(test_file_name), class = rep("run_code", length(unlist(task_name))), j = unlist(js), i = unlist(is)))
  
  df
}