Working version with examples of the Shiny app

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: learnitgrid
 Type: Package
-Version: 0.7.1
+Version: 0.8.0
 Title: Manage Rubrics or Assessment Grids for GitHub Repositories
 Description: Create and manage semi-automatically rubrics to assess GitHub
   projects (R scripts, R Markdown or Quarto files). Create directed projects

NAMESPACE

@@ -8,8 +8,10 @@ export(dir_path_check)
 export(dir_path_create)
 export(file_path_check)
 export(get_git_stats)
+export(install_grid_example)
 export(link_to_www)
 export(populate_table)
+export(run_grid)
 export(www_relative)
 importFrom(DT,JS)
 importFrom(DT,dataTableOutput)
@@ -30,6 +32,7 @@ importFrom(fs,link_create)
 importFrom(fs,link_delete)
 importFrom(fs,link_exists)
 importFrom(fs,path)
+importFrom(ggplot2,element_text)
 importFrom(ggplot2,facet_wrap)
 importFrom(ggplot2,geom_histogram)
 importFrom(ggplot2,geom_point)
@@ -58,6 +61,8 @@ importFrom(shinydashboard,dashboardPage)
 importFrom(shinydashboard,dashboardSidebar)
 importFrom(stats,fivenum)
 importFrom(stringdist,stringsim)
+importFrom(utils,browseURL)
 importFrom(utils,read.csv)
+importFrom(utils,untar)
 importFrom(utils,write.csv)
 importFrom(writexl,write_xlsx)

NEWS.md

@@ -1,3 +1,13 @@
+# learnitgrid 0.8.0
+
+-   An extended example dataset is added (compressed in the package, but can be easily uncompressed using `install_example()`).
+
+-    The `run_grid()` function is added to easily run the learnitgrid Shiny application.
+
+-   Adding support for Quarto .qmd files.
+
+-   New option docs_on_github to specify the location of the documents for the links. It is `TRUE` by default, which corresponds to previous behavior (i.e., links to GitHub files). If `FALSE`, the links will be to local files, except for "repo" and the subdirectory). 
+
 # learnitgrid 0.7.1
 
 -   Several package dependencies are eliminated.

R/create_context.R

