# Preventing from adding following elements
#' @include layout-.R
#' @include layout-operator.R
S7::method(ggalign_update, list(QuadLayout, S7::class_data.frame)) <-
    function(x, object, objectname) {
        cli_abort(sprintf("Can't change data of %s", object_name(x)))
    }

#' @include layout-.R
#' @include layout-operator.R
S7::method(ggalign_update, list(QuadLayout, layout_title)) <-
    function(x, object, objectname) {
        x@titles <- x@titles + object
        x
    }

#' @include layout-.R
#' @include layout-operator.R
S7::method(ggalign_update, list(QuadLayout, S7::class_list)) <-
    function(x, object, objectname) {
        for (o in object) x <- ggalign_update(x, o, object_name)
        x
    }

#' @include layout-.R
#' @include layout-operator.R
S7::method(ggalign_update, list(QuadLayout, ggplot2::class_ggplot)) <-
    function(x, object, objectname) {
        ggalign_update(x, ggfree(data = object), objectname)
    }

# Add elements for the main body or the annotation
#' @include layout-.R
#' @include layout-operator.R
S7::method(ggalign_update, list(QuadLayout, S7::class_any)) <-
    function(x, object, objectname) {
        if (is.null(object)) return(x) # styler: off
        if (is.matrix(object)) {
            cli_abort(sprintf("Can't change data of %s", object_name(x)))
        }
        if (is.null(position <- x@current)) {
            x <- quad_body_add(object, x, objectname)
        } else if (is.null(stack <- prop(x, position))) {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "the {.field {position}} annotation stack is not initialized",
                i = "Try to use {.code quad_anno(initialize = TRUE)} or you can add a {.code stack_layout()} manually"
            ))
        } else {
            prop(x, position) <- ggalign_update(stack, object, objectname)
        }
        x
    }

#' @include layout-.R
#' @include layout-operator.R
#' @include layout-quad-scope.R
S7::method(ggalign_update, list(QuadLayout, quad_scope)) <-
    function(x, object, objectname) {
        old <- x@current
        contexts <- quad_scope_contexts(object, old)
        if (is.null(contexts)) contexts <- list(NULL)
        object <- prop(object, "object")
        for (active in contexts) {
            x@current <- active
            x <- ggalign_update(x, object, objectname)
        }
        x@current <- old
        x
    }

##################################################################
#' @include layout-.R
#' @include layout-operator.R
S7::method(
    ggalign_update,
    list(QuadLayout, S7::new_S3_class("quad_active"))
) <- function(x, object, objectname) {
    if (!is.null(width <- .subset2(object, "width"))) {
        x@width <- width
    }
    if (!is.null(height <- .subset2(object, "height"))) {
        x@height <- height
    }
    x@current <- NULL
    x
}

#' @include layout-.R
#' @include layout-operator.R
S7::method(
    ggalign_update,
    list(QuadLayout, S7::new_S3_class("quad_anno"))
) <- function(x, object, objectname) {
    position <- .subset2(object, "position")
    initialize <- .subset2(object, "initialize")
    stack <- prop(x, position)
    if (is.null(stack) && !isFALSE(initialize)) {
        # try to initialize the annotation stack with the layout data
        direction <- to_direction(position)
        layout_domain <- prop(x, direction)
        # for the annotation stack, we try to take the data from the
        # quad layout
        quad_data <- x@data
        data <- waiver() # use waiver() to indicate data is not initialized
        quad_matrix <- FALSE # the default value for `quad_matrix` in the stack
        if (!is_discrete_domain(layout_domain)) { # the stack need a data frame
            if (!is.data.frame(quad_data)) {
                if (is.null(initialize)) {
                    cli_warn(paste(
                        "`data` in {.fn {x@name}} is",
                        "{.obj_type_friendly {quad_data}}, but the",
                        "{.field {position}} annotation stack need a",
                        "{.cls data.frame}, won't initialize",
                        "the {.field {position}} annotation stack"
                    ))
                } else {
                    data <- NULL
                }
            } else {
                data <- quad_data
            }
        } else if (is.matrix(quad_data)) { # the stack need a matrix
            if (is_horizontal(direction)) {
                data <- quad_data
            } else {
                data <- ggalign_data_restore(t(quad_data), quad_data)
            }
            quad_matrix <- TRUE
        } else {
            if (is.null(initialize)) {
                cli_warn(paste(
                    "`data` in {.fn {x@name}} is",
                    "{.obj_type_friendly {quad_data}}, but the",
                    "{.field {position}} annotation stack need a",
                    "{.cls data.frame}, won't initialize",
                    "the {.field {position}} annotation stack"
                ))
            } else {
                data <- NULL
            }
        }
        if (!is_waiver(data)) { # initialize the annotation stack
            stack <- new_stack_layout(
                data = data,
                direction = direction,
                # the layout parameters should be the same with `quad_layout()`
                domain = layout_domain,
                # we'll inherit the action data function when
                schemes = default_schemes(if (is.null(data)) NULL else waiver())
            )
            stack@heatmap["position"] <- list(position)
            stack@heatmap["quad_matrix"] <- list(quad_matrix)
        }
    } else if (!is.null(stack) && isTRUE(initialize)) {
        cli_abort(c(
            "Cannot initialize the {position} annotation stack",
            i = "{position} annotation stack has already been initialized"
        ))
    }

    if (!is.null(stack)) {
        # update parameters
        if (!is.null(size <- .subset2(object, "size"))) {
            stack@sizes <- size
        }
        if (!is_waiver(free_guides <- .subset2(object, "free_guides"))) {
            stack@heatmap["free_guides"] <- list(free_guides)
        }
        stack <- switch_chain_plot(
            stack, .subset2(object, "what"), quote(quad_anno())
        )
        prop(x, position) <- stack
    }
    x@current <- position
    x
}

