#' Weave an AnansiWeb
#' @name weaveWeb-methods
#' @rdname weaveWeb-methods
#' @aliases weaveWeb.character weaveWeb.formula weaveWeb.MultiAssayExperiment
#' @aliases weaveWeb.TreeSumarizedExperiment weaveWeb.SingleCellExperiment
#' @seealso \itemize{
#'     \item [AnansiWeb]: For general constructor and methods.
#'     \item [kegg_link()]: For examples of input for link argument.
#' }
#'
#' @returns an `AnansiWeb` object, with sparse binary biadjacency matrix
#' with features from `y` as rows and features from `x` as columns in
#' `dictionary` slot.
#' @description
#' Generate a biadjacency matrix, linking the features between two tables.
#' Return an `AnansiWeb` object which contains all three.
#'
#' `weaveWeb()` is for general use and has flexible default settings.
#'
#' `weaveKEGG()` is a wrapper that sets `link` to `kegg_link()`.
#' All variants are special cases of `weaveWeb()`.
#' @examples
#' # Setup demo tables, see first vignette.
#' data(FMT_data)
#'
#' t1 <- t(FMT_metab)
#' t2 <- t(FMT_KOs)
#'
#' # Input objects and syntax:
#' ## define `x` and `y` as characters
#' web <- weaveWeb(
#'     x = "ko", y = "cpd", link = kegg_link(),
#'     tableX = t2, tableY = t1,
#'     metadata = NULL, verbose = TRUE
#' )
#'
#' ## define `x` and `y` with a formula
#' web2 <- weaveWeb(
#'     x = cpd ~ ko, link = kegg_link(),
#'     tableX = t2, tableY = t1,
#'     metadata = NULL, verbose = TRUE
#' )
#'
#' identical(web, web2)
#'
#' # Method for MultiAssayExperiment S4 object
#' mae <- asMAE(web)
#' weaveWeb(
#'     x = mae, link = kegg_link(),
#'     tableY = "cpd", tableX = "ko",
#'     force_new = FALSE
#' )
#'
#' # Method for TreeSummarizedExperiment S4 object
#' tse <- asTSE(web)
#' weaveWeb(
#'     x = tse, link = kegg_link(),
#'     tableY = "cpd", tableX = "ko",
#'     force_new = FALSE
#' )
#'
#' @param x,y `Character scalar`, names of feature types that should be
#'     linked. Should be found in the column names of `link`.
#' @param link One of the following:
#'     \itemize{
#'         \item `Character scalar` with value `"none"`.
#'         \item `data.frame` with two columns
#'         \item `list` with two such `data.frame`s.
#'         }
#' @param tableY,tableX A table containing features of interest. Rows should be
#'     samples and columns should be features. Y and X refer to the position of
#'     the features in a formula: Y ~ X. \cr
#'     < For Bioconductor S4 objects > \cr
#'     `Character scalar` or `numeric scalar`. Selects experiment
#'     corresponding to `tableY` and `tableX` from `experiments(x)` of
#'     `MultiAssayExperiment` object by name or index, name is recommended.
#'     (Default slots: `Y = 1L`, `X = 2L`).
#' @param metadata Optional `data.frame` of sample metadata, to be included with
#'     output. Can be accessed from `AnansiWeb` generated by `weaveWeb()` with
#'     `output@metadata`.
#' @details
#' If the `link` argument is `"none"`, all features will be considered
#' linked. If one or more `data.frame`s, colnames should be as specified in
#' `x` and `y`.
#' @param verbose `Logical scalar`. Whether to print diagnostic information
#'     (Default: `TRUE`).#' @param force_new `boolean` If x already has a
#'     dictionary `Matrix` in metadata, ignore it and generate a new object
#'     anyway? (Default: FALSE).
#' @param typeY,typeX
#' `Character scalar` or `numeric scalar`. Selects assay from experiments to
#' `tableY` and `tableX` from `experiments(x)`. (Default: `1L` - the first assay
#'  in that experiment).
#' @param experiment1,experiment2 synonymous args to `tableY,tableX` for
#'     compatibility with `mia` argument style.
#' @param assay.type1,assay.type2 synonymous args to `typeY,typeX` for
#'     compatibility with `mia` argument style.
#'
NULL

#' @rdname weaveWeb-generic
#' @name weaveKEGG
#' @export
#'
weaveKEGG <- function(x, ...) weaveWeb(x, link = kegg_link(), ...)

