R/sysargslist_methods.R

In tgirke/systemPipeR: systemPipeR: workflow management and report generation environment

########################################
## Method Definitions for SYSargsList ##
########################################
## Methods to return SYSargsList components
setMethod(f = "stepsWF", signature = "SYSargsList", definition = function(x) {
    return(x@stepsWF)
})
setMethod(f = "statusWF", signature = "SYSargsList", definition = function(x) {
    return(lapply(
        lapply(x@statusWF, "[[", 2),
        function(y) S4Vectors::DataFrame(y, check.names = FALSE)
    ))
})
setMethod(f = "targetsWF", signature = "SYSargsList", definition = function(x) {
    return(x@targetsWF)
})
setMethod(f = "outfiles", signature = "SYSargsList", definition = function(x) {
    return(x@outfiles)
})
setMethod(f = "SE", signature = "SYSargsList", definition = function(x, step = NULL) {
    if (is.null(step)) {
        return(x@SE)
    } else {
        return(x@SE[[step]])
    }
})

setMethod(f = "dependency", signature = "SYSargsList", definition = function(x) {
    return(x@dependency)
})
setMethod(f = "projectInfo", signature = "SYSargsList", definition = function(x) {
    return(x@projectInfo)
})
setMethod(f = "runInfo", signature = "SYSargsList", definition = function(x) {
    return(x@runInfo)
})

#####################################
## Coerce Methods for SYSargsList ##
#####################################

## Coerce back to list: as(SYSargsList, "list")
setMethod(f = "sysargslist", signature = "SYSargsList", definition = function(x) {
    sysargslist <- list(
        stepsWF = x@stepsWF,
        statusWF = x@statusWF,
        targetsWF = x@targetsWF,
        outfiles = x@outfiles,
        SE = x@SE,
        dependency = x@dependency,
        targets_connection = x@targets_connection,
        projectInfo = x@projectInfo,
        runInfo = x@runInfo
    )
    return(sysargslist)
})

## Constructor methods
## List to SYSargsList
setAs(
    from = "list", to = "SYSargsList",
    def = function(from) {
        new("SYSargsList",
            stepsWF = from$stepsWF,
            statusWF = from$statusWF,
            targetsWF = from$targetsWF,
            outfiles = from$outfiles,
            SE = from$SE,
            dependency = from$dependency,
            targets_connection = from$targets_connection,
            projectInfo = from$projectInfo,
            runInfo = from$runInfo
        )
    }
)

## SYSargsList to list with: as("SYSargsList", list)
setAs(
    from = "SYSargsList", to = "list",
    def = function(from) {
        sysargslist(from)
    }
)

#####################################
## Generic Methods for SYSargsList ##
#####################################

## Define print behavior for SYSargsList
setMethod(
    f = "show", signature = "SYSargsList",
    definition = function(object) {
        if (length(object) > 0) {
            status_1 <- .showHelper(object)
            status <- append("   WF Steps:\n", status_1)
        } else {
            status <- "No workflow steps added"
        }
        cat(
            crayon::blue$bold(paste0("Instance of '", class(object), "':")), "\n",
            status, "\n"
        )
    }
)

## Internal function
.showHelper <- function(object) {
    status_1 <- as.character()
    for (i in seq_along(object@stepsWF)) {
        status_color <- switch(tolower(object@statusWF[[i]]$status.summary),
            "pending" = crayon::blue$bold,
            "warning" = crayon::make_style("orange")$bold,
            "error" = crayon::red$bold,
            "success" = crayon::green$bold
        )
        if (inherits(object@stepsWF[[i]], "SYSargs2")) {
            status_1 <- c(
                status_1,
                c(
                    paste0("      ", i, ". ", crayon::blue(names(object@stepsWF)[i], "--> Status: "), status_color(object@statusWF[[i]]$status.summary), sep = ""), "\n",
                    paste0(c("          Total Files: ", "Existing: ", "Missing: "), colSums(object@statusWF[[i]][[2]][2:4]), collapse = " | "), "\n",
                    paste0(
                        # "         Sub Steps:", "\n",
                        paste0("        ", i, ".", seq_along(object@stepsWF[[i]]@clt), ". ", crayon::green(object@stepsWF[[i]]$files$steps)), "\n",
                        paste0("             cmdlist: ", length(object@stepsWF[[i]]), " | "),
                        sapply(as.list(object@stepsWF[[i]]$files$steps), function(x) {
                            paste0(
                                paste0(names(table(unlist(object@statusWF[[i]][[2]][object@stepsWF[[i]]$files$steps][x]))), ": ",
                                    table(unlist(object@statusWF[[i]][[2]][object@stepsWF[[i]]$files$steps][x])),
                                    collapse = " | "
                                )
                            )
                        }),
                        "\n"
                    )
                )
            )
        } else if (inherits(object@stepsWF[[i]], "LineWise")) {
            status_1 <- c(
                status_1,
                paste0("      ", i, ". ", crayon::blue(names(object@stepsWF)[i], "--> Status: "), status_color(object@statusWF[[i]]$status.summary), "\n")
            )
        }
    }
    return(status_1)
}

## Extend names() method
setMethod(
    f = "names", signature = "SYSargsList",
    definition = function(x) {
        return(slotNames(x))
    }
)

## Extend length() method
setMethod(
    f = "length", signature = "SYSargsList",
    definition = function(x) {
        return(length(x@stepsWF))
    }
)

# Behavior of "[" operator for SYSargsList
setMethod(f = "[", signature = "SYSargsList", definition = function(x, i, ..., drop) {
    if (missing(i)) {
        i <- 1:length(x)
    }
    if (inherits(i, "character")) {
        if (!all(i %in% stepName(x))) {
            stop(
                "\n",
                "Step name doesn't exist. Please subset accordingly with the 'stepName(x)'",
                "\n",
                paste0(stepName(x), collapse = ", ")
            )
        }
        i <- which(stepName(x) %in% i)
    }
    if (is.logical(i)) {
        i <- which(i)
    }
    for (s in seq_along(i)) {
        tryCatch(
            {
                if (i[s] < 0) {
                    ii <- i[s] * -1
                } else {
                    ii <- i[s]
                }
                x@stepsWF[[ii]]
            },
            error = function(e) {
                e$message <- paste0(
                    "\n",
                    "Step number is out of range. Please subset accordingly with the 'length(x)'",
                    "\n",
                    paste0(1:length(x), collapse = ", ")
                )
                stop(e)
            }
        )
    }
    x@stepsWF <- x@stepsWF[i]
    names_tc <- names(x@stepsWF)
    x@statusWF <- x@statusWF[i]
    x@targetsWF <- x@targetsWF[i]
    x@outfiles <- x@outfiles[i]
    x@SE <- x@SE[i]
    x@dependency <- x@dependency[i]
    x@targets_connection <- x@targets_connection[names(x@targets_connection) %in% names_tc]
    x@projectInfo <- x@projectInfo
    x@runInfo$env <- x@runInfo$env
    x@runInfo$runOption <- x@runInfo$runOption[i]
    # x <- .check_write_SYSargsList(x)
    return(x)
})

