#' Filter and extract function
#'
#' This function lets user to create a new GRangesList with fixed information:
#' seqnames, ranges and strand, and a variable part made up by the regions
#' defined as input. The metadata and metadata_prefix are used to filter
#' the data and choose only the samples that match at least one metdatata
#' with its prefix. The input regions are shown for each sample obtained
#' from filtering.
#'
#' @import xml2
#' @importFrom dplyr bind_cols
#' @importFrom data.table fread
#' @importFrom rtracklayer import
#'
#' @param data string GMQL dataset folder path or GRangesList
#' object
#' @param metadata vector of strings containing names of metadata attributes
#' to be searched for in metadata files.
#' Data will be extracted if at least one condition is satisfied:
#' this condition is logically "ANDed" with prefix filtering (see below)
#' if NULL no filtering action occures
#' (i.e every sample is taken for region filtering)
#' @param metadata_prefix vector of strings that will support the metadata
#' filtering. If defined, each 'metadata' is concatenated with the
#' corresponding prefix.
#' @param region_attributes vector of strings that extracts only region
#' attributes  specified; if NULL no regions attribute is taken and the output
#' is only GRanges made up by the region coordinate attributes
#' (seqnames, start, end, strand);
#' It is also possible to assign the \code{\link{FULL}} with or without 
#' its input parameter; in case was without the `except` parameter, 
#' all the region attributes are taken, otherwise all the region attributes 
#' are taken except the input attribute defined by except.
#' @param suffix name for each metadata column of GRanges. By default it is the
#' value of the metadata attribute named "antibody_target". This string is
#' taken from sample metadata file or from metadata() associated.
#' If not present, the column name is the name of selected regions specified
#' by 'region_attributes' input parameter
#'
#' @details
#' This function works only with dataset or GRangesList all whose samples or
#' Granges have the same region coordinates (chr, ranges, strand) ordered in
#' the same way for each sample
#'
#' In case of GRangesList data input, the function searches for metadata
#' into metadata() function associated to GRangesList.
#'
#' @return GRanges with selected regions
#'
#' @examples
#'
#' ## This statement defines the path to the folder "DATASET" in the
#' ## subdirectory "example" of the package "RGMQL" and filters such folder
#' ## dataset including at output only "pvalue" and "peak" region attributes
#'
#' test_path <- system.file("example", "DATASET", package = "RGMQL")
#' filter_and_extract(test_path, region_attributes = c("pvalue", "peak"))
#'
#' ## This statement imports a GMQL dataset as GRangesList and filters it
#' ## including at output only "pvalue" and "peak" region attributes, the sort
#' ## function makes sure that the region coordinates (chr, ranges, strand)
#' ## of all samples are ordered correctly
#'
#' grl <- import_gmql(test_path, TRUE)
#' sorted_grl <- sort(grl)
#' filter_and_extract(sorted_grl, region_attributes = c("pvalue", "peak"))
#' 
#' ## This statement imports a GMQL dataset as GRangesList and filters it
#' ## including all the region attributes
#' 
#' sorted_grl_full <- sort(grl)
#' filter_and_extract(sorted_grl_full, region_attributes = FULL())
#' 
#' ## This statement imports a GMQL dataset as GRangesList and filters it
#' ## including all the region attributes except "jaccard" and "score"
#' 
#' sorted_grl_full_except <- sort(grl)
#' filter_and_extract(
#'  sorted_grl_full_except, 
#'  region_attributes = FULL("jaccard", "score")
#' )
#' 
#' @export
#'
filter_and_extract <- function(
  data,
  metadata = NULL,
  metadata_prefix = NULL,
  region_attributes = NULL,
  suffix = "antibody_target"
) {
  
  if (is(data, "GRangesList")) {
    .extract_from_GRangesList(
      data,
      metadata,
      metadata_prefix,
      region_attributes,
      suffix
    )
  } else {
    .extract_from_dataset(
      data,
      metadata,
      metadata_prefix,
      region_attributes, suffix
    )
  }
}

