R/generate.R

In jasenfinch/metaboWorkflows: Workflow Project Templates for Metabolomics Analyses

#' Generate a workflow project directory
#' @rdname generateWorkflow
#' @description Generate a workflow project directory from a workflow definition.
#' @param workflow S4 object of class `Workflow`
#' @param start TRUE/FALSE. Automatically activate the project in a new RStudio session after creation
#' @examples 
#' \dontrun{
#' file_paths <- metaboData::filePaths('FIE-HRMS','BdistachyonEcotypes')
#' sample_information <- metaboData::runinfo('FIE-HRMS','BdistachyonEcotypes')
#'
#' workflow_input <- inputFilePath(file_paths,sample_information)
#' 
#' workflow_definition <- defineWorkflow(workflow_input,
#'                                       'FIE-HRMS fingerprinting',
#'                                       'Example project')
#'                                       
#' generateWorkflow(workflow_definition)
#' }
#' @export

setGeneric('generateWorkflow',function(workflow,start = TRUE)
  standardGeneric('generateWorkflow'))

#' @rdname generateWorkflow
#' @importFrom projecttemplates projectDirectory projectSkeleton targetsScript targetsConfig
#' @importFrom projecttemplates targetsRun utils renvInitialise docker createGit githubActions createGithub Rprofile
#' @importFrom cli symbol
#' @importFrom crayon green
#' @importFrom rstudioapi isAvailable openProject

setMethod('generateWorkflow',signature = 'Workflow',
          function(workflow,start = TRUE){
            project_directory <- projectDirectory(projectName(workflow),
                                                  path(workflow))
            
            projectSkeleton(project_directory,
                            force = force(workflow))
            readme(projectName(workflow),
                   type(workflow),
                   path(workflow),
                   renv = renv(workflow))
            Rprofile(project_directory,renv = renv(workflow))
            
            message('Adding targets infrastructure')
            targetsScript(project_directory,type = 'report')
            targetsConfig(project_directory)
            editTargetsScript(project_directory)
            
            targetsRun(project_directory,
                       renv = renv(workflow))
            
            writeTargets(targets(workflow),
                         project_directory)
            
            utils(glue('{project_directory}/R')
            )
            editHeader(paste0(project_directory,'/R/utils.R'))
            
            parallelOptions(workflow)
            targetsOptions(project_directory,
                           error = 'continue',
                           memory = 'transient',
                           garbage_collection = TRUE)
            
            inputPrep(workflow)
            
            if ('report' %in% modules(workflow)) {
              message('Adding R Markdown report')
              output(workflow) 
            }
            
            if (isTRUE(renv(workflow))){
              renvInitialise(project_directory,
                             bioconductor = TRUE,
                             dependencies = workflowDependencies(workflow))
            }
            
            if (isTRUE(docker(workflow))) {
              projecttemplates::docker(projectName(workflow),
                                       path = path(workflow),
                                       renv = renv(workflow)) 
              dockerImage(project_directory)
              editHeader(paste0(project_directory,'/misc/docker/Dockerfile'))
            }
            
            write(reportFooter(workflow),
                  file = paste0(project_directory,'/README.md'),
                  append = TRUE)
            
            if (all(github(workflow), githubActions(workflow))) {
              projecttemplates::githubActions(projectName(workflow), 
                                              path(workflow))
            }
            
            createGit(project_directory,type = 'report')
            
            if (isTRUE(github)) {
              createGithub(projectName(workflow), 
                           path(workflow), 
                           private(workflow))
            }
            message()
            
            message(green(symbol$tick),
                    ' ',
                    glue("Project directory creation complete. See {project_directory}/README.md for details on how to get started."))     
            
            if (isTRUE(start) & isAvailable()) {
              message('Opening project in a new RStudio session')
              openProject(project_directory,newSession = TRUE)
            }
          })

#' @importFrom utils packageVersion

scriptHeader <- function(prefix){
  version <- packageVersion('metaboWorkflows') %>% 
    as.character()
  
  glue('## {prefix} by metaboWorkflows (https://jasenfinch.github.io/metaboWorkflows/) v{version}')
}

editHeader <- function(file){
  file_lines <- readLines(file)
  line_index <- which(str_detect(file_lines,'## Generated by projecttemplates'))
  
  edited_file_lines <- c(file_lines[line_index],
                         scriptHeader('Edited'),
                         file_lines[(line_index + 1):length(file_lines)])
  
  writeLines(edited_file_lines,file)
}

editTargetsScript <- function(project_directory){
  file <- paste0(project_directory,'/_targets.R')
  
  write('"R/targets/" %>%
    list.files(full.names = TRUE) %>%
    purrr::walk(source)\n',
        file = file,
        append = TRUE)
  
  editHeader(file)
}