## Behavior of "[[" operator for SYSargsList
setMethod(f = "[[", signature = c("SYSargsList", "ANY", "missing"), definition = function(x, i, ..., drop) {
    return(as(x, "list")[[i]])
})

## Behavior of "$" operator for SYSargsList
setMethod("$",
    signature = "SYSargsList",
    definition = function(x, name) {
        slot(x, name)
    }
)

setMethod("SampleName", signature = "SYSargsList", definition = function(x, step) {
    ## Check steps
    if (inherits(step, "numeric")) {
        if (!step %in% 1:length(x)) stop("We can not find this step in the Workflow")
    } else if (inherits(step, "character")) {
        if (!step %in% stepName(x)) stop("We can not find this step in the Workflow")
    }
    id <- stepsWF(x)[[step]][["files"]][["id"]]
    if (is.null(id)) {
        # message("This is a LineWise step.")
        return(NULL)
    } else {
        names <- targetsWF(x)[[step]]
        if (length(names) > 1) {
            return(names[[id]])
        } else {
            message("This step doesn't contain multiple samples.")
        }
    }
})

setMethod("baseCommand", signature = "SYSargsList", definition = function(x, step) {
    if (missing(step)) {
        step <- 1:length(x)
    }
    step <- .StepClass(x, class = "SYSargs2", step)
    x <- x[step]
    cmd <- sapply(names(x$stepsWF), function(x) list(NULL))
    for (i in seq_along(x)) {
        cmd[[i]] <- baseCommand(x[step]$stepsWF[[i]])
    }
    return(cmd)
})

setMethod("stepName", signature = "SYSargsList", definition = function(x) {
    return(names(stepsWF(x)))
})

setMethod("targetsheader", signature = "SYSargsList", definition = function(x, step) {
    return(stepsWF(x)[[step]]$targetsheader)
})

## cmdlist method for SYSargslist
setMethod(f = "cmdlist", signature = "SYSargsList", definition = function(x, step, targets = NULL) {
    if (missing(step)) {
        step <- 1:length(x)
    }
    step <- .StepClass(x, class = "SYSargs2", step)
    if (length(step) == 0) stop("Provide a step with a 'SYSargs2' class instance.")
    x <- x[step]
    cmd <- sapply(names(x$stepsWF), function(x) list(NULL))
    for (i in seq_along(x)) {
        if (nchar(cmdlist(x$stepsWF[[i]])[[1]][[1]]) > 0) {
            cmd_list <- cmdlist(x$stepsWF[[i]])
            if (!is.null(targets)) {
                cmd_list <- cmd_list[targets]
            }
            cmd[[i]] <- cmd_list
        }
    }
    return(cmd)
})

setMethod(f = "yamlinput", signature = "SYSargsList", definition = function(x, step) {
    if (length(step) > 1) stop("Please provide one step at a time.", call. = FALSE)
    if (inherits(step, "character")) {
        if (!step %in% stepName(x)) stop("'step' cannot be found in the workflow", call. = FALSE)
    } else if (inherits(step, "numeric")) {
        if (!step %in% seq_along(x)) stop("'step' cannot be found in the workflow", call. = FALSE)
    }
    if (inherits(stepsWF(x)[[step]], "LineWise")) stop("Provide a step with a 'SYSargs2' class instance", call. = FALSE)
    stepsWF(x)[[step]]$yamlinput
})

## Behavior of "subset" method for SYSargsList
setMethod(f = "subset", signature = "SYSargsList", definition = function(x, subset_steps, input_targets, keep_steps = TRUE) {
    if (!hasArg(subset_steps)) stop("argument 'subset_steps' is missing")
    if (!hasArg(input_targets)) stop("argument 'input_targets' is missing")
    x_sub <- x[subset_steps]
    if (any(sapply(stepsWF(x_sub), function(y) class(y)) %in% "LineWise")) {
        stop("We cannot subset a 'LineWise' step. Please review the 'subset_steps' argument")
    }
    ## check subset_steps length
    if (length(unique(sapply(stepsWF(x_sub), function(x) length(x)))) > 1) stop("All 'subset_steps' should contain the same length.")
    if (missing(input_targets)) {
        input_targets <- 1:max(sapply(stepsWF(x_sub), function(x) length(x)))
    }
    # Check targets index, names
    if (inherits(input_targets, "numeric")) {
        if (!all(input_targets %in% sapply(stepsWF(x_sub), function(x) 1:length(x)))) {
            stop(
                "Please select the number of 'input_targets' accordingly, options are: ",
                paste0(1:length(x_sub@stepsWF[[1]]), collapse = ", ")
            )
        }
    } else if (inherits(input_targets, "character")) {
        if (!all(input_targets %in% sapply(stepsWF(x_sub), function(x) SampleName(x)))) {
            stop(
                "Please select the number of 'input_targets' accordingly, options are: ",
                paste0(SampleName(x_sub@stepsWF[[1]]), collapse = ", ")
            )
        }
        input_targets <- which(SampleName(x_sub$stepsWF[[1]]) %in% input_targets)
    }
    if (keep_steps == FALSE) {
        x <- x_sub
        subset_steps <- 1:length(x_sub)
    }
    for (s in subset_steps) {
        x@stepsWF[[s]] <- x@stepsWF[[s]][input_targets]
        x@statusWF[[s]]$status.completed <- x@statusWF[[s]]$status.completed[input_targets, ]
        x@statusWF[[s]]$status.time <- x@statusWF[[s]]$status.time[input_targets, ]
        x@targetsWF[[s]] <- x@targetsWF[[s]][input_targets, ]
        out <- S4Vectors::DataFrame(x@outfiles[[s]][input_targets, ])
        colnames(out) <- colnames(x@outfiles[[s]])
        x@outfiles[[s]] <- out
        x@SE[[s]] <- x@SE[[1]][, input_targets]
        x@dependency <- x@dependency
        x@targets_connection <- x@targets_connection
        x@projectInfo <- x@projectInfo
        x@runInfo$runOption <- x@runInfo$runOption
    }
    x <- .check_write_SYSargsList(x)
    x
})