.extract_from_dataset <- function(
  datasetName,
  metadata,
  metadata_prefix,
  regions,
  suffix
) {
  datasetName <- sub("/*[/]$", "", datasetName)
  if (basename(datasetName) != "files") {
    datasetName <- file.path(datasetName, "files")
  }
  
  if (!dir.exists(datasetName)) {
    stop("Directory does not exists")
  }
  
  gdm_meta_files <- list.files(
    datasetName,
    pattern = "*.gdm.meta$",
    full.names = TRUE
  )
  
  gtf_meta_files <- list.files(
    datasetName,
    pattern = "*.gtf.meta$",
    full.names = TRUE
  )
  
  if (!length(gdm_meta_files) && !length(gtf_meta_files)) {
    stop("no samples present or no files format supported")
  }
  
  if (length(gdm_meta_files) && length(gtf_meta_files)) {
    stop("GMQL dataset cannot be mixed dataset: no GTF and GDM together")
  }
  
  vector_field <- .schema_header(datasetName)
  
  if (length(gdm_meta_files)) {
    samples_file <- .check_metadata_files(
      metadata, metadata_prefix,
      gdm_meta_files
    )
    
    samples_meta_to_read <- unlist(samples_file)
    
    if (length(samples_meta_to_read)) {
      samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
    } else {
      samples_to_read <- gsub(".meta$", "", gdm_meta_files)
      samples_meta_to_read <- gtf_meta_files
    }
    
    suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
    granges <- .parse_gdm_files(
      vector_field, 
      samples_to_read, 
      regions,
      suffix_vec
    )
    
  } else {
    samples_file <- .check_metadata_files(
      metadata, 
      metadata_prefix,
      gtf_meta_files
    )
    samples_meta_to_read <- unlist(samples_file)
    
    if (length(samples_meta_to_read)) {
      samples_to_read <- gsub(".meta$", "", samples_meta_to_read)
    } else {
      samples_to_read <- gsub(".meta$", "", gtf_meta_files)
      samples_meta_to_read <- gtf_meta_files
    }
    
    suffix_vec <- .get_suffix(suffix, FALSE, samples_meta_to_read)
    granges <- .parse_gtf_files(
      samples_to_read, 
      regions, 
      suffix_vec, 
      vector_field
    )
  }
}

.extract_from_GRangesList <- function(
  rangesList,
  metadata,
  metadata_prefix,
  regions,
  suffix
) {
  if (!is(rangesList, "GRangesList")) {
    stop("only GrangesList admitted")
  }
  
  if (!length(rangesList)) {
    stop("rangesList empty")
  }
  
  meta_list <- metadata(rangesList)
  samples <- .check_metadata_list(metadata, metadata_prefix, meta_list)
  if (!length(unlist(samples))) {
    samples <- rangesList
  } else {
    index <- unlist(samples)
    samples <- rangesList[c(index)]
  }
  new_meta_list <- metadata(samples)
  suffix_vec <- .get_suffix(suffix, TRUE, new_meta_list)
  granges <- .parse_Granges(samples, regions, suffix_vec)
}

.parse_Granges <- function(region_list, regions, suffixes) {
  if (is.null(suffixes)) {
    suffixes <- ""
  }
  
  g1 <- region_list[[1]]

  if(is.object(regions) && ("FULL" %in% class(regions))) {
    all_values <- names(elementMetadata(g1))
    except_values <- regions$values
    regions <- if (is.null(except_values))
      all_values
    else
      all_values[!all_values %in% except_values]
    names(regions) <- NULL
    # since import convert this value from GMQL schema to GTF format
    # we need to convert it back
    regions <- replace(regions, regions == "feature", "type")
    regions <- replace(regions, regions == "frame", "phase")
  }
  
  elementMetadata(g1) <- NULL
  if (!is.null(regions)) {
    DF_list <- mapply(function(g_x, h) {
      meta <- elementMetadata(g_x)[regions]
      if (h != "") {
        names(meta) <- paste(regions, h, sep = ".")
      }
      data.frame(meta)
    }, region_list, suffixes, SIMPLIFY = FALSE)
    DF_only_regions <- dplyr::bind_cols(DF_list)
    elementMetadata(g1) <- DF_only_regions
  }
  g1
}

.get_suffix <- function(col_name, from_list, meta_fl) {
  suffix <- paste0(col_name, "$")
  
  if (from_list) {
    meta_list <- mapply(function(x, index) {
      vec_names <- names(x)
      s_index <- grep(suffix, vec_names)
      first_index <- s_index[1]
      suffix <- unlist(x[first_index]) # ne prendo solo uno
      names(suffix) <- NULL
      
      # if found retrieve samples that has at least one choosen metadata
      if (first_index && !is.na(first_index)) {
        suffix
      } else {
        ""
      }
    }, meta_fl, seq_along(meta_fl))
  }
  else {
    meta_list <- vapply(meta_fl, function(x) {
      list <- .add_metadata(x)
      vec_names <- names(list)
      index <- grep(suffix, vec_names)
      first_index <- index[1]
      suffix <- unlist(list[first_index]) # ne prendo solo uno
      names(suffix) <- NULL
      # if found retrieve samples that has at least one choosen metadata
      if (first_index && !is.na(first_index)) {
        suffix
      } else {
        ""
      }
    }, character(1))
  }
  names(meta_list) <- NULL
  meta_list
}

