##' Prepare (Load) Downloaded Datasets to R

##'

##' @author Shixiang Wang <w_shixiang@163.com>

##' @param objects a object of character vector or data.frame. If `objects` is data.frame,

##' it should be returned object of [XenaDownload] function. More easier way is

##' that objects can be character vector specify local files/directory and download urls.

##' @param objectsName specify names for elements of return object, i.e. names of list

##' @param use_chunk default is `FALSE`. If you want to select subset of original data, please set it to

##' `TRUE` and specify corresponding arguments: `chunk_size`, `select_direction`, `select_names`,

##' `callback`.

##' @param chunk_size the number of rows to include in each chunk

##' @param subset_rows logical expression indicating elements or rows to keep:

##' missing values are taken as false. `x` can be a representation of data frame

##' you wanna do subset operation. Of note, the first colname of most of datasets

##' in Xena will be set to "sample", you can use it to select rows.

##' @param select_cols expression, indicating columns to select from a data frame.

##' 'x' can be a representation of data frame you wanna do subset operation,

##' e.g. `select_cols = colnames(x)[1:3]` will keep only first to third column.

##' @param callback a function to call on each chunk, default is `NULL`,

##' this option will overvide operations of subset_rows and select_cols.

##' @param comment a character specify comment rows in files

##' @param na a character vectory specify `NA` values in files

##' @param ... other arguments transfer to `read_tsv` function or

##' `read_tsv_chunked` function (when `use_chunk` is `TRUE`) of `readr` package.

##' @return a list contains file data, which in way of tibbles

##' @export

##' @importFrom readr read_tsv

##' @importFrom readr read_tsv_chunked

##' @importFrom readr cols

##' @examples

##' \dontrun{

##' xe = XenaGenerate(subset = XenaHostNames == "tcgaHub")

##' hosts(xe)

##' xe_query = XenaQuery(xe)

##'

##' xe_download = XenaDownload(xe_query)

##' dat = XenaPrepare(xe_download)

##' }

XenaPrepare <- function(objects,

                        objectsName = NULL,

                        use_chunk = FALSE,

                        chunk_size = 100,

                        subset_rows = TRUE,

                        select_cols = TRUE,

                        callback = NULL,

                        comment = "#",

                        na = c("", "NA", "[Discrepancy]"),

                        ...) {

  # objects can be url, local files/directory or xena object from xena download process

  stopifnot(

    is.character(objects) |

      is.data.frame(objects),

    is.logical(use_chunk)

  )

  subset_rows.bk <- subset_rows

  select_cols.bk <- select_cols

  subset_rows <- substitute(subset_rows)

  if (is.name(subset_rows)) {

    subset_rows <- substitute(eval(subset_rows.bk))

  }

  select_cols <- substitute(select_cols)

  if (is.name(select_cols)) {

    select_cols <- substitute(eval(select_cols.bk))

  }

  # subset_rows <- substitute(subset_rows)

  # select_cols <- substitute(select_cols)

  #    subset_direction = match.arg(subset_direction)

  objects2 <- objects

  if (is.character(objects)) {

    if (length(objects) == 0) {

      stop("Please check you input!")

    }

    # Is the input directory?

    if (all(dir.exists(objects))) {

      if (length(objects) > 1) {

        stop("We do not accept multiple directories as input.")

      } else {

        files <- paste0(objects, "/", dir(objects))

        res <- lapply(files, function(x) {

          if (use_chunk) {

            if (is.null(callback)) {

              f <- function(x, pos) {

                subset(x,

                  eval(subset_rows),

                  select = eval(select_cols)

                )

              }

            } else {

              f <- callback

            }

            y <- readr::read_tsv_chunked(

              x,

              readr::DataFrameCallback$new(f),

              chunk_size = chunk_size,

              comment = comment,

              na = na,

              col_types = readr::cols()

            )

          } else {

            y <- readr::read_tsv(

              x,

              comment = comment,

              na = na,

              col_types = readr::cols(),

              ...

            )

          }

          y

        })

        if (is.null(objectsName)) {

          objectsName <- make.names(dir(objects))

          names(res) <- objectsName

        }

      }

    } else if (all(file.exists(objects))) {

      res <- lapply(objects, function(x) {

        if (use_chunk) {

          if (is.null(eval(callback))) {

            f <- function(x, pos) {

              subset(x,

                eval(subset_rows),

                select = eval(select_cols)

              )

            }

          } else {

            f <- callback

          }

          y <- readr::read_tsv_chunked(

            x,

            readr::DataFrameCallback$new(f),

            chunk_size = chunk_size,

            comment = comment,

            na = na,

            col_types = readr::cols()

          )

        } else {

          y <- readr::read_tsv(

            x,

            comment = comment,

            na = na,

            col_types = readr::cols(),

            ...

          )

        }

        y

      })

      if (is.null(objectsName)) {

        objectsName <- make.names(basename(objects))

        names(res) <- objectsName

      }

      if (length(res) == 1) {

        res <- res[[1]]

      }

    }

    else {

      # check urls

      all_right <- grepl(pattern = "http", x = objects)

      if (any(all_right)) {

        objects <- objects[all_right]

        if (length(objects) == 1) {

          if (use_chunk) {

            if (is.null(callback)) {

              f <- function(x, pos) {

                subset(x,

                  eval(subset_rows),

                  select = eval(select_cols)

                )

              }

            } else {

              f <- callback

            }

            res <- readr::read_tsv_chunked(

              objects,

              readr::DataFrameCallback$new(f),

              chunk_size = chunk_size,

              comment = comment,

              na = na,

              col_types = readr::cols()

            )

          } else {

            res <- readr::read_tsv(

              objects,

              comment = comment,

              na = na,

              col_types = readr::cols(),

              ...

            )

          }

          # res = suppressMessages(read_tsv(objects, comment=comment, na=na, ...))

        } else {

          res <- lapply(objects, function(x) {

            if (use_chunk) {

              if (is.null(callback)) {

                f <- function(x, pos) {

                  subset(x,

                    eval(subset_rows),

                    select = eval(select_cols)

                  )

                }

              } else {

                f <- callback

              }

              y <- readr::read_tsv_chunked(

                x,

                readr::DataFrameCallback$new(f),

                chunk_size = chunk_size,

                comment = comment,

                na = na,

                col_types = readr::cols()

              )

            } else {

              y <- readr::read_tsv(

                x,

                comment = comment,

                na = na,

                col_types = readr::cols(),

                ...

              )

            }

            y

          })

          if (is.null(objectsName)) {

            objectsName <- make.names(basename(objects))

            names(res) <- objectsName

          }

        }

      }

      all_wrong <- !all_right

      if (any(all_wrong)) {

        bad_urls <- objects2[all_wrong]

        message("Some inputs are wrong, maybe you should check:")

        print(bad_urls)

      }

    }

  } else {

    if (!"destfiles" %in% colnames(objects)) {

      stop(

        "Input data.frame should contain 'destfiles' column which generated by XenaDownload functions. Please check your input."

      )

    }

    files <- objects$destfiles

    res <- XenaPrepare(

      files,

      objectsName = objectsName,

      use_chunk = use_chunk,

      chunk_size = chunk_size,

      subset_rows = subset_rows,

      select_cols = select_cols,

      callback = callback,

      comment = comment,

      na = na,

      ...

    )

  }

  return(res)

}