#' @export
S7::method(weaveWeb, S7::class_character) <- function(x, y,
    link = NULL,
    tableX = NULL,
    tableY = NULL,
    metadata = NULL,
    verbose = TRUE) {
    weaveWeb.character(x, y, link, tableX, tableY, metadata, verbose)
}

weaveWeb.character <- function(x, y,
    link = NULL,
    tableX = NULL,
    tableY = NULL,
    metadata = NULL,
    verbose = TRUE) {
    terms <- c(y, x)
    stopifnot(
        "both 'x' and 'y' terms must be provided as character" =
            is(terms, "character") && length(terms) == 2L
    )
    if (is.null(link)) {
        stop(
            "'link' argument not provided. To explicitly disable ",
            "knowledge-based selection, use link = 'none' instead. "
        )
    }
    if (identical(link, "none")) {
        return(web_missing_link(tableX, tableY, terms))
    }

    # Ensure link is a MultiFactor
    link <- MultiFactor(link, drop.unmatched = TRUE)
    # Determine required ids in order, only keep relevant elements of link.
    all_terms <- termSeq(x, y, link)
    link <- subsetByPath(link, all_terms)

    # Trim link levels and tables based on feature overlap
    if (!is.null(tableX)) {
        keep <- sort(intersect(colnames(tableX), levels(link)[[x]]))
        if (verbose && length(keep) < NCOL(tableX)) {
            message("Dropped features in tableX: ", length(keep), " remain. ")
        }
        tableX <- tableX[, keep]
        link <- trimByInput(link, tableX, x)
    }
    if (!is.null(tableY)) {
        keep <- sort(intersect(colnames(tableY), levels(link)[[y]]))
        if (verbose && length(keep) < NCOL(tableY)) {
            message("Dropped features in tableY: ", length(keep), " remain. ")
        }
        tableY <- tableY[, keep]
        link <- trimByInput(link, tableY, y)
    }
    # Construct dictionary
    d <- dictionaryMatrix(link, all_terms)
    dimnames(d) <- list(y = colnames(tableY), x = colnames(tableX))
    names(dimnames(d)) <- c(y, x)

    # Dummy tables if missing
    if (is.null(tableX) && is.null(tableY)) {
        dimnames(d) <- levels(link)[terms]
        tableY <- matrix(ncol = NROW(d), dimnames = list(NULL, rownames(d)))
        tableX <- matrix(ncol = NCOL(d), dimnames = list(NULL, colnames(d)))
    }
    # Create web
    AnansiWeb(
        tableY = as.matrix(tableY)[, rownames(d), drop = FALSE],
        tableX = as.matrix(tableX)[, colnames(d), drop = FALSE],
        dictionary = d,
        metadata = metadata
    )
}

#' @export
S7::method(weaveWeb, S7::class_formula) <- function(x,
    link = NULL,
    tableX = NULL,
    tableY = NULL,
    metadata = NULL,
    verbose = TRUE) {
    weaveWeb.formula(x, link, tableX, tableY, metadata, verbose)
}

weaveWeb.formula <- function(x,
    link = NULL,
    tableX = NULL,
    tableY = NULL,
    metadata = NULL,
    verbose = TRUE) {
    if (missing(x) || (length(x) != 3L)) {
        stop("'formula' missing or incorrect")
    }

    terms <- all.vars(x)
    if (is.null(link) || identical(link, "none")) {
        return(
            weaveWeb(
                x = terms[2],
                y = terms[1],
                link,
                tableX,
                tableY,
                metadata,
                verbose
            )
        )
    }

    link <- MultiFactor(link, drop.unmatched = TRUE)

    if (sum(terms %in% colnames(link)) != 2L) {
        stop("Variables from 'formula' not found in 'link'.")
    }

    weaveWeb(
        x = terms[2],
        y = terms[1],
        link,
        tableX,
        tableY,
        metadata,
        verbose
    )
}

#' @importFrom SummarizedExperiment colData assay assayNames
#' @importFrom MultiAssayExperiment MultiAssayExperiment experiments
#' @importFrom methods getClass
#' @export
#'
S7::method(
    weaveWeb,
    methods::getClass("MultiAssayExperiment", where = "MultiAssayExperiment")
) <- function(x,
    link = NULL,
    tableY = NULL,
    tableX = NULL,
    typeY = NULL,
    typeX = NULL,
    force_new = FALSE,
    experiment1 = NULL,
    experiment2 = NULL,
    assay.type1 = NULL,
    assay.type2 = NULL) {
    weaveWeb.MultiAssayExperiment(
        x, link, tableY, tableX, typeY, typeX, force_new,
        experiment1, experiment2, assay.type1, assay.type2
    )
}

