rqudocuhelper:

###
###
###
###   Purpose:   Create skeleton documentation
###   started:   2016/02/16 (pvr)
###
### ############################################################ ###

#' Create a documentation package
#'
#' @description
#' \code{create_docu_package} creates a documentation package using
#' \code{devtools::create}. Description information can be provided
#' by the additional arguments to the function. Changes to the
#' DESCRIPTION file are moved to a separate function called
#' \code{add_dcf_info}. If any of the arguments specific to the
#' DESCRIPTION file are not null, then the function
#' \code{add_dcf_info} is called.
#'
#' @param psPkgName           name of the package
#' @param psPkgPath           path below which package is created
#' @param psDescTitle         title of the package
#' @param psDescAuthor        author information
#' @param psDescDescription   Description field in dcf
#' @param psDescLicense       license information
#' @export create_docu_package
create_docu_package <- function(psPkgName,
                                psPkgPath = ".",
                                psDescTitle = NULL,
                                psDescAuthor = NULL,
                                psDescMaintainer = NULL,
                                psDescDescription = NULL,
                                psDescLicense = NULL) {
  ### # start by creating a package
  devtools::create(path = psPkgName)
  pkg <- devtools::as.package(psPkgName)
  ### # if any of the desc components is not null, change
  ### #  description
  if (!is.null(c(psDescTitle,psDescAuthor,psDescMaintainer,psDescDescription,psDescLicense))){
    add_dcf_info(psPkgPath         = pkg$path,
                 psDescTitle       = psDescTitle,
                 psDescAuthor      = psDescAuthor,
                 psDescMaintainer  = psDescMaintainer,
                 psDescDescription = psDescDescription,
                 psDescLicense     = psDescLicense)
  }
}

### ############################################################ ###

#' @title Create a new Qualitas project document
#'
#' @description
#' This function is a wrapper for \code{create_docu_skeleton}
#' using the fixed template "project_docu" from package
#' \code{rqudocuhelper}.
#'
#' @param   psDocuName           name of the new document
#' @param   psPkgPath            path where package is located under which document should be created
#' @param   psDocuSubdir         subdirectory in which document should be saved to
#' @param   pbDocuHasOwnSubdir   should document be stored in separate subdir
#' @param   pbOverwrite          flag whether existing files are overwritten
#' @param   pbEdit               directly open newly created document
#' @export create_qudocu_skeleton
create_qudocu_skeleton <- function(psDocuName,
                                   psPkgPath     = ".",
                                   psDocuSubdir  = "vignettes",
                                   pbDocuHasOwnSubdir = TRUE,
                                   pbOverwrite   = FALSE,
                                   pbEdit        = TRUE) {
  create_docu_skeleton(psDocuName         = psDocuName,
                       psPkgPath          = psPkgPath,
                       psRmdTemplate      = "project_docu",
                       psTemplatePkg      = "rqudocuhelper",
                       psDocuSubdir       = psDocuSubdir,
                       pbDocuHasOwnSubdir = pbDocuHasOwnSubdir,
                       pbOverwrite        = pbOverwrite,
                       pbEdit             = pbEdit)
}


#' Create a new Rmarkdown (Rmd) document
#'
#' @description
#' \code{create_docu_skeleton} assumes that psPkgPath is a
#' directory that contains an R-package. By default the new
#' document is created in subdirectory "vignettes". If this
#' subdirectory does not exist, it is created. The document
#' is generated by the function \code{rmarkdown::draft} using
#' the template "project_docu".
#'
#' @details
#' The basic functionality follows the function
#' \code{devtools::use_vignette}, except for the possibility
#' of specifying any given template from any package.
#'
#' @param   psDocuName           name of the new document
#' @param   psPkgPath            path where package is located under which document should be created
#' @param   psRmdTemplate        name of the template to be used
#' @param   psTemplatePkg        package from where the template should be taken
#' @param   psDocuSubdir         subdirectory in which document should be saved to
#' @param   pbDocuHasOwnSubdir   should document be stored in separate subdir
#' @param   pbOverwrite          flag whether existing files are overwritten
#' @param   pbEdit               directly open newly created document
#' @export create_docu_skeleton
create_docu_skeleton <- function(psDocuName,
                                 psPkgPath     = ".",
                                 psRmdTemplate = "project_docu",
                                 psTemplatePkg = "rqudocuhelper",
                                 psDocuSubdir  = "vignettes",
                                 pbDocuHasOwnSubdir = TRUE,
                                 pbOverwrite   = FALSE,
                                 pbEdit        = FALSE) {
  ### # do the preparation similar to devtools::use_vignette
  pkg <- devtools::as.package(psPkgPath)
  devtools:::check_suggested("rmarkdown")
  devtools:::add_desc_package(pkg, "Suggests", "knitr")
  devtools:::add_desc_package(pkg, "Suggests", "rmarkdown")
  devtools:::add_desc_package(pkg, "VignetteBuilder", "knitr")
  ### # for the document directory, differentiate whether the document
  ### #  should be moved to a separate subdirectory
  sDocuDir <- file.path(pkg$path, psDocuSubdir)
  if (pbDocuHasOwnSubdir)
    sDocuDir <- file.path(sDocuDir, psDocuName)
  if (!dir.exists(sDocuDir))
    dir.create(sDocuDir, showWarnings = FALSE, recursive = TRUE)
  sDocuPath <- file.path(sDocuDir, paste0(psDocuName, ".Rmd"))
  rmd_draft(file = sDocuPath,
            template = psRmdTemplate,
            package = psTemplatePkg,
            create_dir = FALSE,
            pbOverwrite = pbOverwrite)

  if (pbEdit) file.edit(sDocuPath)
  message("Draft vignette created in ", sDocuPath)

}