setMethod("getColumn", signature = "SYSargsList", definition = function(x, step, position = c("outfiles", "targetsWF"), column = 1, names = SampleName(x, step)) {
    ## assertions
    stopifnot(inherits(x, "SYSargsList"))
    stopifnot(length(step) == 1)
    stopifnot(length(column) == 1)
    position <- match.arg(position, c("outfiles", "targetsWF"))
    ## Check steps
    if (inherits(step, "numeric")) {
        if (!step %in% 1:length(x)) stop("We can not find this step in the Workflow")
    } else if (inherits(step, "character")) {
        if (!step %in% stepName(x)) stop("We can not find this step in the Workflow")
    }
    ## Check column
    if (inherits(column, "numeric")) {
        if (!column %in% 1:ncol(x[[position]][[step]])) stop("We can not find this column in the Workflow")
    } else if (inherits(column, "character")) {
        if (!column %in% colnames(x[[position]][[step]])) stop("We can not find this column in the Workflow")
    }
    ## Check names
    if (inherits(x$stepsWF[[step]], "SYSargs2")) {
        if (!length(names) == length(x[[position]][[step]][[column]])) stop("'names' argument needs to have the same length of desired output")
    }
    ##
    if (!is.null(x[[position]][[step]][[column]])) {
        subset <- x[[position]][[step]][[column]]
        if (is.null(names)) {
            if (is.null(rownames(x[[position]][[step]]))) {
                names <- rep("", length(subset))
            } else {
                names <- rownames(x[[position]][[step]])
            }
        }
        names(subset) <- names
    } else {
        message("This step doesn't contain expected outfiles.")
    }
    return(subset)
})


setReplaceMethod("updateColumn", signature = "SYSargsList", definition = function(x, step, position = c("outfiles", "targetsWF"), value) {
    ## assertions
    stopifnot(inherits(x, "SYSargsList"))
    stopifnot(length(step) == 1)
    stopifnot(inherits(value, c("DFrame", "data.frame")))
    position <- match.arg(position, c("outfiles", "targetsWF"))
    ## Check steps
    if (inherits(step, "numeric")) {
        if (!step %in% 1:length(x)) stop("We can not find this step in the Workflow")
    } else if (inherits(step, "character")) {
        if (!step %in% stepName(x)) stop("We can not find this step in the Workflow")
    }
    ## get some info
    df_names <- names(value)
    df_rows <- nrow(value)
    sal_name <- as.character(match.call()$x)
    ## if empty original value
    if (nrow(x[[position]][[step]]) == 0) {
        x[[position]][[step]] <- as(value, "DataFrame")
        rownames(x[[position]][[step]]) <- rownames(value)
        return(x)
    }
    ## if not empty
    if (nrow(x[[position]][[step]]) != df_rows) stop("updateColumn: Original dataframe has different rows than the new dataframe.")
    x[[position]][[step]][, df_names] <- value
    x
})

## Print accessor for codeLine slot
setMethod(f = "codeLine", signature = "SYSargsList", definition = function(x, step) {
    if (missing(step)) {
        step <- 1:length(x)
    }
    step <- .StepClass(x, class = "LineWise", step)
    if (length(step) == 0) stop("No selected step is a 'LineWise' object.")
    x <- x[step]
    rcode <- sapply(names(x$stepsWF), function(x) list(NULL))
    for (i in seq_along(x)) {
        if (!inherits(stepsWF(x)[[i]], "LineWise")) stop("This step is 'SYSargs2'. Please provide an 'LineWise' class step")
        code_list <- x$stepsWF[[i]]$codeLine
        rcode[[i]] <- code_list
    }
    for (i in seq_along(rcode)) {
        cat(crayon::blue(names(rcode[i])), paste0("    ", as.character(rcode[[i]])), sep = "\n")
    }
})

## Internal function
.StepClass <- function(x, class = c("SYSargs2", "LineWise"), step) {
    x_class <- sapply(stepsWF(x), function(y) class(y))
    if (any(class(step) == c("numeric", "integer"))) {
        step <- stepName(x)[step]
    }
    select <- x_class[names(x_class) %in% step]
    if (all(select %in% class)) {
        return(names(select))
    } else if (!all(select %in% class)) {
        message(paste0(names(select[!select %in% class]), collapse = " AND "), " step have been dropped because it is not a ", class, " object.", "\n")
        return(names(select[select %in% class]))
    }
}

## viewEnvir() methods for SYSargsList
setMethod(f = "viewEnvir", signature = "SYSargsList", definition = function(x, silent = FALSE) {
    if (!silent) {
        print(x@runInfo$env)
        print(ls(x@runInfo$env, all.names = TRUE))
    } else {
        return(ls(x@runInfo$env, all.names = TRUE))
    }
})

## copyEnvir() methods for SYSargsList
setMethod(
    f = "copyEnvir", signature = "SYSargsList",
    definition = function(x, list = character(), new.env = globalenv(), silent = FALSE) {
        envir <- x@runInfo$env
        if (!silent) print(envir)
        if (length(list) == 0) {
            list <- ls(envir, all.names = TRUE)
        } else {
            list <- list
        }
        for (l in list) {
            assign(l, get(l, envir), new.env)
        }
        if (!silent) cat(paste0("Copying to 'new.env': ", "\n", paste0(list, collapse = ", ")))
    }
)