weaveWeb.MultiAssayExperiment <- function(x,
    link = NULL,
    tableY = NULL,
    tableX = NULL,
    typeY = NULL,
    typeX = NULL,
    force_new = FALSE,
    experiment1 = NULL,
    experiment2 = NULL,
    assay.type1 = NULL,
    assay.type2 = NULL) {
    y_ids <- .test_coherent(tableY, experiment1, typeY, assay.type1)
    x_ids <- .test_coherent(tableX, experiment2, typeX, assay.type2)
    tableY <- y_ids[[1L]]
    tableX <- x_ids[[1L]]

    # Check experiments
    .test_mae_has_exp(x, tableY)
    .test_mae_has_exp(x, tableX)

    # Extract assays
    tY <- t(assay(experiments(x)[tableY], y_ids[[2L]]))
    tX <- t(assay(experiments(x)[tableX], x_ids[[2L]]))

    # Check if x already contains a dictionary
    if (!force_new) {
        m <- x@metadata

        d <- if (is.null(link)) {
            "dictionary"
        } else {
            ""
        }
        if (.check_valid_selection(link, m)) {
            d <- link
        }
        if (d %in% names(m)) {
            return(AnansiWeb(
                tableX = tX,
                tableY = tY,
                dictionary = m[[d]],
                metadata = as.data.frame(colData(x))
            ))
        }
    }
    # Else, generate web object
    weaveWeb(
        x = tableX,
        y = tableY,
        link = link,
        tableX = tX,
        tableY = tY,
        metadata = as.data.frame(colData(x))
    )
}

#' @export
#' @importClassesFrom SingleCellExperiment SingleCellExperiment
#' @importFrom SummarizedExperiment colData assay assayNames
#' @importFrom SingleCellExperiment SingleCellExperiment altExp altExpNames
#' @importClassesFrom TreeSummarizedExperiment TreeSummarizedExperiment
#' @method weaveWeb SingleCellExperiment
S7::method(
    weaveWeb,
    methods::getClass(
        "SingleCellExperiment",
        where = "SingleCellExperiment"
    ) |
        methods::getClass(
            "TreeSummarizedExperiment",
            where = "TreeSummarizedExperiment"
        )
) <- function(x,
    link = NULL,
    tableY = NULL,
    tableX = NULL,
    typeY = NULL,
    typeX = NULL,
    force_new = FALSE,
    experiment1 = NULL,
    experiment2 = NULL,
    assay.type1 = NULL,
    assay.type2 = NULL) {
    weaveWeb.SingleCellExperiment(
        x, link, tableY, tableX, typeY, typeX, force_new,
        experiment1, experiment2, assay.type1, assay.type2
    )
}

weaveWeb.SingleCellExperiment <- function(x,
    link = NULL,
    tableY = NULL,
    tableX = NULL,
    typeY = NULL,
    typeX = NULL,
    force_new = FALSE,
    experiment1 = NULL,
    experiment2 = NULL,
    assay.type1 = NULL,
    assay.type2 = NULL) {
    y_ids <- .test_coherent(tableY, experiment1, typeY, assay.type1)
    x_ids <- .test_coherent(tableX, experiment2, typeX, assay.type2)
    tableY <- y_ids[[1L]]
    tableX <- x_ids[[1L]]


    tse_list <- .get_table_from_tse(x, tableY, tableX)


    # Extract assays
    tY <- t(assay(tse_list[[1L]], y_ids[[2L]]))
    tX <- t(assay(tse_list[[2L]], x_ids[[2L]]))

    # Check if x already contains a dictionary
    if (!force_new) {
        m <- x@metadata

        d <- if (is.null(link)) {
            "dictionary"
        } else {
            ""
        }
        if (.check_valid_selection(link, m)) {
            d <- link
        }
        if (d %in% names(m)) {
            return(AnansiWeb(
                tableX = tX,
                tableY = tY,
                dictionary = m[[d]],
                metadata = as.data.frame(colData(x))
            ))
        }
    }
    # Generate web object
    weaveWeb(
        x = names(tse_list)[2L],
        y = names(tse_list)[1L],
        link = link,
        tableX = tX,
        tableY = tY,
        metadata = as.data.frame(colData(x))
    )
}