#' @include layout-.R
#' @include layout-operator.R
S7::method(
    ggalign_update,
    list(QuadLayout, QuadLayout)
) <- function(x, object, objectname) {
    cli_abort(c(
        sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
        i = "Did you mean to place multiple {.fn quad_layout} elements inside a {.fn stack_layout}?"
    ))
}

#' @include layout-.R
#' @include layout-operator.R
S7::method(ggalign_update, list(QuadLayout, StackLayout)) <-
    function(x, object, objectname) {
        # we check if there is an active annotation
        if (is.null(position <- x@current)) {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "no active annotation stack",
                i = "try to activate an annotation stack with {.fn anno_*}"
            ))
        }
        # check the annotation stack is not initialized
        if (!is.null(prop(x, position))) {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "{position} annotation stack already exists"
            ))
        }
        # cannot contain nested layout
        if (!all(vapply(object@box_list, is_craftbox, logical(1L),
                    USE.NAMES = FALSE))) { # styler: off
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "annotation stack cannot contain nested layout"
            ))
        }
        # check quad layout is compatible with stack layout
        if (!identical(direction <- to_direction(position), object@direction)) {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "only {.field {direction}} stack is allowed in {position} annotation"
            ))
        }
        if (length(object@sizes) > 1L) {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "{.arg sizes} must be of length one to use the stack as an annotation"
            ))
        }
        quad_domain <- prop(x, direction)
        if (is_cross_layout(object) &&
            any(position == c("bottom", "right")) &&
            !is_empty(object@cross_points)) {
            # if there are cross points in bottom or right annotation,
            # use the first domain
            stack_domain <- .subset2(object@odomain, 1L)
        } else {
            stack_domain <- object@domain
        }
        # check if we can align in this direction
        # `stack_layout()` is free from aligning obervations in this axis
        if (!is_discrete_domain(stack_domain)) {
            if (is_discrete_domain(quad_domain)) {
                cli_abort(c(
                    sprintf(
                        "Cannot add {.var {objectname}} to %s",
                        object_name(x)
                    ),
                    i = sprintf(
                        "%s cannot align continuous variable in {.field {direction}} direction",
                        object_name(x)
                    )
                ))
            }
            layout_domain <- stack_domain
        } else if (is_discrete_domain(quad_domain)) {
            layout_domain <- discrete_domain_update(
                quad_domain, stack_domain,
                old_name = object_name(x),
                new_name = objectname
            )
        } else {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = sprintf(
                    "%s cannot align discrete variable in {.field {direction}} direction",
                    object_name(x)
                )
            ))
        }
        object@heatmap$position <- position
        prop(x, position) <- object
        layout_update_domain(x,
            direction = direction,
            domain = layout_domain,
            objectname = objectname
        )
    }

#' @include layout-.R
#' @include layout-operator.R
S7::method(ggalign_update, list(QuadLayout, CraftBox)) <-
    function(x, object, objectname) {
        if (is.null(position <- x@current)) {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "no active annotation stack",
                i = "try to activate an annotation stack with {.fn anno_*}"
            ))
        }
        if (is.null(stack <- prop(x, position))) {
            cli_abort(c(
                sprintf("Cannot add {.var {objectname}} to %s", object_name(x)),
                i = "the {.field {position}} annotation stack is not initialized",
                i = "Try to use {.code quad_anno(initialize = TRUE)} or you can add a {.code stack_layout()} manually"
            ))
        }

        # add annotation -----------------------------
        stack <- ggalign_update(stack, object, objectname)
        prop(x, position) <- stack

        # if there are cross points in bottom or right annotation, we use
        # the first domain
        if (is_cross_layout(stack) &&
            any(position == c("bottom", "right")) &&
            !is_empty(stack@cross_points)) {
            new_domain <- .subset2(stack@odomain, 1L)
        } else {
            new_domain <- stack@domain
        }
        layout_update_domain(
            x,
            direction = to_direction(position),
            domain = new_domain,
            objectname = objectname
        )
    }