@@ -16,31 +16,33 @@
 #' @return A list with the context information for the learnitgrid Shiny app.
 #' @export
 create_context <- function(correction, base_corr_dir, base_templ_dir,
-base_repos_dir, repositories, assignments, github_url, branch) {
+    base_repos_dir, repositories, assignments, github_url, branch) {
+  # Note: for now, it is hardcoded in default_correction at the top of the file!
+  # Populate a list of correction folders available
   course_dirs <- dir_ls(base_corr_dir, type = "directory")
   if (!length(course_dirs))
-    stop("There is still no evalaution grids for this assignment. ",
-      "Use the script '04create_assessments4.R' to create them...")
+    stop("Il n'y a pas encore de grilles de correction disponibles. ",
+      "Utilisez le script '04create_assessments3.R' pour les cr\u00e9er...")
   courses <- basename(course_dirs)
 
   corr_dirs <- dir_ls(course_dirs, type = "directory")
   if (!length(corr_dirs))
-    stop("There is still no evalaution grids for this assignment. ",
-      "Use the script '04create_assessments4.R' to create them...")
+    stop("Il n'y a pas encore de grilles de correction disponibles. ",
+      "Utilisez le script '04create_assessments3.R' pour les cr\u00e9er...")
   corrections <- basename(corr_dirs)
 
   if (is.null(correction) || !length(correction) || correction == "")
-    stop("Correction set not provided, or operation cancelled.")
+    stop("Correction set non fourni, ou op\u00e9ration annul\u00e9e.")
   if (!correction %in% corrections)
-    stop("Correction set '", correction, "' not found. Check it...")
+    stop("Correction set '", correction, "' introuvable. V\u00e9rifiez sa valeur...")
 
   # Get corr_dir for this correction + get course, assignment and corr_date
   corr_dir <- corr_dirs[corrections == correction]
   course <- basename(dirname(corr_dir))
   corr_parts <- strsplit(correction, "_", fixed = TRUE)[[1]]
   if (length(corr_parts) < 4)
-    stop("Problem with the correction set '", correction,
-      "'  : it should be something like A00Ia_21M_title_2022-01-01")
+    stop("Il y a un probl\u00e8me avec le set de corrections '", correction,
+      "'  : il devrait \u00eatre quelque chose comme A00Ia_21M_titre_2022-01-01")
   corr_date  <- corr_parts[length(corr_parts)]
   assignment <- paste(corr_parts[-length(corr_parts)], collapse = "_")
   rm(corr_parts)
@@ -81,13 +83,14 @@ base_repos_dir, repositories, assignments, github_url, branch) {
   #if (!is.null(app))
   #  assign_infos <- assign_infos[tolower(assign_infos$app) == tolower(app), ]
   if (!NROW(assign_infos)) {
-    stop("The selected assignment (", assignment, ") is not found in ",
-      "the table.")
+    stop("L'exercice s\u00e9lectionn\u00e9 (", assignment,
+      ") n'est pas trouv\u00e9 dans la table des exercices.")
   }
 
   if (NROW(assign_infos) > 1) {
-    warning("The selected assignment (", assignment,
-      ") is found in several variants in the table. Use of the first one.")
+    warning("L'exercice s\u00e9lectionn\u00e9 (", assignment,
+      ") est trouv\u00e9 dans la table ",
+      " des exercices en plusieurs exemplaires. Utilisation du premier.")
     assign_infos <- assign_infos[1, ]
   }
 
@@ -102,7 +105,7 @@ base_repos_dir, repositories, assignments, github_url, branch) {
     templ_corrs[substring(templ_corrs$criterion, 1, 8) != "!{login}", ]
 
   # Path of git_stat.csv
-  git_stats <- file_path_check(repos_dir, "git_stats.csv")
+  git_dir <- file_path_check(repos_dir, "git_stats.csv")
 
   # The context object (list) contains info required to populate tables
   context <- list(
@@ -112,7 +115,7 @@ base_repos_dir, repositories, assignments, github_url, branch) {
     assign_infos = assign_infos, # Informations about the assignment
     github_url = github_url,     # The base URL for GitHub links
     branch = branch,             # The GitHub branch
-    git_stats_file = git_stats,  # The path to git_stats.csv file
+    git_dir = git_dir,           # The path to git_stats.csv
     user_logins = user_logins,   # The users logins (teams for group projects)
     repos_names = repos_names,   # The names of repositories
     repos_names2 = repos_names2, # The names of repos if different from apps

R/get_git_stats.R

@@ -3,23 +3,23 @@
 #' @description Use data from a git_stats.csv file to get a history of commits
 #'   done in a repository for the learnitgrid Shiny app.
 #'
-#' @param git_stats_file The path the the git_stats.csv file
+#' @param dir The path the the git_stats.csv file
 #' @param exclude_authors The list of authors to exclude from the stats
 #' @param type The type of files to consider ("all", "R", "Rmd", or "Qmd")
 #' @param tz The time zone to use for times
 #'
 #' @return A data frame with git stats data to be used by the learnitgrid Shiny
 #'   app.
 #' @export
-get_git_stats <- function(git_stats_file,
-exclude_authors = "github-classroom[bot]", type = "all", tz = "UTC") {
+get_git_stats <- function(dir, exclude_authors = "github-classroom[bot]",
+    type = "all", tz = "UTC") {
 
-  if (!file_exists(git_stats_file))
-    stop("The file ", git_stats_file, " does not exist")
-  stat <- suppressMessages(read.csv(git_stats_file))
+  if (!file_exists(dir))
+    stop("The directory ", dir, " does not exist")
+  stat <- suppressMessages(read.csv(dir))
 
   # TODO: allow for more types too (e.g., doc, docx, pdf, ppt, pptx, ...)
-  vec <- match.arg(type, choices = c("all", "R", "Rmd", "Qmd"),
+  vec <- match.arg(type, choices = c("all", "R", "Rmd", "qmd"),
     several.ok = TRUE)
 
   if (length(exclude_authors))
@@ -41,3 +41,5 @@ exclude_authors = "github-classroom[bot]", type = "all", tz = "UTC") {
 
   stat
 }
+
+#res <- stat_git(git_stats, type = c("Rmd", "R"))

R/install_grid_example.R

@@ -0,0 +1,38 @@
+#' Install and extended example dataset to try the learnitgrid Shiny application
+#'
+#' @param dir The directory where to decompress the extended example
+#' @param browse Should we browse the example directory after decompression?
+#'
+#' @return The path to the example learnitgrid data is returned invisibly.
+#' @seealso [run_grid()]
+#' @export
+#'
+#' @examples
+#' # Install the extended examples in a temporary directory
+#' \dontrun{
+#' library(learnitgrid)
+#' ex_dir <- install_grid_example(browse = TRUE)
+#' }
+install_grid_example <- function(dir = tempdir(), browse = FALSE) {
+  if (is.null(dir) || !length(dir) || !is.character(dir) || !dir.exists(dir))
+    stop("dir must be a single existing directory")
+
+  # Decompress the example archive
+  ex_archive <- system.file('example', 'learnitgrid-example.tar.xz',
+    package = 'learnitgrid')
+  ex_dir <- file.path(dir, 'learnitgrid-example', 'www')
+  if (!dir.exists(ex_dir))
+    untar(ex_archive, exdir = dir)
+  if (!dir.exists(ex_dir))
+    stop("example data was not decompressed correctly")
+
+  # Put the path in the options
+  options(learnitgrid.data.dir = as.character(ex_dir))
+
+  if (isTRUE(browse)) {
+    message("Browsing ", ex_dir, "...")
+    browseURL(ex_dir)
+  }
+
+  invisible(ex_dir)
+}

R/learnitgrid-package.R

@@ -20,7 +20,7 @@
 #' @importFrom glue glue
 #' @importFrom fs path dir_create dir_exists dir_ls file_exists link_create link_delete link_exists
 #' @importFrom collapse fcumsum GRP roworder
-#' @importFrom ggplot2 geom_histogram facet_wrap geom_point geom_step geom_vline labs theme xlim
+#' @importFrom ggplot2 geom_histogram element_text facet_wrap geom_point geom_step geom_vline labs theme xlim
 #' @importFrom stats fivenum
 #' @importFrom lubridate ymd_hms with_tz
 #' @importFrom parsermd as_document by_section has_label has_type parse_rmd rmd_select
@@ -30,7 +30,7 @@
 #' @importFrom shinydashboard dashboardBody dashboardHeader dashboardPage dashboardSidebar
 #' @importFrom shinycssloaders withSpinner
 #' @importFrom stringdist stringsim
-#' @importFrom utils read.csv write.csv
+#' @importFrom utils browseURL read.csv untar write.csv
 #' @importFrom writexl write_xlsx
 # The following block is used by usethis to automatically manage
 # roxygen namespace tags. Modify with care!