rcourse: R Open Online Course (ROOC)

#' Class to build a web-site with rmarkdown rendering functionalities.
#'
#' @description The class generates a web-site based on the Rmd files in the directory 'site'. The directory has a flat structure
#' and contains several categories of files:
#'
#' \describe{
#'   \item{\strong{_site.yml}}{This file in YAML format describing the structure and the look of the site with menues and sub-menus.}
#'   \item{\strong{_schedule.yml}}{This file contains information about the course (see details).}
#'   \item{\strong{<module-name>.Rmd}}{These files contain the course material on a specific topic.}
#'   \item{\strong{_<name>.Rmd}}{These Rmd files can be re-used and are called from inside other Rmd files. They do not have a html
#'   counterpart in the _site directory.}
#'   \item{\strong{data and images}}{ These directories are copied into _site directory}
#'   \item{\strong{footer.html}}{Footer content for all pages.}
#'   \item{\strong{setup.R}}{This is needed if the individual Rmd files need to be generated inside RStudio using the 'knit' button.}
#'   \item{\strong{Styles.css}}{Stylesheet file for the appearance}
#' }
#'
#' The files prefixed with \strong{_} will not be rendered and are for internal use.
#'
#' @details
#'
#' The \strong{schedule} file has the following structure:
#'
#' \preformatted{
#'    course:
#'        title: <course-title>
#'        start: <start-date>
#'        end: <end-date>
#'        exam:
#'            date: <exam-date>
#'            time: <time-time>
#'            venue: <venue>
#'        slots:
#'            <slot-id>:
#'                title:  <session-title>
#'                subtitle: <session-subtitle>
#'                goal: <goals/description>
#'                date: <session-date>
#'                time: <session-time>
#'                venue: <venue>
#'                tasks : "yes | no"
#'            <slot-id>:
#'                ...
#' }
#'
#'
#'
#' @docType class
#' @importFrom R6 R6Class
# @export
#' @format An \code{\link{R6Class}} generator object
#' @section Methods:
#'
#'@examples
#' rcourse <- Course$new()
#' rcourse$view()
#'
#'@export
Course <- R6Class("Course",
    private = list(
      sources_ = NULL,
      url_ = NULL,
      site_ = NULL,
      schedule_ = NULL,
      config_ = NULL,
      modified = function(f) {
        # Returns TRUE if the html file of the corresponding 'Rmd' file is absent or the
        # Rmd' file's modification date exceeds the html's.
        html_file <- file.path(self$src(),"_site",paste0(f,".html"))
        ifelse(!file.exists(html_file), TRUE,
               ((file.info(html_file)$mtime - file.info(file.path(self$src(), paste0(f,".Rmd") ) )$mtime )  <= 0) )
      },
      zip_ = function(zip_file, what) {
        prefix <- sub(".zip","",zip_file)
        if (file.exists(prefix))
          unlink(prefix)
        if (file.exists(zip_file))
          unlink(zip_file)
        file.symlink(from = private$sources_, to = prefix)
#        zip::zip(zipfile = paste0(prefix,".zip"), files = paste0(prefix,"/",self$listing(what)), flags = "-r")
        zip::zip(zipfile = paste0(prefix,".zip"), files = paste0(prefix,"/",self$listing(what)), recurse = TRUE)
        unlink(prefix)
      },
      read_schedule = function() {
        cfg <- file.path(self$src(),"_schedule.yml")
        if (file.exists(cfg) ) {
          private$schedule_ <- yaml.load_file( cfg  )
        } else {
          error("missing _schedule.yml !")
        }
      }
    ),
    public = list(
      #' @param path_ course directory path.
      path_ = NULL,
      course_ = NULL,
      #' @description Load config.yml file.
      #' @param path ...
      #' @param config_file ...
      load_config = function(path, config_file) {
        private$config_ <- yaml.load_file(file.path(path,config_file))
      },
      #' @description Access config.yml file. Given 'id' return value otherwise the complete list.
      #' @param id
      config = function(id=NULL) {
        if (is.null(id)) {
          private$config_
        } else {
          private$config_[[id]]
        }
      },
      #' @description Builds a TheCourse instance based on the 'config.yml' file in the path 'dir'
      #' @param config config-file name.
      initialize = function(path, config_file="config.yml", site="docs") {
        # Course config file (YAML)
        self$load_config(path,config_file)
        #
        index_html <- self$config("index_file") # todo: prefix S01L01l is generated by rendering, but is fixed in config!

        self$path_ <- path
        private$sources_ <- path
        private$site_ <- file.path(dirname(self$src()), site)
        private$url_ <- file.path(self$site(),index_html)

        # global course info
        startDate <- as.Date(self$config("startDate"))
        # TheCourse object
        course <- TheCourse$new( id = self$config("course_id"), dir = path, label =  self$config("course_label") )
        # Slots :  slot => Session
        #
        slots <- self$config("slots")
        for( i in seq_len( length( slots ) ) ) {
          slot_id <- names(slots)[[i]]
          slot <- slots[[i]]
          session_ <- Session$new(
            id = slot_id, label = slot[["slot_label"]],
            date = startDate + slot[["slot_date"]],
            timeRange = slot[["slot_time"]],
            breaksPattern = slot[["slot_plan"]]
          )
          for( lecture in slot[["lectures"]] ) {
            lecture_ <- strsplit(lecture,":")[[1]] # [id,label,hasTasks,min]
            idFile <- strsplit( lecture_[1], "[|]" )[[1]] # [id|rmdFile]
            if( length( idFile ) <= 1 ) {
              session_$add(Lecture$new(id=lecture_[1], label=lecture_[2],hasTasks=as.logical(lecture_[3]),min=as.numeric(lecture_[4])))
            } else {
              session_$add(Lecture$new(
                id=idFile[[1]], label=lecture_[2],hasTasks=as.logical(lecture_[3]),min=as.numeric(lecture_[4]),
                rmdFile=idFile[[2]]
              ))
            }
          }
          course$add(session_)
        }
        # Materials
        materials <- lapply(self$config("materials"), function(m) {
          m_ <- strsplit(m,":")[[1]] # id:label:path:out_path
          material_  <- Material$new(id=m_[1],label=m_[2],path=m_[3],outPath=m_[4])
          course$add(material_)
        })

        self$course_ <- course
      },
      #' @description Path to site's directory containing all Rmd files.
      src = function() {
        prj_path <- try(rprojroot::find_rstudio_root_file(), silent=TRUE)
        if (class(prj_path)!="try-error") {
          file.path(prj_path,private$sources_)
        } else {
          if (grepl("^(/|[A-Za-z]:|\\\\|~)", private$sources_)) # absolute path (ref. HW)
            private$sources_
          else
            file.path(getwd(),private$sources_)
        }
      },
      #' @description clear generated nocode html file
      clear_nocode_html = function() {
        html_files <- dir(self$src(),pattern = ".nocode.html$", full.names = TRUE)
        unlink(html_files)
      },
      #' @param clean If true the clean the site first.
      #' @param ... arguments to rmarkdown::render_site
      #' @description Render the site only for modified Rmd's.
      render_off = function(clean=FALSE,...){
        e <- new.env() # currently to hold .next and .prev values for slots
        if (clean)
          self$clean()
        # when a task file is updated render its slot so both code and no_code versions are compiled!
        render_list <- self$lstmod()
        tasks_list <- grepl(".tasks", render_list)
        if (sum(tasks_list)!=0)
          render_list <- c(render_list[!tasks_list], sub(".tasks$","", render_list[tasks_list]))
        # render only modified files
        lapply(render_list,function(b) {
          assign(x = ".next", value = self$next_slot(base_name = b), envir = e)
          assign(x = ".prev", value = self$prev_slot(base_name = b), envir = e)
          rmarkdown::render_site(file.path(self$src(),paste0(b,".Rmd")),envir=e,...)
        })
        self$clear_nocode_html()
      },
      #' @description Render the site ( todo: only for modified Rmd's).
      #' @param publish ...
      render = function(out_dir = ".docs"){

        # always render
        renderer <- Renderer$new( outDir = out_dir)
        renderer$makeAll( course = self$course_ )
        file.copy(from = file.path(out_dir, self$config("index_file")), to = file.path(out_dir, "index.html")  )


      },
      site = function() {
        private$site_
      },
      #' @description Return the path to site's index.html
      url = function() {
        private$url_
      },
      #' @description View the site in the browser.
      #' @param publish If TRUE then show the published build (docs) otherwise the development version (.docs).
      view = function(publish=FALSE) {
        pub <- self$url()
        dev <- sub("docs", ".docs", self$url())

        url_<- ifelse(publish, pub, dev)

        if (!publish & !file.exists(dev)) {
          warning('Missing .docs reverting to docs! Try render(publish=FALSE)')
          url_ <- pub
        }

        browseURL(url_)
      },
      #' @description Course schedule from schedule.yml.
      schedule = function() {
       private$read_schedule()
       private$schedule_
      },
      #' #' @description Edit '_schedule.yml'. Render the pages by render() to enforce the changes.
      #' schedule = function() {
      #'   file.edit(file.path(self$src(),"_schedule.yml"))
      #' },
      #' @description Returns the list of course slots. The data is taken from '_schedule.yml'.
      slots = function() {
        schedule <- self$schedule()
        slots <- schedule[["course"]][["slots"]]
        slots_names <- names(slots)
        task_names <- lapply(slots_names, function(x) if (slots[[x]][["tasks"]]=="yes") paste(x,".tasks",sep="") )
        task_names <- task_names[!sapply(task_names,is.null)]
        c(slots_names, task_names)
      },
      #' @description given the base name of the slot return the basename of the next
      #' slot from '_schedule.yml'.
      #' @param base_name the RMD file basename.
      next_slot = function(base_name) {
        schedule <- self$schedule()
        schedule[["course"]][["slots"]][[base_name]][["next"]]
      },
      #' @description given the base name of the slot return the basename of the previous
      #' slot from '_schedule.yml'.
      #' @param base_name the RMD file basename.
      prev_slot = function(base_name) {
        schedule <- self$schedule()
        schedule[["course"]][["slots"]][[base_name]][["prev"]]
      },
      #' @description given the base name of the slot return the related slots from '_schedule.yml'.
      #' @param base_name the RMD file basename.
      related = function(base_name) {
        schedule <- self$schedule()
        unlist(strsplit(schedule[["course"]][["slots"]][[base_name]][["related"]]," " ))
      },
      #' @description Returns the list of modified files.
      lstmod = function() {
        rmds <- dir(self$src(), pattern = ".Rmd")
        rmds <- rmds[!grepl('^_',rmds)]
        file_basenames <- sapply(rmds, function(x) sub(".Rmd","",x)) %>% as.vector()
        # consider only the slots declared in the schedule.yml
        file_basenames <- intersect(file_basenames,self$slots())
        # additional RMD files other than slots
        file_basenames <- c(file_basenames, c("index","data","schedule","_schedule","_graph"))
        file_basenames[sapply(file_basenames, private$modified)]
      },
      #' @description Returns the list of files for zip archive.
      #' @param set {archive, data}
      listing = function(set="archive"){
        schedule <- self$schedule()
        if (set=="archive") {
          course <- schedule[["course"]]
          rmds <- dir(self$src(),pattern=".Rmd")
          other <- c("images","data","_schedule.yml","styles.css","_site.yml","footer.html")
          c(rmds,other)
        } else if (set=="data") {
          paste("data", strsplit(schedule[["course"]][["dataset"]]," ")[[1]], sep="/")
        } else {
          stop("use {archive,data} as possible sets.")
        }

      },
      #' @description Create a zip archive.
      #' @param filename name of zip archive.
      #' @param what {archive, data}
      #'
      zip = function(filename="archive.zip", what="arvhive"){
        if (!grepl(".zip$",filename))
          stop("invalud suffix, use extension .zip !")
        cat('exporting to ',filename, '...\n')
        Sys.sleep(2)
        msg <- try ( private$zip_(zip_file = filename, what= what), silent = TRUE )
        if (class(msg)=="try-error") {
          message(msg)
        } else {
          file.copy(from = filename, to = file.path(private$sources_,"_site"), overwrite = TRUE)
          file.remove(filename)
        }
      },
      #' @description clear generted files, i.e. site/
      push = function(slot, server="shark", server_dir="/bam-export/crip") {
        # course
        # slot
        # remote_url : shark:/bam-export
        #
        all_slots <- self$slots() %>%  unlist
        if (slot %in% all_slots) {
          ps <-  private$sources_
          dest <- paste(server,server_dir, sep=":")
          src1 <- file.path(ps,"_site",paste(slot,".html",sep=""))
          src2 <- file.path(ps,"_site",paste(slot,".tasks.html",sep=""))
          src <- c(src1,src2)[sapply(c(src1,src2),file.exists)]
          src <- paste(src,collapse = " ")
          cmd <- paste("scp -p",src,dest)
          cat('command: ',cmd, '\n')
          system(cmd)
        } else{
          warning("invalid slot name !")
        }
      },
      #' @description publish _site to remote site with rsync
      publish = function(remote=NULL, remote_dir="/bam-export",server="shark",group="5-A-SHARK_BioCentEXP") {
        if (is.null(remote))
          stop("missing remote !")
        dst_ <- paste(server,file.path(remote_dir,remote), sep=":")
        src_ <- file.path(private$sources_, "_site", "") # "" adds a final / to the path, needed for rsync !
        cmd <- paste("rsync -avp ",paste("--chown=:",group,sep=""), src_, dst_)
        cat('command: ',cmd, '\n')
        system(cmd)
      },
      #' @description clear generted files, i.e. site/
      clean = function() {
        rmarkdown::clean_site(self$src())
      }
    )
)