#' Adding a string to .gitignore
add_git_ignore <- function (psPath = ".", psIgnores)
{
  sPath <- file.path(psPath, ".gitignore")
  union_write(sPath, psIgnores)
  invisible(TRUE)
}

#' write a string to an existing file
union_write <- function (path, new_lines)
{
  if (file.exists(path)) {
    lines <- readLines(path, warn = FALSE)
  }
  else {
    lines <- character()
  }
  all <- union(lines, new_lines)
  writeLines(all, path)
}

### ############################################################ ###

#' Custom local copy of rmarkdown::draft
#'
#' @description
#' \code{rmd_draft} corresponds to a local copy of
#' \code{rmarkdown::draft}. In contrast to the original
#' version, this version allows for the use of templates
#' with skeleton files which are already found in the
#' target directory.
#'
#'
#' @param file          name of the new document
#' @param template      name of the template
#' @param package       package where template can be found
#' @param create_dir    whether or not to create a new directory for this document
#' @param pbOverwrite   should existing files be overwritten
rmd_draft <- function(file, template,
                      package = NULL,
                      create_dir = "default",
                      pbOverwrite = FALSE){
  ### # determine the template path which is contained
  ### #  in package "package"
  if (!is.null(package)) {
    template_path = system.file("rmarkdown", "templates",
                                template, package = package)
    if (!nzchar(template_path)) {
      stop("The template '", template, "' was not found in the ",
           package, " package")
    }
  } else {
    template_path <- template
  }
  ### # read info in template.yaml
  template_yaml <- file.path(template_path, "template.yaml")
  if (!file.exists(template_yaml)) {
    stop("No template.yaml file found for template '", template,
         "'")
  }
  template_meta <- rmarkdown:::yaml_load_file_utf8(template_yaml)
  if (is.null(template_meta$name) || is.null(template_meta$description)) {
    stop("template.yaml must contain name and description fields")
  }
  if (identical(create_dir, "default"))
    create_dir <- isTRUE(template_meta$create_dir)
  if (create_dir) {
    file <- tools::file_path_sans_ext(file)
    if (dir_exists(file))
      stop("The directory '", file, "' already exists.")
    dir.create(file)
    file <- file.path(file, basename(file))
  }
  ### # error, in case file itself already exists
  if (!identical(tolower(tools::file_ext(file)), "rmd"))
    file <- paste(file, ".Rmd", sep = "")
  if (file.exists(file))
    stop("The file '", file, "' already exists.")
  ### # generate a list of skeleton files
  skeleton_files <- list.files(file.path(template_path, "skeleton"),
                               full.names = TRUE)
  to <- dirname(file)
  for (f in skeleton_files) {
    if (pbOverwrite)
      file.copy(from = f, to = to, overwrite = pbOverwrite, recursive = TRUE)
    if (!file.exists(file.path(to, basename(f))))
      # stop("The file '", basename(f), "' already exists")
      file.copy(from = f, to = to, overwrite = FALSE, recursive = TRUE)
  }
  file.rename(file.path(dirname(file), "skeleton.Rmd"), file)

  invisible(file)

}

### ############################################################ ###

#' Adding DESCRIPTION information to an existing package
#'
#' @description
#' This function \code{add_dcf_info} uses the reference class
#' \code{DcfRefClass} to represent the information stored in
#' a DESCRIPTION file. Any arguments specified to \code{add_dcf_info}
#' that are not null, are written to the DESCRIPTION file
#' and therebye overwritting the existing information in the
#' DESCRIPTION file.
#'
#' @param psPkgPath           package path
#' @param psDescTitle         title of the package
#' @param psDescAuthor        author information
#' @param psDescDescription   Description field in dcf
#' @param psDescLicense       license information
#' @export add_dcf_info
add_dcf_info <- function(psPkgPath,
                         psDescTitle = NULL,
                         psDescAuthor = NULL,
                         psDescMaintainer = NULL,
                         psDescDescription = NULL,
                         psDescLicense = NULL) {

  ### # define pkg DESCRIPTION file
  sDcfFile <- file.path(psPkgPath, "DESCRIPTION")
  ### # read existing DESCRIPTION
  refObjDesc <- DcfRefClass$new()
  refObjDesc$readDcf(psDcfFile = sDcfFile)
  ### # change values
  if (!is.null(psDescTitle))
    refObjDesc$setTitle(psTitle = psDescTitle)
  if (!is.null(psDescAuthor))
    refObjDesc$setAuthor(psAuthor = psDescAuthor)
  if (!is.null(psDescMaintainer))
    #refObjDesc$setMaintainer(psMaintainer = psDescMaintainer)
    if (!is.null(psDescDescription))
      refObjDesc$setDescription(psDescription = psDescDescription)
  if (!is.null(psDescLicense))
    refObjDesc$setLicense(psLicense = psDescLicense)
  ### # write back changes
  refObjDesc$writeDcf(psDcfFile = sDcfFile)
}