#' Create the server logic for the ped_shiny application
#' @include app_health_sel.R
#' @include app_family_sel.R
#' @include app_inf_sel.R
#' @include app_ped_avaf_infos.R
#' @include app_data_import.R
#' @include app_data_col_sel.R
#' @include app_data_download.R
#' @include app_utils.R
#' @include app_plot_all.R
#' @importFrom utils data
#' @importFrom shiny shinyServer req observeEvent reactive stopApp
#' @importFrom shiny exportTestValues stopApp
#' @importFrom shinytoastr toastr_warning toastr_error
#' @importFrom shinyhelper observe_helpers helper
#' @param input The input object from a Shiny app.
#' @param output The output object from a Shiny app.
#' @param session The session object from a Shiny app.
#' @param precision Number of decimal for the position of the boxes
#' in the plot.
#' @inheritParams plot_all_server
#' @returns `shiny::shinyServer()`
#' @examples
#' if (interactive()) {
#'     ped_shiny()
#' }
#' @export
ped_server <- function(
    input, output, session, precision = 6,
    ind_max_warning = 300, ind_max_error = 500
) {
    shiny::shinyServer(function(input, output, session) {

        height_family_infos <- "auto"

        data_env <- new.env(parent = emptyenv())
        utils::data("sampleped", envir = data_env, package = "Pedixplorer")
        utils::data("relped", envir = data_env, package = "Pedixplorer")

        ## Helper observers for the help buttons -------------------------------
        shinyhelper::observe_helpers(
            withMathJax = TRUE,
            help_dir = system.file("helpfiles", package = "Pedixplorer")
        )

        output$help_main <- shiny::renderUI({
            shiny::tags$div() |>
                shinyhelper::helper(
                    type = "markdown",
                    content = "app_help_main",
                    size = "l",
                    colour = "#3792ad",
                    style = "font-size: 1.5em;"
                )
        })

        ## Ped data import ----------------------------------------------------
        ped_df <- data_import_server(
            id = "data_ped_import",
            label = "Select pedigree file :",
            help_type = "markdown",
            help_data = "app_pedigree_data",
            help_test_data = "app_pedigree_testdata",
            dftest = data_env[["sampleped"]],
            help_colour = "#8aca25"
        )
        ped_df_rename <- data_col_sel_server(
            id = "data_ped_col_sel", df = ped_df,
            help_type = "markdown",
            col_config = list(
                "id" = list(
                    alternate = c("indid"), mandatory = TRUE,
                    help = "app_pedigree_id"
                ),
                "dadid" = list(
                    alternate = c("fatherid"), mandatory = TRUE,
                    help = "app_pedigree_dadid"
                ),
                "momid" = list(
                    alternate = c("motherid"), mandatory = TRUE,
                    help = "app_pedigree_momid"
                ),
                "sex" = list(
                    alternate = c("gender"), mandatory = TRUE,
                    help = "app_pedigree_sex"
                ),
                "famid" = list(
                    alternate = c("family"), mandatory = FALSE,
                    help = "app_pedigree_famid"
                ),
                "fertility" = list(
                    alternate = c("steril", "sterilization"), mandatory = FALSE,
                    help = "app_pedigree_fertility"
                ),
                "miscarriage" = list(
                    alternate = c("aborted"), mandatory = FALSE,
                    help = "app_pedigree_miscarriage"
                ),
                "deceased" = list(
                    alternate = c("status", "vitalstatus", "death"),
                    mandatory = FALSE,
                    help = "app_pedigree_deceased"
                ),
                "avail" = list(
                    alternate = c("available"), mandatory = FALSE,
                    help = "app_pedigree_avail"
                ),
                "evaluated" = list(
                    alternate = c("eval"), mandatory = FALSE,
                    help = "app_pedigree_evaluated"
                ),
                "consultand" = list(
                    alternate = c(NA_character_), mandatory = FALSE,
                    help = "app_pedigree_consultand"
                ),
                "proband" = list(
                    alternate = c(NA_character_), mandatory = FALSE,
                    help = "app_pedigree_proband"
                ),
                "carrier" = list(
                    alternate = c(NA_character_), mandatory = FALSE,
                    help = "app_pedigree_carrier"
                ),
                "asymptomatic" = list(
                    alternate = c("presymptomatic"), mandatory = FALSE,
                    help = "app_pedigree_asymptomatic"
                ),
                "adopted" = list(
                    alternate = c("adoption"), mandatory = FALSE,
                    help = "app_pedigree_adopted"
                ),
                "dateofbirth" = list(
                    alternate = c("dob", "birth"), mandatory = FALSE,
                    help = "app_pedigree_dateofbirth"
                ),
                "dateofdeath" = list(
                    alternate = c("dod"), mandatory = FALSE,
                    help = "app_pedigree_dateofdeath"
                )
            ),
            title = "Select columns :", na_omit = TRUE,
            ui_col_nb = 3, by_row = FALSE,
            help_style = "margin-top:0.5em;",
            help_colour = "#3792ad"
        )
        ## Rel data import ----------------------------------------------------
        rel_df <- data_import_server(
            id = "data_rel_import",
            label = "Select relationship file :",
            help_type = "markdown",
            help_data = "app_rel_data",
            help_test_data = "app_rel_testdata",
            dftest = data_env[["relped"]],
            help_colour = "#8aca25"
        )
        rel_df_rename <- data_col_sel_server(
            id = "data_rel_col_sel", df = rel_df,
            help_type = "markdown",
            col_config = list(
                "id1" = list(
                    alternate = c("indId1"), mandatory = TRUE,
                    help = "app_rel_id1"
                ),
                "id2" = list(
                    alternate = c("indId2"), mandatory = TRUE,
                    help = "app_rel_id2"
                ),
                "code" = list(
                    alternate = c(NA_character_), mandatory = TRUE,
                    help = "app_rel_code"
                ),
                "famid" = list(
                    alternate = c("family"), mandatory = FALSE,
                    help = "app_rel_famid"
                )
            ),
            title = "Select columns :", na_omit = TRUE,
            ui_col_nb = 1, by_row = FALSE,
            help_style = "margin-top:0.5em",
            help_colour = "#3792ad"
        )

        ## Ped families object creation ---------------------------------------
        ped_df_norm <- shiny::reactive({
            shiny::req(ped_df_rename())
            if (is.null(ped_df_rename())) {
                return(NULL)
            }
            ped_df <- ped_df_rename()
            if (!"famid" %in% colnames(ped_df_rename())) {
                ped_df$famid <- make_famid(
                    as.character(ped_df$id),
                    as.character(ped_df$dadid),
                    as.character(ped_df$momid)
                )
            }
            withCallingHandlers({
                norm_ped(
                    ped_df, cols_used_del = FALSE, na_strings = c(NA, "", "NA")
                )
            }, warning = function(w) {
                shinytoastr::toastr_warning(
                    title = "Warnings during pedigree normalization",
                    conditionMessage(w)
                )
                invokeRestart("muffleWarning")
            })
        })
        rel_df_norm <- shiny::reactive({
            if (is.null(rel_df_rename())) {
                return(NULL)
            }
            norm_rel(rel_df_rename())
        })

        ped_all <- shiny::reactive({
            shiny::req(ped_df_norm())
            ped_df <- ped_df_norm()
            if (any(!is.na(ped_df_norm()$error))) {
                shinytoastr::toastr_warning(
                    title = "Errors are present in the data given.",
                    paste(
                        "Please check the data and try again.",
                        "Only the data without errors will be used."
                    )
                )
                ped_df <- ped_df_norm()[is.na(ped_df_norm()$error), ]
            }
            tryCatch({
                withCallingHandlers({
                    ped_df <- fix_parents(ped_df)
                    Pedigree(
                        ped_df, rel_df_norm(),
                        cols_ren_ped = list("affection" = "affected"),
                        cols_ren_rel = list(),
                        normalize = FALSE
                    )
                }, warning = function(w) {
                    shinytoastr::toastr_warning(
                        title = "Warnings during pedigree creation",
                        conditionMessage(w)
                    )
                    invokeRestart("muffleWarning")
                })
            }, error = function(e) {
                shinytoastr::toastr_error(
                    title = "Error during pedigree creation",
                    conditionMessage(e)
                )
                NULL
            })
        })

        ## Errors download ----------------------------------------------------
        shiny::observeEvent(ped_df_norm(), {
            data_download_server("ped_norm_errors",
                shiny::reactive({
                    ped_df_norm()[!is.na(ped_df_norm()$error), ]
                }), "Pedigree data errors", title = "Pedigree data errors"
            )
        })

        shiny::observeEvent(rel_df_norm(), {
            data_download_server("rel_norm_errors",
                shiny::reactive({
                    rel_df_norm()[!is.na(rel_df_norm()$error), ]
                }), "Relationship data errors",
                title = "Relationship data errors"
            )
        })
        output$ped_errors <- renderUI({
            shiny::req(ped_df_norm()[!is.na(ped_df_norm()$error), ])
            data_download_ui(id = "ped_norm_errors")
        })
        output$rel_errors <- renderUI({
            shiny::req(rel_df_norm()[!is.na(rel_df_norm()$error), ])
            data_download_ui(id = "rel_norm_errors")
        })

        output$download_errors <- renderUI({
            shiny::req(ped_df_norm())
            if (nrow(ped_df_norm()[!is.na(ped_df_norm()$error), ]) == 0) {
                if (is.null(rel_df_norm())) {
                    return(NULL)
                } else if (
                    nrow(rel_df_norm()[!is.na(rel_df_norm()$error), ]) == 0
                ) {
                    return(NULL)
                }
            }
            fluidRow(
                h3("Download errors"),
                column(6, align = "center",
                    uiOutput("ped_errors")
                ),
                column(6, align = "center",
                    uiOutput("rel_errors")
                )
            )
        })

        ## Health selection ---------------------------------------------------
        lst_health <- health_sel_server(
            "health_sel", ped_all, var = "affection"
        )

        ## Generate colors creation -------------------------------------------
        output$health_full_scale_box <- renderUI({
            checkboxInput(
                "health_full_scale",
                label = "Full scale color",
                value = FALSE
            ) |> shinyhelper::helper(
                type = "markdown",
                content = "app_full_scale_color",
                size = "m",
                colour = "#3792ad"
            )
        })

        cols_aff <- color_picker_server("col_aff",
            list(
                "Least_Affected" = "#ecbd00",
                "Affected" = "#c40000"
            )
        )

        cols_unaff <- color_picker_server("col_unaff",
            list(
                "Unaffected" = "white",
                "Dubious" = "#3792ad"
            )
        )

        cols_avail <- color_picker_server("col_avail",
            list("Avail" = "#8aca25", "Unavail" = "black")
        )

        ## Families selection -------------------------------------------------
        lst_fam <- family_sel_server(
            "family_sel", ped_all, "family", 1,
            help_type = "markdown",
            help_text = "app_family_selection",
            help_colour = "#3792ad",
            help_title = ""
        )

        ## Pedigree affected --------------------------------------------------
        ped_aff <- shiny::reactive({
            shiny::req(lst_fam())
            shiny::req(lst_health())
            if (is.null(lst_fam()) |
                    is.null(lst_health()) |
                    is.null(input$health_full_scale)
            ) {
                return(NULL)
            }
            if (lst_health()$as_num &
                    is.null(lst_health()$threshold)
            ) {
                return(NULL)
            }
            tryCatch({
                withCallingHandlers({
                    generate_colors(
                        lst_fam()$ped_fam, col_aff = lst_health()$var,
                        add_to_scale = FALSE, mods_aff = lst_health()$mods_aff,
                        threshold = lst_health()$threshold,
                        is_num = lst_health()$as_num,
                        sup_thres_aff = lst_health()$sup_threshold,
                        keep_full_scale = input$health_full_scale,
                        colors_aff = unname(unlist(
                            cols_aff()[c("Least_Affected", "Affected")]
                        )),
                        colors_unaff = unname(unlist(
                            cols_unaff()[c("Unaffected", "Dubious")]
                        )),
                        colors_na = "grey",
                        colors_avail = unname(unlist(
                            cols_avail()[c("Avail", "Unavail")]
                        )),
                        breaks = 3
                    )
                }, warning = function(w) {
                    shinytoastr::toastr_warning(
                        title = "Warnings during pedigree affection generation",
                        conditionMessage(w)
                    )
                    invokeRestart("muffleWarning")
                })
            }, error = function(e) {
                shinytoastr::toastr_error(
                    title = "Error during pedigree affection generation",
                    conditionMessage(e)
                )
                NULL
            })
        })

        ## Family information -------------------------------------------------
        ped_avaf_infos_server(
            "ped_avaf_infos", pedi = ped_aff,
            title = "Family informations",
            height = height_family_infos
        )

        ## Informative selection ----------------------------------------------
        lst_inf <- inf_sel_server("inf_sel", ped_all)

        ## Subfamily selection ------------------------------------------------
        ped_subfamilies <- shiny::reactive({
            shiny::req(lst_inf())
            shiny::req(ped_aff())
            pedi_inf <- is_informative(
                ped_aff(),
                informative = lst_inf()$inf_sel,
                col_aff = lst_health()$var
            )
            pedi_inf <- useful_inds(
                pedi_inf, keep_infos = lst_inf()$keep_parents,
                max_dist = lst_inf()$kin_max, reset = TRUE
            )
            pedi_inf <- Pedixplorer::subset(
                pedi_inf, useful(ped(pedi_inf)),
                del_parents = "both"
            )
            make_famid(pedi_inf)
        })

        lst_subfam <- family_sel_server(
            "subfamily_sel", ped_subfamilies,
            fam_var = "family", fam_sel = 1, title = "Subfamily selection",
            help_type = "markdown",
            help_text = "app_subfamily_selection",
            help_colour = "#3792ad",
            help_title = ""
        )

        ## Update based on update button -------------------------------------
        ped_subfam <- shiny::reactive({
            shiny::req(lst_subfam())
            if (is.null(lst_subfam())) {
                return(NULL)
            }
            lst_subfam()$ped_fam
        })

        ## Sub Family information ---------------------------------------------
        ped_avaf_infos_server(
            "subped_avaf_infos", pedi = ped_subfam,
            title = "Subfamily informations",
            height = height_family_infos
        )

        ## Plotting pedigree --------------------------------------------------
        cust_title <- function(short) {
            shiny::reactive({
                shiny::req(lst_fam())
                shiny::req(lst_subfam())
                shiny::req(lst_inf())
                get_title(
                    family_sel = lst_fam()$famid,
                    subfamily_sel = lst_subfam()$famid,
                    inf_selected = lst_inf()$inf_sel,
                    kin_max = lst_inf()$kin_max,
                    keep_parents = lst_inf()$keep_parents,
                    nb_rows = length(lst_subfam()$ped_fam), short_title = short
                )
            })
        }

        my_title_l <- shiny::reactive({
            shiny::req(ped_subfam())
            if (length(ped(ped_subfam())) < 1) {
                NULL
            } else {
                cust_title(FALSE)()
            }
        }) |>
            shiny::bindEvent(lst_fam(), lst_subfam(), lst_inf())

        my_title_s <- shiny::reactive({
            shiny::req(ped_subfam())
            if (length(ped(ped_subfam())) < 1) {
                NULL
            } else {
                cust_title(TRUE)()
            }
        }) |>
            shiny::bindEvent(lst_fam(), lst_subfam(), lst_inf())

        ### Tips column selection --------------------------------------------
        lst_plot <- plot_all_server(
            "all_plot_ped", ped_subfam,
            ind_max_error = ind_max_error,
            ind_max_warning = ind_max_warning,
            my_title_l = my_title_l,
            my_title_s = my_title_s,
            precision = precision,
            init_width = "90%"
        )

        ## Test values --------------------------------------------------------
        shiny::exportTestValues(
            peddf = lst_plot()$df
        )

        ## End ----------------------------------------------------------------
        if (!interactive()) {
            session$onSessionEnded(function() {
                shiny::stopApp()
                q("no")
            })
        }
    })
}