## addResources() methods for SYSargsList
setMethod(
    f = "addResources", signature = "SYSargsList",
    definition = function(x, step, resources) {
        # Validations
        if (!inherits(x, "SYSargsList")) {
            stop("Argument 'x' needs to be assigned an object of class 'SYSargsList'")
        }
        ## Check step
        if (inherits(step, "numeric")) {
            if (!all(step %in% seq_along(x))) {
                stop(
                    "Please select the 'step' number accordingly, options are: ", "\n",
                    "        ", paste0(seq_along(x), collapse = ", ")
                )
            }
        } else if (inherits(step, "character")) {
            if (!all(step %in% stepName(x))) {
                stop(
                    "Please select the 'step' name accordingly, options are: ", "\n",
                    "        ", paste0(stepName(x), collapse = ", ")
                )
            }
            step <- which(stepName(x) %in% step)
        }
        ## Check resources
        if (!inherits(resources, "list")) {
            stop("Argument 'resources' needs to be assigned an object of class 'named list', please check 'help(clusterRun)'")
        }
        if (!any(c("conffile", "template") %in% names(resources))) {
            stop("'resources' list should contain 'conffile' and 'template' file paths.")
        }
        if (!file.exists(resources$conffile)) stop("'", resources$conffile, "' doesn't exist. Please provid a valid PATH.")
        if (!file.exists(resources$template)) stop("'", resources$template, "' doesn't exist. Please provid a valid PATH.")
        ## for each step
        for (i in step) {
            x@runInfo$runOption[[i]]$"run_remote_resources" <- resources
            if (!x@runInfo$runOption[[i]]$run_session == "compute") {
                message("Please note that the '", stepName(x)[i], "' step option '", x@runInfo$runOption[[i]]$run_session, "' was replaced with 'compute'.")
                runInfo(x, step = i, param = "run_session") <- "compute"
            }
        }
        x <- .check_write_SYSargsList(x)
        return(x)
    }
)

#########################################
## Replacement Methods for SYSargsList ##
#########################################

## Replacement method for SYSargsList using "[[" operator
setReplaceMethod(f = "[[", signature = "SYSargsList", definition = function(x, i, j, value) {
    if (i == 1) x@stepsWF <- value
    if (i == 2) x@statusWF <- value
    if (i == 3) x@targetsWF <- value
    if (i == 4) x@outfiles <- value
    if (i == 5) x@SE <- value
    if (i == 6) x@dependency <- value
    if (i == 7) x@targets_connection <- value
    if (i == 8) x@projectInfo <- value
    if (i == 9) x@runInfo <- value
    if (i == "stepsWF") x@stepsWF <- value
    if (i == "statusWF") x@statusWF <- value
    if (i == "targetsWF") x@targetsWF <- value
    if (i == "outfiles") x@outfiles <- value
    if (i == "SE") x@SE <- value
    if (i == "dependency") x@dependency <- value
    if (i == "targets_connection") x@targets_connection <- value
    if (i == "projectInfo") x@projectInfo <- value
    if (i == "runInfo") x@runInfo <- value
    return(x)
})