#######################################################
# used to add elements for main body
#' @keywords internal
quad_body_add <- function(object, quad, objectname) {
    UseMethod("quad_body_add")
}

#' @importFrom ggplot2 update_ggplot
#' @export
quad_body_add.default <- function(object, quad, objectname) {
    quad@plot <- update_ggplot(
        object,
        ggfun("plot_clone")(quad@plot),
        objectname
    )
    quad
}

#' @export
quad_body_add.Coord <- function(object, quad, objectname) {
    if (!inherits(object, "CoordCartesian")) {
        cli_warn(c(
            "only {.field cartesian coordinate} is supported",
            i = "will discard {.var {objectname}} directly"
        ))
        return(quad)
    }
    NextMethod() # call default method
}

#' @export
`quad_body_add.ggalign::layout_theme` <- function(object, quad, objectname) {
    prop(quad, "theme") <- prop(quad, "theme") + prop(object, "theme")
    quad
}

#' @export
`quad_body_add.ggalign::Scheme` <- function(object, quad, objectname) {
    quad@body_schemes <- ggalign_update(quad@body_schemes, object, objectname)
    quad
}


##############################################################
# `subtract` operates at layout-level
#' @include layout-.R
#' @include layout-operator.R
S7::method(layout_apply_selected, list(QuadLayout, S7::class_any)) <-
    function(x, object, ...) {
        if (is.null(context <- x@current)) context <- c(.TLBR, list(NULL))
        for (active in context) {
            if (is.null(active)) {
                x <- quad_body_add(object, x, ...)
            } else if (!is.null(prop(x, active))) {
                prop(x, active) <- layout_apply_selected(
                    prop(x, active), object, ...
                )
            }
        }
        x
    }

# for object can set at layout level
#' @include layout-.R
#' @include layout-operator.R
S7::method(layout_apply_selected, list(QuadLayout, Scheme)) <-
    function(x, object, ...) {
        if (is.null(context <- x@current)) {
            prop(x, "schemes") <- ggalign_update(
                prop(x, "schemes"), object, ...
            )
        } else {
            prop(x, context) <- layout_apply_selected(
                prop(x, context), object, ...
            )
        }
        x
    }

#' @include layout-.R
#' @include layout-operator.R
S7::method(layout_apply_selected, list(QuadLayout, quad_scope)) <-
    function(x, object, ...) {
        inner <- prop(object, "object")
        contexts <- quad_scope_contexts(object, x@current)
        # `subtract` operates at layout-level
        if (is.null(contexts)) {
            x <- layout_apply_selected(x, inner, ...)
        } else {
            for (active in contexts) {
                if (is.null(active)) {
                    x <- quad_body_add(inner, x, ...)
                } else if (!is.null(prop(x, active))) {
                    prop(x, active) <- layout_apply_selected(
                        prop(x, active), inner, ...
                    )
                }
            }
        }
        x
    }

###############################################################
#' @include layout-.R
#' @include layout-operator.R
#' @include layout-quad-scope.R
S7::method(layout_apply_all, list(QuadLayout, quad_scope)) <-
    function(x, object, ...) {
        layout_apply_all(x, prop(object, "object"), ...)
    }

quad_apply_all <- function(x, object, ...) {
    x <- quad_body_add(object, x, ...)
    for (position in .TLBR) {
        stack <- prop(x, position)
        if (is.null(stack)) next # no annotation
        prop(x, position) <- layout_apply_all(stack, object, ...)
    }
    x
}

#' @include layout-.R
#' @include layout-operator.R
S7::method(layout_apply_all, list(QuadLayout, S7::class_any)) <- quad_apply_all

#' @include layout-.R
#' @include layout-operator.R
S7::method(layout_apply_all, list(QuadLayout, ggplot2::class_theme)) <-
    function(x, object, ...) {
        ans <- quad_apply_all(x, object, ...)
        # to align with `patchwork`, we also modify the layout theme
        # when using `&` to add the theme object.
        ans@theme <- ggfun("add_theme")(ans@theme, object)
        ans
    }