targetsOptions <- function(project_directory,...){
  target_options <- enexprs(...) %>% 
    map(expr_text)
  
  target_options <- target_options %>% 
    names() %>% 
    map_chr(~glue('{.x} = {target_options[[.x]]}')) %>% 
    glue_collapse(',\n')
  
  file <- glue('{project_directory}/R/utils.R')
  
  file_lines <- readLines(file)
  line_index <- which(str_detect(file_lines,'tar_option_set'))
  
  file_lines[line_index] <- glue('tar_option_set({target_options})')
  
  writeLines(file_lines,file)
  
  out <- capture.output(style_file(file))
}

parallelOptions <- function(workflow_definition){
  
  project_directory <- projectDirectory(
    projectName(workflow_definition),
    path(workflow_definition)
  )
  
  write(c('## Set future parallel backend',
          paste0(expr_text(parallelPlan(workflow_definition)),'\n')
          ),
  file = paste0(project_directory,'/R/utils.R'),
  append = TRUE)
}

modulesList <- function(workflow_targets){
  workflow_modules <- workflow_targets %>% 
    names() %>% 
    paste0('_targets') %>% 
    paste0(collapse = ',\n')
  
  glue('list({workflow_modules})')
}

moduleTargetsList <- function(module_targets){
  module_targets <- module_targets %>%
    map(~{
      target_code <- code(.x)
      
      if (length(target_code) > 1){
        target_code <- glue_collapse(target_code,sep = '
                                         ')
      }
      
      if (length(comment(.x)) > 0) {
        glue('
{name(.x)} = 
       {target_code}')
      } else {
        glue('
{name(.x)} = {target_code}')
      }
    }) %>%
    glue_collapse(sep = ',
')
  
  targets_list <- module_targets %>% 
    paste0(collapse = ',\n')
  
  
  glue('list(
       {targets_list}
       )')
}

#' @importFrom utils capture.output
#' @importFrom styler style_file
#' @importFrom magrittr set_names
#' @importFrom purrr walk

writeTargets <- function(workflow_targets,project_directory){
  
  dir.create(paste0(project_directory,'/R/targets'))
  
  modules_list <- modulesList(workflow_targets)
  
  file_path <- paste0(project_directory,
                      '/_targets.R')
  
  write(modules_list,
        file_path,
        append = TRUE)
  
  out <- capture.output(style_file(file_path))
  
  module_targets_lists <- workflow_targets %>% 
    map(moduleTargetsList)
  
  targets_lists <- module_targets_lists %>% 
    names() %>% 
    map(~{
      glue('{.x}_targets = {module_targets_lists[[.x]]}')
    }) %>% 
    set_names(names(module_targets_lists))
  
  targets_lists %>% 
    names() %>% 
    walk(~{
      file_path <- glue('{project_directory}/R/targets/{.x}_targets.R') 
      write(scriptHeader('Generated'),
            file_path)
      
      write(targets_lists[[.x]],
            file_path,
            append = TRUE)
      
      out <- capture.output(style_file(file_path))
    })
  
}

setGeneric('inputPrep',function(x)
  standardGeneric('inputPrep'))

#' @importFrom utils write.csv
#' @importFrom yaml write_yaml

setMethod('inputPrep',signature = 'Workflow',
          function(x){
            input_type <- x %>% 
              input() %>% class()
            
            project_directory <- projectDirectory(
              projectName(x),
              path(x)
            )
            
            if (input_type == 'FilePathInput') {
              x %>% 
                filePaths() %>% 
                writeLines(glue('{project_directory}/data/file_paths.txt'))
              x %>% 
                sampleInformation() %>% 
                write.csv(glue('{project_directory}/data/runinfo.csv'),
                          row.names = FALSE)
              
            }
            
            if (input_type == 'GroverInput') {
              
              grover_client <- list(host = host(x),
                                    port = port(x),
                                    auth = auth(x))
              write_yaml(grover_client,
                         glue('{project_directory}/misc/grover_client.yml'))
            }
          })

setGeneric('output',function(x)
  standardGeneric('output'))

setMethod('output',signature = 'Workflow',
          function(x){
            project_directory <- projectDirectory(
              projectName(x),
              path(x)
            )
            
            report_directory <- paste0(project_directory,'/report') 
            if (!dir.exists(report_directory)){
              dir.create(report_directory)
            }
            
            rmd(x) %>% 
              writeLines(paste0(report_directory,'/',basename(project_directory),'_report.Rmd'))
          })