## Replacement method
setReplaceMethod(
    f = "appendStep", signature = c("SYSargsList"),
    definition = function(x, after = length(x), ..., value) {
        on.exit({
            ## used in `importWF`
            options(spr_importing = FALSE)
            ## used in `+.SYSargsList`
            options(appendPlus = FALSE)
            options(linewise_importing = FALSE)
        })
        ## append position
        lengx <- length(x)
        after <- after
        if (any(stepName(value) %in% stepName(x))) stop("Steps Names need to be unique.")
        ## Dependency
        if (after > 0) {
            if (any(!value$dependency[[1]][!value$dependency[[1]] %in% NA] %in% stepName(x))) {
                stop(
                    "Dependency value needs to be present in the Workflow. ", "Options are: ", "\n",
                    paste0(paste0(stepName(x), collapse = ", "), ", OR NA")
                )
            }
        } else if (after == 0) {
            if (!is.na(dependency(value))) {
                stop("This is the first step, and there is no previous step in the Workflow. Please select NA.")
            }
        }
        if (all(dependency(value) %in% "")) value[["dependency"]][[1]] <- NA
        ## Append
        if (inherits(value, "SYSargsList")) {
            if (length(value) > 1) stop("One step can be appended in each operation.", call. = FALSE)
            value <- .validationStepConn(x, value)
            x <- sysargslist(x)
            if (names(value$stepsWF) == "Step_x") {
                step_name <- paste0("Step_", after + 1L)
                renameStep(value, 1) <- step_name
            }
            if (!after) {
                x$stepsWF <- c(value$stepsWF, x$stepsWF)
                x$targetsWF <- c(targetsWF(value), x$targetsWF)
                x$statusWF <- c(value$statusWF, x$statusWF)
                x$dependency <- c(dependency(value), x$dependency)
                x$outfiles <- c(outfiles(value), x$outfiles)
                x$SE <- c(value$SE, x$SE)
                x$targets_connection <- c(value$targets_connection, x$targets_connection)
                x$runInfo$runOption <- c(value$runInfo$runOption, x$runInfo$runOption)
            } else if (after >= lengx) {
                x$stepsWF <- c(x$stepsWF, value$stepsWF)
                x$targetsWF <- c(x$targetsWF, targetsWF(value))
                x$statusWF <- c(x$statusWF, value$statusWF)
                x$dependency <- c(x$dependency, dependency(value))
                x$outfiles <- c(x$outfiles, outfiles(value))
                x$SE <- c(x$SE, value$SE)
                x$targets_connection <- c(x$targets_connection, value$targets_connection)
                x$runInfo$runOption <- c(x$runInfo$runOption, value$runInfo$runOption)
            } else {
                after_tc <- names(x$stepsWF)[1L:after]
                before_tc <- names(x$stepsWF)[(after + 1L):lengx]
                x$targets_connection <- c(x$targets_connection[names(x$targets_connection) %in% after_tc], value$targets_connection, x$targets_connection[names(x$targets_connection) %in% before_tc])
                x$stepsWF <- c(x$stepsWF[1L:after], value$stepsWF, x$stepsWF[(after + 1L):lengx])
                x$targetsWF <- c(x$targetsWF[1L:after], targetsWF(value), x$targetsWF[(after + 1L):lengx])
                x$statusWF <- c(x$statusWF[1L:after], value$statusWF, x$statusWF[(after + 1L):lengx])
                x$dependency <- c(x$dependency[1L:after], dependency(value), x$dependency[(after + 1L):lengx])
                x$outfiles <- c(x$outfiles[1L:after], outfiles(value), x$outfiles[(after + 1L):lengx])
                x$SE <- c(x$SE[1L:after], value$SE, x$SE[(after + 1L):lengx])
                x$runInfo$runOption <- c(x$runInfo$runOption[1L:after], value$runInfo$runOption, x$runInfo$runOption[(after + 1L):lengx])
            }
            x <- as(x, "SYSargsList")
        } else if (inherits(value, "LineWise")) {
            if (value$stepName == "Step_x") {
                step_name <- paste0("Step_", after + 1L)
            } else {
                step_name <- value$stepName
            }
            x <- sysargslist(x)
            if (!after) {
                x$stepsWF <- c(value, x$stepsWF)
                x$targetsWF <- c(list(S4Vectors::DataFrame()), x$targetsWF)
                x$statusWF <- c(list(value$status), x$statusWF)
                x$dependency <- c(value$dependency, x$dependency)
                x$outfiles <- c(list(S4Vectors::DataFrame()), x$outfiles)
                x$SE <- c(list(NULL), x$SE)
                x$targets_connection <- c(list(NULL), x$targets_connection)
                x$runInfo$runOption <- c(value$runInfo$runOption, x$runInfo$runOption)
            } else if (after >= lengx) {
                x$stepsWF <- c(x$stepsWF, value)
                x$targetsWF <- c(x$targetsWF, list(S4Vectors::DataFrame()))
                x$statusWF <- c(x$statusWF, list(value$status))
                x$dependency <- c(x$dependency, value$dependency)
                x$outfiles <- c(x$outfiles, list(S4Vectors::DataFrame()))
                x$SE <- c(x$SE, list(NULL))
                x$targets_connection <- c(x$targets_connection, list(NULL))
                x$runInfo$runOption <- c(x$runInfo$runOption, value$runInfo$runOption)
            } else {
                after_tc <- names(x$stepsWF)[1L:after]
                before_tc <- names(x$stepsWF)[(after + 1L):lengx]
                x$targets_connection <- c(x$targets_connection[names(x$targets_connection) %in% after_tc], list(NULL), x$targets_connection[names(x$targets_connection) %in% before_tc])
                x$stepsWF <- c(x$stepsWF[1L:after], value, x$stepsWF[(after + 1L):lengx])
                x$targetsWF <- c(x$targetsWF[1L:after], list(S4Vectors::DataFrame()), x$targetsWF[(after + 1L):lengx])
                x$statusWF <- c(x$statusWF[1L:after], list(value$status), x$statusWF[(after + 1L):lengx])
                x$dependency <- c(x$dependency[1L:after], value$dependency, x$dependency[(after + 1L):lengx])
                x$outfiles <- c(x$outfiles[1L:after], list(S4Vectors::DataFrame()), x$outfiles[(after + 1L):lengx])
                x$SE <- c(x$SE[1L:after], list(NULL), x$SE[(after + 1L):lengx])
                x$runInfo$runOption <- c(x$runInfo$runOption[1L:after], value$runInfo$runOption, x$runInfo$runOption[(after + 1L):lengx])
            }
            names(x$stepsWF)[after + 1L] <- step_name
            names(x$statusWF)[after + 1L] <- step_name
            names(x$dependency)[after + 1L] <- step_name
            names(x$targetsWF)[after + 1L] <- step_name
            names(x$outfiles)[after + 1L] <- step_name
            names(x$SE)[after + 1L] <- step_name
            names(x$targets_connection)[after + 1L] <- step_name
            names(x$runInfo$runOption)[after + 1L] <- step_name
            x <- as(x, "SYSargsList")
        } else {
            stop("Argument 'value' needs to be assigned an object of class 'SYSargsList' OR 'LineWise'.")
        }
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Internal functions ##
.check_write_SYSargsList <- function(x, silent = TRUE) {
    if (!inherits(x, "SYSargsList")) stop("Argument 'x' needs to be assigned an object of class 'SYSargsList'.")
    sys.file <- projectInfo(x)$sysargslist
    if (is.null(sys.file)) {
        if (interactive()) {
            init <- readline(cat(
                cat(crayon::bgMagenta("** Object 'x' was NOT initialized with SPRproject function! **\n")),
                "Do you like to initialize the project now using the default values?", "Type a number: \n",
                "\n 1. Please create the project \n 2. I don't need the project information \n 3. Quit"
            ))
        } else {
            ## For an non-interactive session
            init <- "1"
        }
        if (init == "1") {
            init <- SPRproject()
            x[["projectInfo"]] <- init$projectInfo
            sys.file <- projectInfo(x)$sysargslist
            write_SYSargsList(x, sys.file, silent = TRUE)
            return(x)
        } else if (init == "2") {
            print("For more details, check help(SRRproject)")
            return(x)
        } else if (init == "3") {
            stop("Quiting...")
        }
    } else if (!is.null(sys.file)) {
        sys.file <- file.path(projectInfo(x)$project, projectInfo(x)$sysargslist)
        write_SYSargsList(x, sys.file, silent = silent)
        return(x)
    }
}

## Internal functions ##
.validationStepConn <- function(x, value) {
    ## used in `importWF`
    on.exit({
        options(spr_importing = FALSE)
        options(replace_step = FALSE)
    })
    targetsCon <- value$targets_connection[[1]]
    ## Check outfiles names
    value_out <- targetsCon[[1]][[1]]
    if (any(duplicated(unlist(lapply(value_out, function(y) names(outfiles(x)[[y]])))))) {
        stop("'outfiles' columns names need to be unique for the steps provide in the targets argument.", call. = FALSE)
    }
    ## Check value length
    ## only one step at the time
    if (length(value) > 1) stop("One step can be appended in each operation.", call. = FALSE)
    if (!is.null(targetsCon[[1]])) {
        step <- targetsCon[[1]][[1]]
        if (any(!step %in% names(stepsWF(x)))) {
            stop("'targets' argument needs to be assigned as valid targets file OR ", "\n",
                "the names of a previous step, for example: ", "\n",
                paste0(names(stepsWF(x)), collapse = " OR "),
                call. = FALSE
            )
        }
        ## check new_targets_col
        all_names <- unlist(append(
            lapply(outfiles(x), function(y) names(y)),
            unique(unlist(lapply(targetsWF(x)[step], function(y) names(y))))
        ))
        if (!all(targetsCon[[2]][[1]] %in% all_names)) stop("Invalid `inputVars`.", call. = FALSE)
        new_targets_col <- targetsCon[[2]][[1]][!targetsCon[[2]][[1]] %in% unlist(lapply(targetsWF(x)[step], function(y) names(y)))]
        new_targets <- .cbindTargetsOutfiles(x, step, new_targets_col, targetsCon[[3]][[1]])
        new_targetsheader <- sapply(step, function(y) targetsheader(x, y))
        if (!all(sapply(new_targetsheader, function(x) identical(x, new_targetsheader[[1]])))) {
            stop("Step(s) you selected have different targetsheader(x), cannot use these step(s) as targets connections", call. = FALSE)
        }
        new_targetsheader <- new_targetsheader[1]
        names(new_targetsheader) <- "targetsheader"
        WF <- value$stepsWF[[1]]
        WF2 <- updateWF(WF, new_targets = targets.as.list(data.frame(new_targets)), new_targetsheader = new_targetsheader, inputvars = WF$inputvars, write.yaml = FALSE)
        value <- sysargslist(value)
        value$stepsWF[[1]] <- WF2
        value$targetsWF[[1]] <- as(WF2, "DataFrame")
        ## SE object update
        rownames(value$targetsWF[[1]]) <- value$targetsWF[[1]][, value$stepsWF[[1]]$files$id]
        value$SE <- list(SummarizedExperiment::SummarizedExperiment(
            colData = value$targetsWF,
            metadata = value$stepsWF[[1]]$targetsheader
        ))
        names(value$SE) <- names(value$targetsWF)
        value$outfiles[[1]] <- output.as.df(WF2)
        value$statusWF[[1]] <- WF2$status
        rownames(value$outfiles[[1]]) <- value$targetsWF[[1]][, value$stepsWF[[1]]$files$id]
        rownames(value$statusWF[[1]]$status.completed) <- value$targetsWF[[1]][, value$stepsWF[[1]]$files$id]
        rownames(value$statusWF[[1]]$status.time) <- value$targetsWF[[1]][, value$stepsWF[[1]]$files$id]
        value <- as(value, "SYSargsList")
    }
    if (inherits(value, "SYSargs2")) {
        value[["statusWF"]][[1]]$status.completed <- cbind(check.output(value)[[1]], value$statusWF[[1]]$status.completed[5:ncol(value$statusWF[[1]]$status.completed)])
    }
    if (all(!is.na(dependency(value)) && !getOption("spr_importing", FALSE) && !getOption("replace_step", FALSE))) {
        dep <- dependency(value)[[1]]
        if (inherits(dep, "character")) {
            if (all(!dep %in% names(stepsWF(x)))) {
                stop(
                    "'dependency' argument needs to be assigned as valid previous Step Name, for example: ", "\n",
                    paste0(names(stepsWF(x)), collapse = " OR ")
                )
            }
        } else {
            if (inherits(dep, "numeric")) {
                if (all(!dep %in% 1:length(stepsWF(x)))) {
                    stop(
                        "'dependency' argument needs to be assigned as valid previous Step Index, for example: ", "\n",
                        paste0(1:length(stepsWF(x)), collapse = " OR ")
                    )
                }
            }
        }
    }
    return(value)
}

## Internal functions ##
.cbindTargetsOutfiles <- function(sal, targets_con, new_targets_col, rm_targets_con = NULL) {
    . <- print_targets <- NULL
    ## handle outfiles
    outfiles <- outfiles(sal)[targets_con] %>%
        lapply(as.data.frame) %>%
        {
            .[lapply(., function(x) nrow(x) > 0) %>% unlist()]
        }
    if (length(targets) > 1) {
        outfiles_length <- lapply(outfiles, nrow) %>% unlist()
        if (
            (length(unique(outfiles_length)) > 2) ||
                (outfiles_length[1] != mean(outfiles_length)) &&
                    (!1 %in% outfiles_length)
        ) {
            stop("Steps you selected have different Sample length in outfiles, cannot use these steps as targets connections")
        }
    }
    outfiles <- data.frame(lapply(outfiles, function(x) x[colnames(x) %in% new_targets_col]))
    colnames(outfiles) <- new_targets_col
    ## handle targets
    targets <- targetsWF(sal)[targets_con] %>%
        lapply(as.data.frame) %>%
        {
            .[lapply(., function(x) nrow(x) > 0) %>% unlist()]
        }
    ## cases of removal of columns
    if (!is.null(rm_targets_con)) targets <- lapply(targets, function(x) x[!colnames(x) %in% rm_targets_con])
    if (length(targets) > 1) {
        targets_length <- lapply(targets, nrow) %>% unlist()
        if (
            (length(unique(targets_length)) > 2) ||
                (targets_length[1] != mean(targets_length)) &&
                    (!1 %in% targets_length)
        ) {
            stop("Steps you selected have different Sample length in targets, cannot use these steps as targets connections")
        }
        targets <- lapply(seq_along(targets), function(x) {
            if (x == 1) {
                return(targets[[x]])
            }
            print_targets <- names(targets[x])
            names(targets[[x]]) <- paste0(names(targets[[x]]), "_", names(targets[x]))
            targets[[x]]
        })
        if (exists("print_targets")) message("columns in step ", print_targets, " has been renamed with `<columnName>_<StepName>`.")
    }
    names <- unlist(lapply(targets, function(y) names(y)))
    targets <- do.call(cbind, targets)
    colnames(targets) <- names
    ## merge both
    df <- if (length(outfiles) == 0 && length(targets) != 0) {
        targets
    } else if (length(outfiles) != 0 && length(targets) == 0) {
        outfiles
    } else if (length(outfiles) == 0 && length(targets) == 0) {
        stop("Selected steps don't have any targets or outfiles, try to choose other steps as targets connections")
    } else {
        if (nrow(targets) != nrow(outfiles) && nrow(outfiles) != 1) {
            stop("Step(s) you selected have different length in",
                "outfiles and targets dataframes or the outfiles",
                "length is not 1, this is not allowed",
                call. = FALSE
            )
        }
        df <- cbind(outfiles, targets)
    }
    return(df)
}

## Usage:
# appendStep(sal) <- SYSargsList(WF)
# appendStep(sal, after=0) <- SYSargsList(WF)
# appendStep(sal, after=0, step_index="test_11") <- SYSargsList(WF)

## Replacement method
setReplaceMethod(
    f = "yamlinput", signature = c("SYSargsList"),
    definition = function(x, step, paramName, value) {
        if (length(step) > 1) stop("Only ONE step can be selected at the time")
        x_sub <- x[step]
        args <- x_sub@stepsWF[[1]]
        if (!inherits(args, "SYSargs2")) stop("Please selected a 'SYSargs2' step")
        yamlinput(args, paramName) <- value
        x <- sysargslist(x)
        x$stepsWF[[step]] <- args
        x <- as(x, "SYSargsList")
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "replaceStep", signature = c("SYSargsList"),
    definition = function(x, step, step_name = "default", value) {
        on.exit({
            options(spr_importing = FALSE)
            options(replace_step = FALSE)
            options(appendPlus = FALSE)
        })
        if (any(!inherits(value, "SYSargsList") && !inherits(value, "LineWise"))) {
            stop("Argument 'value' needs to be assigned an object of class 'SYSargsList' or 'LineWise'.")
        }
        if (all(inherits(value, "SYSargsList") && length(value) > 1)) stop("Argument 'value' cannot have 'length(value) > 1")
        ## Check step name or index on x
        if (inherits(step, "numeric")) {
            if (step > length(x)) {
                stop("Argument 'step' cannot be greater than ", length(x))
            }
        } else if (inherits(step, "character")) {
            if (!step %in% stepName(x)) {
                stop(
                    "Argument 'step' needs to be assigned one of the following: ",
                    paste(stepName(x), collapse = " OR ")
                )
            }
            step <- grep(step, stepName(x))
        }
        ## Dependency
        if (step > 1) {
            if (all(dependency(value) %in% "")) value[["dependency"]][[1]] <- NA
            if (any(!value$dependency[[1]][!value$dependency[[1]] %in% NA] %in% stepName(x))) {
                stop(
                    "Dependency value needs to be present in the Workflow. ",
                    "Options are: ", "\n",
                    paste0(stepName(x)[1:step - 1], collapse = ", ")
                )
            }
        } else if (step == 1) {
            ## first step usually is ""
            if (!is.na(dependency(value))) {
                if (!value$dependency[[1]] %in% stepName(x)) {
                    warning("The dependency step specify is not in the Workflow. Please check the dependency tree.")
                }
            }
        }
        ## Update connections
        on.exit({
            options(replace_step = TRUE)
        })
        if (inherits(value, "SYSargsList")) value <- .validationStepConn(x[-c(step)], value)
        ## replace
        x <- sysargslist(x)
        if (inherits(value, "SYSargsList")) {
            x$stepsWF[step] <- value$stepsWF
            x$statusWF[step] <- value$statusWF
            x$targetsWF[step] <- value$targetsWF
            x$outfiles[step] <- value$outfiles
            x$SE[step] <- value$SE
            x$dependency[step] <- value$dependency
            x$targets_connection[step] <- value$targets_connection
            x$runInfo[["runOption"]][step] <- value$runInfo[["runOption"]]
        } else if (inherits(value, "LineWise")) {
            x$stepsWF[[step]] <- value
            x$statusWF[[step]] <- value$status
            x$targetsWF[[step]] <- S4Vectors::DataFrame()
            x$outfiles[[step]] <- S4Vectors::DataFrame()
            x$SE[step] <- list(NULL)
            x$dependency[[step]] <- value$dependency[[1]]
            x$targets_connection[[step]] <- list(NULL)
            x$runInfo[["runOption"]][step] <- value$runInfo[["runOption"]]
        }
        x <- as(x, "SYSargsList")
        ## rename
        if (step_name == "default") {
            name <- stepName(value)
            if (name %in% stepName(x)) {
                renameStep(x, step) <- paste0("Step_", step)
                cat(paste0("Index name of x", "[", step, "]", " was rename to ", paste0("Step_", step), " to avoid duplications."))
            } else {
                renameStep(x, step) <- stepName(value)
            }
        } else {
            renameStep(x, step) <- step_name
        }
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "updateStatus", signature = c("SYSargsList"),
    definition = function(x, step, value) {
        if (!inherits(value, "SYSargsList")) {
            stop("Argument 'value' needs to be assigned an object of class 'SYSargsList'.")
        }
        if (length(step) > 1) stop("Argument 'step' cannot have 'length(step) > 1")
        if (!all(stepName(value) %in% stepName(x))) stop("Argument 'value' are required to have the same stepName then x")
        ## Check step name or index on x
        if (inherits(step, "numeric")) {
            if (step > length(x)) stop("Argument 'step' cannot be greater than ", length(x))
            step <- stepName(x)[step]
        } else if (inherits(step, "character")) {
            if (!step %in% stepName(x)) {
                stop(
                    "Argument 'step' needs to be assigned one of the following: ",
                    paste(stepName(x), collapse = " OR ")
                )
            }
        }
        ## Dependency
        if (!all(dependency(x)[[step]] == dependency(value)[[step]])) {
            stop("'dependency' for 'x' and 'value' objects are required to have the same structure")
        }
        ## replace
        extra <- which(dependency(x) %in% stepName(x[step]))
        extra <- c(step, extra)
        x <- sysargslist(x)
        if (inherits(value, "SYSargsList")) {
            x$stepsWF[extra] <- value$stepsWF[extra]
            x$statusWF[extra] <- value$statusWF[extra]
            x$targetsWF[extra] <- value$targetsWF[extra]
            x$outfiles[extra] <- value$outfiles[extra]
            x$SE[extra] <- value$SE[extra]
            x$runInfo[["runOption"]][extra] <- value$runInfo[["runOption"]][extra]
            if (!is.null(value$projectInfo$logsFile)) {
                if (!is.null(x$projectInfo$logsFile)) {
                    cat(readLines(value$projectInfo$logsFile),
                        file = x$projectInfo$logsFile, sep = "\n",
                        append = TRUE
                    )
                }
            }
        }
        x <- as(x, "SYSargsList")
        if (length(ls(value$runInfo$env)) > 0) {
            copyEnvir(value, new.env = x$runInfo$env, silent = TRUE)
        }
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "renameStep", signature = c("SYSargsList"),
    definition = function(x, step, ..., value) {
        ## checking step and value length
        if (length(step) != length(value)) stop("value argument needs to be the same length of the step for rename")
        ## checking for special characters
        if (inherits(value, "character")) {
            .checkSpecialChar(value)
        } else {
            stop("Replace value needs to be assigned an 'character' name for the workflow step.")
        }
        ## if the replace has the same name
        if (any(value %in% stepName(x)[step])) {
            return(x)
        }
        ## step_name duplication
        if (any(value %in% stepName(x))) stop("Steps Names need to be unique.")
        ## Check step name or index on x
        if (inherits(step, "numeric")) {
            if (length(step) > length(x)) {
                stop("Argument 'step' cannot be greater than ", length(x))
            }
        } else if (inherits(step, "character")) {
            if (!all(step %in% stepName(x))) {
                stop(
                    "Argument 'step' needs to be assigned one of the following: ",
                    paste(stepName(x), collapse = " OR ")
                )
            }
            step <- sapply(as.list(step), function(y) grep(y, stepName(x)))
        }
        for (i in seq_along(step)) {
            original <- names(x@stepsWF)[step[i]]
            names(x@stepsWF)[step[i]] <- value[i]
            names(x@statusWF)[step[i]] <- value[i]
            names(x@dependency)[step[i]] <- value[i]
            names(x@targetsWF)[step[i]] <- value[i]
            names(x@outfiles)[step[i]] <- value[i]
            names(x@SE)[step[i]] <- value[i]
            names(x@targets_connection)[step[i]] <- value[i]
            if (!is.null(x$runInfo$runOption)) {
                names(x@runInfo$runOption)[step[i]] <- value[i]
            }
            ## check in dependency step
            x[["dependency"]] <- lapply(x$dependency, function(y) gsub(original, value[i], y))
            ## check in targets_connection step
            x[["targets_connection"]] <- lapply(x$targets_connection, function(y) {
                if (!is.null(y)) {
                    lapply(y, function(w) {
                        if (all(w == original)) {
                            sub(original, value[i], w)
                        } else {
                            w
                        }
                    })
                }
            })
        }
        ## Save
        if (!is.null(x$projectInfo$sysargslist)) {
            x <- .check_write_SYSargsList(x)
        }
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "dependency", signature = c("SYSargsList"),
    definition = function(x, step, ..., value) {
        ## checking step length
        if (length(step) > 1) stop("Dependency of one step at the time can be replaced...")
        ## Check step name or index on x
        if (inherits(step, "numeric")) {
            if (step > length(x)) {
                stop("Argument 'step' cannot be greater than ", length(x))
            }
            if (all(any(!value %in% stepName(x)[step:1]) && !is.na(value))) {
                stop("Dependency name cannot be found in the workflow.")
            }
        } else if (inherits(step, "character")) {
            if (!step %in% stepName(x)) {
                stop(
                    "Argument 'step' needs to be assigned one of the following: ",
                    paste(stepName(x), collapse = " OR ")
                )
            }
            step <- grep(step, stepName(x))
            if (all(any(!value %in% stepName(x)[step:1]) && !is.na(value))) {
                stop("Dependency name cannot be found in the workflow.")
            }
        }
        x@dependency[[step]] <- value
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "replaceCodeLine", signature = c("SYSargsList"),
    definition = function(x, step, line, value) {
        if (!inherits(value, "LineWise")) {
            stop("The value argument needs to be assigned a 'LineWise' object")
        }
        y <- x$stepsWF[step][[1]]
        if (!inherits(y, "LineWise")) {
            stop("The step argument needs to be assigned a 'LineWise' object")
        }
        y <- as(y, "list")
        y$codeLine <- as.character(y$codeLine)
        if (missing(line)) {
            y$codeLine <- as.character(value$codeLine)
        } else {
            y$codeLine[line] <- as.character(value$codeLine)
        }
        y$codeLine <- parse(text = y$codeLine)
        y <- as(y, "LineWise")
        x <- as(x, "list")
        x$stepsWF[step][[1]] <- y
        x <- as(x, "SYSargsList")
        sys.file <- projectInfo(x)$sysargslist
        write_SYSargsList(x, sys.file, silent = TRUE)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "appendCodeLine", signature = c("SYSargsList"),
    definition = function(x, step, after = NULL, value) {
        if (is.null(after)) after <- length(stepsWF(x[step])[[1]])
        y <- x$stepsWF[step][[1]]
        if (!inherits(y, "LineWise")) stop("Provide 'LineWise' class object")
        lengx <- length(y)
        y <- linewise(y)
        value <- parse(text = value)
        if (!after) {
            y$codeLine <- c(value, y$codeLine)
        } else if (after >= lengx) {
            y$codeLine <- c(y$codeLine, value)
        } else {
            y$codeLine <- c(y$codeLine[1L:after], value, y$codeLine[(after + 1L):lengx])
        }
        y <- as(y, "LineWise")
        x <- as(x, "list")
        x$stepsWF[step][[1]] <- y
        x <- as(x, "SYSargsList")
        sys.file <- projectInfo(x)$sysargslist
        write_SYSargsList(x, sys.file, silent = TRUE)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "stepsWF", signature = c("SYSargsList"),
    definition = function(x, step, ..., value) {
        x@stepsWF[[step]] <- value
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "statusWF", signature = c("SYSargsList"),
    definition = function(x, step, ..., value) {
        x@statusWF[[step]] <- value
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "runInfo", signature = c("SYSargsList"),
    definition = function(x, step, param, ..., value) {
        x@runInfo$runOption[[step]][[param]] <- value
        x <- .check_write_SYSargsList(x)
        x
    }
)

## Replacement method
setReplaceMethod(
    f = "SE", signature = c("SYSargsList"),
    definition = function(x, step, ..., value) {
        if (is.numeric(step)) {
            step <- stepName(x)[step]
        }
        if (!inherits(value, "SummarizedExperiment")) stop("Provide 'SummarizedExperiment' class object")
        x@SE[[step]] <- value
        x <- .check_write_SYSargsList(x)
        x
    }
)