.check_metadata_list <- function(metadata, metadata_prefix, meta_list) {
  vec_meta <- paste0(metadata_prefix, metadata)
  list <- mapply(function(x, index) {
    vec_names <- names(x)
    a <- lapply(vec_meta, function(y) {
      which(y == vec_names)
    })
    ## we would like that manage more index from grep
    found <- as.logical(length(unlist(a)))
    # if found retrieve samples that has at least one choosen metadata
    if (found) {
      index
    }
  }, meta_list, seq_along(meta_list))
}

.check_metadata_files <- function(metadata, metadata_prefix, meta_files) {
  vec_meta <- paste0(metadata_prefix, metadata)
  meta_list <- lapply(meta_files, function(x) {
    list <- .add_metadata(x)
    vec_names <- names(list)
    a <- lapply(vec_meta, function(y) {
      grep(y, vec_names)
    })
    ## we would like that manage more index from grep
    found <- as.logical(length(unlist(a)))
    # if found retrieve samples that has at least one choosen metadata
    if (found) {
      x
    }
  })
}

.parse_gtf_files <- function(
  gtf_region_files, 
  regions, 
  suffixes,
  vector_field
) {
  g1 <- rtracklayer::import(con = gtf_region_files[1], format = "gtf")
  elementMetadata(g1) <- NULL
  if (is.null(suffixes)) {
    suffixes <- ""
  }
  
  # check if we used a FULL parameter instead of char array containing
  # the region parameters
  if(is.object(regions) && ("FULL" %in% class(regions))) {
    all_values <- vector_field[!vector_field %in% c(
      "seqname", 
      "strand", 
      "start",
      "end"
      )
    ]
    except_values <- regions$values
    regions <- if (is.null(except_values))
      all_values
    else
      all_values[!all_values %in% except_values]
    names(regions) <- NULL
    # since import convert this value from GMQL schema to GTF format
    # we need to convert it back
    regions <- replace(regions, regions == "feature", "type")
    regions <- replace(regions, regions == "frame", "phase")
  }
  
  if (!is.null(regions)) {
    DF_list <- mapply(function(x, header) {
      g_x <- rtracklayer::import(con = x, format = "gtf")
      meta <- elementMetadata(g_x)[regions]
      if (header != "") {
        names(meta) <- paste(regions, header, sep = ".")
      }
      data.frame(meta)
    }, gtf_region_files, suffixes, SIMPLIFY = FALSE)
    DF_only_regions <- dplyr::bind_cols(DF_list)
    elementMetadata(g1) <- DF_only_regions
  }
  g1
}

.parse_gdm_files <- function(
  vector_field,
  gdm_region_files,
  regions,
  suffixes
) {
  # read first sample cause chromosome regions are the same for all samples
  df <- data.table::fread(
    gdm_region_files[1],
    col.names = vector_field,
    header = FALSE,
    sep = "\t"
  )
  col_names <- names(df)
  df <- subset(df, TRUE, c("chr", "left", "right", "strand"))
  
  # check if we used a FULL parameter instead of char array containing
  # the region parameters
  if(is.object(regions) && ("FULL" %in% class(regions))) {
    all_values <- vector_field[!vector_field %in% c(
      "chr", 
      "left", 
      "right",
      "strand"
      )
    ]
    except_values <- regions$values
    regions <- if (is.null(except_values))
      all_values
    else
      all_values[!all_values %in% except_values]
    names(regions) <- NULL
  }
  
  if (!is.null(regions)) {
    df_list <- lapply(gdm_region_files, function(x, regions, vector_field) {
      region_frame <- data.table::fread(
        x,
        col.names = vector_field,
        header = FALSE,
        sep = "\t"
      )
      col_names <- names(region_frame)
      # delete column not choosen by input
      if (!is.null(regions)) {
        col_names <- col_names[col_names %in% regions]
      }
      
      if (length(col_names)) {
        r <- subset(region_frame, TRUE, col_names)
      }
    }, regions, vector_field)
    
    df_only_regions <- dplyr::bind_cols(df_list)
    complete_df <- dplyr::bind_cols(df, df_only_regions)
    
    region_names <- names(complete_df)[-(seq_len(4))]
    region_names <- gsub("[0-9]+", "", region_names)
    region_names <- paste(region_names, suffixes, sep = ".")
    region_names <- c(names(complete_df)[(seq_len(4))], region_names)
    names(complete_df) <- region_names
    g <- GenomicRanges::makeGRangesFromDataFrame(
      complete_df,
      keep.extra.columns = TRUE,
      start.field = "left",
      end.field = "right"
    )
  }
  else {
    g <- GenomicRanges::makeGRangesFromDataFrame(
      df,
      keep.extra.columns = TRUE,
      start.field = "left",
      end.field = "right"
    )
  }
}