api_conf.R

#' @title Set configuration parameters
#' @name .conf_set_options
#' @noRd
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @param processing_bloat       Estimated growth size of R memory relative
#'                               to block size.
#' @param rstac_pagination_limit Limit of number of items returned by STAC.
#' @param gdal_creation_options  GDAL creation options for GeoTiff.
#' @param gdalcubes_chunk_size   Chunk size to be used by gdalcubes
#' @param sources                Data sources
#' @param colors                 Color values
#' @param ...                    Other configuration params
.conf_set_options <- function(processing_bloat = NULL,
                              rstac_pagination_limit = NULL,
                              gdal_creation_options = NULL,
                              gdalcubes_chunk_size = NULL,
                              sources = NULL,
                              colors = NULL, ...) {
    # set caller to show in errors
    .check_set_caller(".conf_set_options")
    # initialize config
    if (!exists("config", envir = sits_env))
        sits_env[["config"]] <- list()
    # process processing_bloat
    if (!is.null(processing_bloat)) {
        .check_int_parameter(processing_bloat,
            min = 1, len_min = 1, len_max = 1, max = 10
        )
        sits_env[["config"]][["processing_bloat"]] <- processing_bloat
    }
    # process rstac_pagination_limit
    if (!is.null(rstac_pagination_limit)) {
        .check_int_parameter(rstac_pagination_limit,
            min = 1, len_min = 1, len_max = 1, max = 500
        )
        sits_env[["config"]][["rstac_pagination_limit"]] <- rstac_pagination_limit
    }
    # process gdal_creation_options
    if (!is.null(gdal_creation_options)) {
        .check_chr(gdal_creation_options,
            allow_empty = FALSE,
            regex = "^.+=.+$",
            msg = .conf("messages", ".conf_set_options_gdal_creation")
        )
        sits_env$config[["gdal_creation_options"]] <- gdal_creation_options
    }
    # process gdalcubes_chunk_size
    if (!is.null(gdalcubes_chunk_size)) {
        .check_num_parameter(gdalcubes_chunk_size,
            len_min = 3,
            len_max = 3,
            is_named = FALSE
        )
        sits_env[["config"]][["gdalcubes_chunk_size"]] <- gdalcubes_chunk_size
    }
    # process sources
    if (!is.null(sources)) {
        .check_lst_parameter(sources, len_min = 1)
        # source names are uppercase
        names(sources) <- toupper(names(sources))
        # check each source
        sources <- lapply(sources, function(source) {
            # pre-condition
            .check_lst_parameter(source, len_min = 2)

            # check that source contains essential parameters
            .check_chr_contains(names(source),
                contains = c("s3_class", "collections")
            )
            names(source) <- tolower(names(source))
            # check source
            source <- .check_error(
                {
                    do.call(.conf_new_source, args = source)
                },
                msg = .conf("messages", ".conf_set_options_source")
            )
            return(source)
        })

        # initialize sources
        if (is.null(sits_env[["config"]][["sources"]])) {
            sits_env[["config"]][["sources"]] <- sources
        }

        sits_env[["config"]][["sources"]] <- utils::modifyList(
            sits_env[["config"]][["sources"]],
            sources,
            keep.null = FALSE
        )
    }
    # check and initialize palettes
    if (.has(colors)) {
        # initialize colors
        if (is.null(sits_env[["config"]][["colors"]])) {
            sits_env[["config"]][["colors"]] <- colors
        }
        # add colors
        sits_env[["config"]][["colors"]] <- utils::modifyList(
            sits_env[["config"]][["colors"]],
            colors,
            keep.null = FALSE
        )
    }
    # process extra parameters
    dots <- list(...)
    .check_lst(dots)

    if (length(dots) > 0) {
        sits_env[["config"]] <- utils::modifyList(
            sits_env[["config"]],
            dots,
            keep.null = FALSE
        )
    }
    return(invisible(sits_env[["config"]]))
}
#' @title Return the default configuration file
#' @name .conf_file
#' @keywords internal
#' @noRd
#' @return default configuration file
#'
.conf_file <- function() {
    .check_set_caller(".conf_file")
    # load the default configuration file
    yml_file <- system.file("extdata", "config.yml", package = "sits")

    # check that the file name is valid
    .check_file(yml_file)

    return(yml_file)
}
#' @title Return the internal configuration file (only for developers)
#' @name .conf_internals_file
#' @keywords internal
#' @noRd
#' @return default internal configuration file
.conf_internals_file <- function() {
    .check_set_caller(".conf_internals_file")
    # load the default configuration file
    yml_file <- system.file("extdata", "config_internals.yml", package = "sits")
    # check that the file name is valid
    .check_that(file.exists(yml_file))
    return(yml_file)
}
#' @title Return the user-relevant configuration file
#' @name .config_file
#' @keywords internal
#' @noRd
#' @return default user-relevant configuration file
.config_file <- function() {
    .check_set_caller(".config_file")
    # load the default configuration file
    yml_file <- system.file("extdata", "config.yml", package = "sits")
    # check that the file name is valid
    .check_that(file.exists(yml_file))
    return(yml_file)
}
#' @title Return the message configuration files (only for developers)
#' @name .conf_sources_files
#' @keywords internal
#' @noRd
#' @return internal sources configuration
.conf_sources_files <- function() {
    .check_set_caller(".conf_sources_files")
    # list the source files configurations
    package_files <- system.file("extdata", "sources", package = "sits")
    yml_files <- list.files(
        path = package_files,
        pattern = "config_source_*",
        full.names = TRUE
    )
    # check that the file name is valid
    purrr::map(yml_files, .check_file)
    return(yml_files)
}
#' @name .conf_load_sources
#' @description Loads sources configurations
#' @keywords internal
#' @noRd
#' @return NULL, called for side effects
.conf_load_sources <- function() {
    # get file paths
    source_yml_files <- .conf_sources_files()
    # load files
    source_configs <- purrr::map(source_yml_files, function(file) {
        yaml::yaml.load_file(
            input = file,
            merge.precedence = "override"
        )
    })
    # prepare sources object
    source_obj <- purrr::map(source_configs, "sources")
    source_obj <- purrr::flatten(source_obj)
    # prepare extras objects (e.g., token, url config)
    extras_obj <- purrr::map(source_configs, function(source_config) {
        source_config[["sources"]] <- NULL
        source_config
    })
    extras_obj <- purrr::flatten(extras_obj)
    # merge objects
    config_obj <- utils::modifyList(extras_obj, list(
        sources = source_obj
    ))
    # set configurations
    do.call(.conf_set_options, args = config_obj)
    # done
    return(invisible(NULL))
}
#' @title Return the message configuration file (only for developers)
#' @name .conf_messages_file
#' @keywords internal
#' @noRd
#' @return default internal configuration file
.conf_messages_file <- function() {
    .check_set_caller(".conf_messages_file")
    # load the default configuration file
    yml_file <- system.file("extdata", "config_messages.yml", package = "sits")
    # check that the file name is valid
    .check_file(yml_file)
    return(yml_file)
}
#' @name .conf_load_messages
#' @description Loads the error messages and warnings
#' @keywords internal
#' @noRd
#' @return NULL, called for side effects
.conf_load_messages <- function() {
    # load the color configuration file
    msgs_yml_file <- .conf_messages_file()
    config_msgs <- yaml::yaml.load_file(
        input = msgs_yml_file,
        merge.precedence = "override"
    )
    # set the messages
    sits_env[["config"]][["messages"]] <- config_msgs
    return(invisible(NULL))
}
#' @title Return the default configuration file for colors
#' @name .conf_colors_file
#' @keywords internal
#' @noRd
#' @return default color configuration file
.conf_colors_file <- function() {
    # load the default configuration file
    yml_file <- system.file("extdata", "config_colors.yml", package = "sits")

    # check that the file name is valid
    .check_file(yml_file, msg = "invalid configuration file")

    return(yml_file)
}
#' @title Loads default color table and legends
#' @name .conf_load_color_table
#' @description Loads the default color table
#' @keywords internal
#' @noRd
#' @return NULL, called for side effects
.conf_load_color_table <- function() {
    # load the color configuration file
    color_yml_file <- .conf_colors_file()
    config_colors <- yaml::yaml.load_file(
        input = color_yml_file,
        merge.precedence = "override"
    )
    # set the legends
    sits_env[["legends"]] <- config_colors$legends
    # build the color table
    colors <- config_colors[["colors"]]
    color_table <- purrr::map2_dfr(colors, names(colors),
                                   function(cl, nm) {
        cc_tb <- tibble::tibble(
            name = nm,
            color = cl
        )
        return(cc_tb)
    })

    # set the color table
    sits_env[["color_table"]] <- color_table
    return(invisible(color_table))
}
#' @title Add user color table
#' @name .conf_add_color_table
#' @description Loads a user color table
#' and merges with default color table
#' @param color_tb user color table
#' @keywords internal
#' @noRd
#' @return new color table (invisible)
.conf_add_color_table <- function(color_tb) {
    .check_set_caller(".conf_add_color_table")
    # pre condition - table contains name and hex code
    .check_chr_contains(
        x = colnames(color_tb),
        contains = .conf("color_table_cols"),
        discriminator = "all_of"
    )
    # replace all duplicates
    new_colors <- dplyr::pull(color_tb, .data[["name"]])
    # remove duplicate colors
    old_color_tb <- dplyr::filter(sits_env[["color_table"]],
                                  !(.data[["name"]] %in% new_colors))
    sits_env[["color_table"]] <- dplyr::bind_rows(old_color_tb, color_tb)
    return(invisible(sits_env[["color_table"]]))
}
#' @title Merge user colors with default colors
#' @name .conf_merge_colors
#' @description Combines user colors with default color table
#' @param user_colors  list of user colors
#' @keywords internal
#' @noRd
#' @return new color table
.conf_merge_colors <- function(user_colors) {
    # get the current color table
    color_table <- .conf_colors()
    names_user_colors <- names(user_colors)
    col_user_colors <- unname(user_colors)
    for (i in seq_along(names_user_colors)) {
        name <- names_user_colors[[i]]
        col <- col_user_colors[[i]]
        id <- which(color_table[["name"]] == name)
        if (length(id) > 0) {
            color_table[id, "color"] <- col
        } else {
            color_table <- tibble::add_row(color_table,
                name = name,
                color = col
            )
        }
    }
    sits_env[["color_table"]] <- color_table
    return(color_table)
}
#' @title Merge user legends with default legends
#' @name .conf_merge_legends
#' @description Combines user legends with default
#' @param user_legends  List of user legends
#' @keywords internal
#' @noRd
#' @return new color table
.conf_merge_legends <- function(user_legends){
    .check_set_caller(".conf_merge_legends")
    # check legends are valid names
    .check_chr_parameter(names(user_legends), len_max = 100,
                         msg = .conf("messages", ".conf_merge_legends_user"))
    # check legend names do not already exist
    .check_that(!(any(names(user_legends) %in% names(sits_env[["legends"]]))))
    # check colors names are valid
    ok <- purrr::map_lgl(user_legends, function(leg){
        .check_chr_parameter(leg, len_max = 100,
                        msg = .conf("messages", ".conf_merge_legends_colors"))
        return(TRUE)
    })
    sits_env[["legends"]] <- c(sits_env[["legends"]], user_legends)
    return(invisible(sits_env[["legends"]]))

}
#' @title Return the default color table
#' @name .conf_colors
#' @keywords internal
#' @noRd
#' @return default color table
#'
.conf_colors <- function() {
    return(sits_env[["color_table"]])
}
#' @title Configure fonts to be used
#' @name .conf_set_fonts
#' @keywords internal
#' @noRd
#' @return NULL, called for side effects
#'
.conf_set_fonts <- function() {
    # verifies if sysfonts package is installed
    .check_require_packages("sysfonts")
    .check_require_packages("showtext")
    showtext::showtext_auto()
    sysfonts::font_add_google("IBM Plex Sans", family = "plex_sans")
    sysfonts::font_add_google("Roboto", family = "roboto")
    sysfonts::font_add_google("Lato", family = "lato")

    return(NULL)
}
#' @title Return the user configuration set in enviromental variable
#' @name .conf_user_env_var
#' @keywords internal
#' @noRd
#' @return YAML user configuration
.conf_user_env_var <- function() {
    # load the default user configuration file
    yml_file <- Sys.getenv("SITS_CONFIG_USER_FILE")
    yaml_user_config <- NULL
    # check if the file exists when env var is set
    if (nchar(yml_file) > 0) {
        .check_warn(
            .check_file(yml_file,
                msg = .conf("messages", ".conf_user_env_var")
            )
        )
        # if the YAML file exists, try to load it
        tryCatch({
            yaml_user_config <- yaml::yaml.load_file(
                    input = yml_file,
                    merge.precedence = "override"
            )},
            error = function(e) {
                warning(.conf("messages", ".conf_user_env_var"), call. = TRUE)
            }
        )
    }
    # returns the user configuration, otherwise null
    return(yaml_user_config)
}
#' @title Load the user configuration file
#' @name .conf_set_user_file
#' @param config_user_file  Configuration file provided by user
#' @keywords internal
#' @noRd
#' @return user configuration file
.conf_set_user_file <- function(config_user_file = NULL) {
    .check_set_caller(".conf_set_user_file")
    # try to find a valid user configuration file
    # check config user file is valid
    if (.has(config_user_file) && !is.na(config_user_file)) {
        user_config <- tryCatch(
            yaml::yaml.load_file(config_user_file, error.label = "",
                                 readLines.warn = FALSE),
            error = function(e) {
                stop(.conf("messages", ".conf_set_user_file"), call. = TRUE)
            }
        )
    } else {
        user_config <- .conf_user_env_var()
    }
    if (.has(user_config)) {
        if (.has(user_config[["colors"]])) {
            user_colors <- user_config[["colors"]]
            .conf_merge_colors(user_colors)
            user_config[["colors"]] <- NULL
        }
        if (.has(user_config[["legends"]])) {
            user_legends <- user_config[["legends"]]
            .conf_merge_legends(user_legends)
            user_config[["legends"]] <- NULL
        }
        if (length(user_config) > 0) {
            user_config <- utils::modifyList(sits_env[["config"]],
                user_config,
                keep.null = FALSE
            )
            # set options defined by user (via YAML file)
            # modifying existing configuration
            .conf_set_options(
                processing_bloat = user_config[["processing_bloat"]],
                rstac_pagination_limit =
                    user_config[["rstac_pagination_limit"]],
                gdal_creation_options =
                    user_config[["gdal_creation_options"]],
                gdalcubes_chunk_size =
                    user_config[["gdalcubes_chunk_size"]],
                sources = user_config[["sources"]],
                colors = user_config[["colors"]],
                view   = user_config[["view"]],
                plot   = user_config[["plot"]]
            )
        }
    }
}
#' @title Check band availability
#' @name .conf_check_bands
#' @description Checks if the requested bands are available in the collection
#'
#' @keywords internal
#' @noRd
#' @param source        Data source
#' @param collection    Collection to be searched in the data source.
#' @param bands         Bands to be included.
#'
#' @return              Called for side effects.
.conf_check_bands <- function(source, collection, bands) {
    # set caller to show in errors
    .check_set_caller(".conf_check_bands")

    sits_bands <- .source_bands(
        source = source,
        collection = collection
    )
    source_bands <- .source_bands_band_name(
        source = source,
        collection = collection
    )
    .check_chr_within(
        x = bands,
        within = c(sits_bands, source_bands)
    )
    return(invisible(bands))
}
#' @title List configuration parameters
#' @name .conf_list_params
#' @description List the contents of a source
#'
#' @keywords internal
#' @noRd
#' @param params        parameter list
#'
#' @return              Called for side effects.
.conf_list_params <- function(params) {
    params <- lapply(params, function(x) {
        if (is.atomic(x)) {
            return(x)
        }
        list(names(x))
    })
    params_txt <- yaml::as.yaml(
        params,
        indent = 4,
        handlers = list(
            character = function(x) {
                res <- toString(x)
                class(res) <- "verbatim"
                res
            },
            integer = function(x) {
                res <- toString(x)
                class(res) <- "verbatim"
                res
            },
            numeric = function(x) {
                res <- toString(x)
                class(res) <- "verbatim"
                res
            }
        )
    )
    cat(params_txt, sep = "\n")
}

#' @title List contents of a source
#' @name .conf_list_source
#' @description List the contents of a source
#'
#' @keywords internal
#' @noRd
#' @param source        Data source
#'
#' @return              Called for side effects.
.conf_list_source <- function(source){
    cat(paste0(source, ":\n"))
    collections <- .source_collections(source)
    purrr::map(collections, function(col) {
        cat(paste0("- ", col))
        cat(paste0(
            " (", .source_collection_satellite(source, col),
            "/", .source_collection_sensor(source, col), ")\n",
            "- grid system: ", .source_collection_grid_system(source, col), "\n"
        ))
        cat("- bands: ")
        cat(.source_bands(source, col))
        cat("\n")
        if (.source_collection_open_data(source, col)) {
            cat("- opendata collection ")
            if (.source_collection_open_data(
                source = source,
                collection = col,
                token = TRUE
            )) {
                cat("(requires access token)")
            }
        } else {
            cat("- not opendata collection")
        }
        cat("\n")
        cat("\n")
    })
}


#' @title Get names associated to a configuration key
#' @name .conf_names
#' @param key   key combination to access config information
#' @keywords internal
#' @noRd
#' @return   names associated to the chosen access key
.conf_names <- function(...) {
    key <- c(...)
    res <- tryCatch(
        {
            names(sits_env[["config"]][[key]])
        },
        error = function(e) {
            return(NULL)
        }
    )
    # post-condition
    .check_chr(res,
        allow_empty = FALSE,
        msg = paste(
            "invalid names for",
            paste0("'", paste0(key, collapse = "$"), "'"),
            "key"
        )
    )

    return(res)
}
#' @title Include a new source in the configuration
#' @name .conf_new_source
#' @description creates a new data source in the config file
#' @param s3_class   s3 class associated to the source
#' @param collections collections associated to the source
#' @param ...         other parameters associated to the new source
#' @param service     protocol associated to the source (e.g., "STAC")
#' @param url         url associated to the endpoint of the service
#' @keywords internal
#' @noRd
#' @return   list with the configuration associated to the new source
.conf_new_source <- function(s3_class,
                             collections, ...,
                             service = NULL,
                             url = NULL) {
    # set caller to show in errors
    .check_set_caller(".conf_new_source")
    # pre-condition
    .check_chr_parameter(s3_class,
        allow_empty = FALSE, len_min = 1,
        msg = .conf("messages", ".conf_new_source_s3class")
    )

    if (!is.null(service)) {
        .check_chr_parameter(service,
            allow_empty = FALSE, len_min = 1, len_max = 1,
            msg = .conf("messages", ".conf_new_source_service")
        )
    }
    if (!is.null(url)) {
        .check_chr_parameter(url,
            allow_empty = FALSE, len_min = 1, len_max = 1,
            regex = '^(http|https):https://[^ "]+$',
            msg = .conf("messages", ".conf_new_source_url")
        )
    }
    .check_lst(collections, len_min = 1)
    names(collections) <- toupper(names(collections))

    collections <- lapply(collections, function(collection) {
        # pre-condition
        .check_lst_parameter(collection,
            len_min = 1,
            msg = .conf("messages", ".conf_new_source_collections")
        )
        # collection members must be lower case
        names(collection) <- tolower(names(collection))
        collection <- .check_error(
            {
                do.call(.conf_new_collection, args = collection)
            },
            msg = .conf("messages", ".conf_new_source_collections")
        )
        return(collection)
    })

    # extra parameters
    dots <- list(...)
    .check_lst_parameter(dots, len_min = 0,
                msg = .conf("messages", ".conf_new_source_collections_args"))

    return(c(list(
        s3_class = s3_class,
        service = service,
        url = url,
        collections = collections
    ), dots))
}
#' @title Include a new collection in the configuration
#' @name .conf_new_collection
#' @description creates a new collection associated to a source
#' @param bands       bands associated to the collection
#' @param ...         other relevant parameters
#' @param satellite   satellite associated to the collection
#' @param sensor      sensor associated to the collection
#' @keywords internal
#' @noRd
#' @return   list with the configuration associated to the new collection
.conf_new_collection <- function(bands, ...,
                                 satellite = NULL,
                                 sensor = NULL,
                                 metadata_search = NULL) {
    # set caller to show in errors
    .check_set_caller(".conf_new_collection")
    # check satellite
    .check_chr_parameter(satellite,
        allow_null = TRUE,
        msg = .conf("messages", ".conf_new_collection_satellite")
    )
    #  check sensor
    .check_chr(sensor,
        allow_null = TRUE,
        msg = .conf("messages", ".conf_new_collection_sensor")
    )
    # check metadata_search
    if (!missing(metadata_search)) {
        .check_chr_within(metadata_search,
            within = .conf("metadata_search_strategies"),
            msg = .conf("messages", ".conf_new_collection_metadata")
        )
    }
    # check extra parameters
    dots <- list(...)
    .check_lst(dots,
               msg = .conf("messages", ".conf_new_collection_metadata_args")
    )
    # bands names is upper case
    names(bands) <- toupper(names(bands))
    # pre-condition
    .check_lst(bands,
               len_min = 1,
               msg = .conf("messages", ".conf_new_collection_bands")
    )
    # define collection bands
    collection_bands <- c()
    # handle class bands
    is_class_cube <- dots[["class_cube"]]
    is_class_cube <- all(!is.null(is_class_cube))
    if (is_class_cube) {
        # configure class bands (assuming there is no cloud band in class cubes)
        class_bands <- .conf_new_bands(bands, .conf_new_class_band)
        # save band configuration object
        collection_bands <- c(class_bands)
    } else {
        # handle cloud and non-cloud bands
        cloud_band <- bands[names(bands) %in% .source_cloud()]
        non_cloud_bands <- bands[!names(bands) %in% .source_cloud()]
        # cloud bands
        cloud_band <- .conf_new_bands(cloud_band, .conf_new_cloud_band)
        # non-cloud bands
        non_cloud_bands <- .conf_new_bands(non_cloud_bands, .conf_new_band)
        # save bands configuration object
        collection_bands <- c(non_cloud_bands, cloud_band)
    }
    # merge metadata properties
    res <- c(list(bands = collection_bands),
        "satellite" = satellite,
        "sensor" = sensor,
        "metadata_search" = metadata_search, dots
    )
    # post-condition
    .check_lst(res,
        len_min = 1,
        msg = .conf("messages", ".conf_new_collection")
    )
    .check_lst(res$bands,
        len_min = 1,
        msg = .conf("messages", ".conf_new_collection_bands")
    )
    # return a new collection data
    return(res)
}
#' @title Include a new band in the configuration
#' @name .conf_new_band
#' @description creates a description associated to a new band
#' @param missing_value  missing value
#' @param minimum_value  minimum value
#' @param maximum_value  maximum_value
#' @param scale_factor   scale_factor associated with the data
#' @param offset_value   offset_value for the band
#' @param band_name      name of the band
#' @param resolution     spatial resolution (in meters)
#' @param ...            other relevant parameters
#' @keywords internal
#' @noRd
#' @return   list with the configuration associated to the new band
.conf_new_band <- function(missing_value,
                           minimum_value,
                           maximum_value,
                           scale_factor,
                           offset_value,
                           band_name,
                           resolution, ...) {
    .check_set_caller(".conf_new_band")
    # pre-condition
    .check_num_parameter(
        missing_value,
        len_min = 1,
        len_max = 1
    )
    .check_num_parameter(
        minimum_value,
        len_min = 1,
        len_max = 1
    )
    .check_num_parameter(
        x = maximum_value,
        len_min = 1,
        len_max = 1
    )
    .check_num_parameter(
        scale_factor,
        len_min = 1,
        len_max = 1,
        exclusive_min = 0
    )
    .check_num_parameter(
        offset_value,
        len_min = 1,
        len_max = 1
    )
    .check_num_parameter(
        resolution,
        exclusive_min = 0,
        len_min = 1,
        len_max = 1,
        allow_null = TRUE
    )
    .check_chr(
        band_name,
        allow_empty = FALSE,
        len_min = 1,
        len_max = 1
    )
    # extra parameters
    dots <- list(...)
    .check_lst(dots, msg = .conf("messages", ".check_new_band_dots"))

    new_band_params <- c(list(
        missing_value = missing_value,
        minimum_value = minimum_value,
        maximum_value = maximum_value,
        scale_factor = scale_factor,
        offset_value = offset_value,
        band_name = band_name,
        resolution = resolution
    ), dots)

    # post-condition
    .check_lst_parameter(new_band_params,
        len_min = 7
    )
    # return a band object
    return(new_band_params)
}
#' @title Include a new cloud band in the configuration
#' @name .conf_new_cloud_band
#' @description creates a description associated to a new cloud band
#' @param bit_mask       bit mask to describe clouds (if applicable)
#' @param value          values of the cloud band
#' @param interp_values  pixel values that need to be replaced by interpolation
#' @param resolution     spatial resolution (in meters)
#' @param band_name      name of the band
#' @param ...            other relevant parameters
#' @keywords internal
#' @noRd
#' @return   list with the configuration associated to the new band
.conf_new_cloud_band <- function(bit_mask,
                                 values,
                                 interp_values,
                                 resolution,
                                 band_name, ...) {
    # set caller to show in errors
    .check_set_caller(".conf_new_cloud_band")
    # pre-condition
    .check_lgl_parameter(bit_mask)
    .check_lst_parameter(values, fn_check = .check_chr)
    .check_int_parameter(interp_values, len_min = 1)
    .check_chr_parameter(band_name, len_min = 1, len_max = 1)

    # extra parameters
    dots <- list(...)
    .check_lst(dots, msg = .conf("messages", ".check_new_cloud_band_dots"))

    cloud_band_params <- c(list(
        bit_mask = bit_mask,
        values = values,
        interp_values = interp_values,
        resolution = resolution,
        band_name = band_name
    ), dots)

    # post-condition
    .check_lst_parameter(cloud_band_params, len_min = 5)

    # return a cloud band object
    return(cloud_band_params)
}
#' @title Include a new class band in the configuration
#' @name .conf_new_class_band
#' @description creates a description associated to a new cloud band
#' @param bit_mask       bit mask to describe clouds (if applicable)
#' @param values         values of the class band
#' @param resolution     spatial resolution (in meters)
#' @param band_name      name of the band
#' @param ...            other relevant parameters
#' @keywords internal
#' @noRd
#' @return   list with the configuration associated to the new class band
.conf_new_class_band <- function(bit_mask, values, resolution, band_name, ...) {
    # set caller to show in errors
    .check_set_caller(".conf_new_class_band")
    # pre-condition
    .check_lgl_parameter(bit_mask)
    .check_lst_parameter(values, fn_check = .check_chr)
    .check_chr_parameter(band_name, len_min = 1, len_max = 1)

    # check extra parameters
    dots <- list(...)
    .check_lst(dots, msg = .conf("messages",
                                 ".check_new_class_band_dots"))

    # build band
    class_band_params <- c(list(
        bit_mask = bit_mask,
        values = values,
        resolution = resolution,
        band_name = band_name
    ), dots)

    # post-condition
    .check_lst_parameter(class_band_params, len_min = 4)

    # return a class band object
    return(class_band_params)
}
#' @title Configure bands
#' @name .conf_new_bands
#' @description creates a description of multiple bands based on a user-defined
#' strategy.
#' @param bands       bands to be configured
#' @param config_fnc  band configuration strategy function
#' @keywords internal
#' @noRd
#' @return   list of configurations associated with the given bands
.conf_new_bands <- function(bands, config_fnc) {
    lapply(bands, function(band) {
        # lower case bands
        names(band) <- tolower(names(band))
        # configure band
        .check_error(
            {
                do.call(config_fnc, args = band)
            },
            msg = .conf("messages", ".conf_new_collection_bands")
        )
    })
}
#' @title Retrieve the rstac pagination limit
#' @name .conf_rstac_limit
#' @keywords internal
#' @noRd
#' @return pagination limit to rstac output
.conf_rstac_limit <- function() {
    res <- .conf("rstac_pagination_limit")
    return(res)
}
#' @title Retrieve the raster package to be used
#' @name .conf_raster_pkg
#' @keywords internal
#' @noRd
#' @return the raster package used to process raster data
#'
.conf_raster_pkg <- function() {
    res <- .conf("raster_api_package")
    return(res)
}

#' @title Retrieve the request package to be used
#' @name .conf_request_pkg
#' @keywords internal
#' @noRd
#' @return the package used to process http requisitions
#'
.conf_request_pkg <- function() {
    res <- .conf("request_api_package")
    return(res)
}

#' @title Basic access config functions
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @description
#' These are basic functions to access config options.
#'
#' @param ... Set of \code{character} values representing a key to access
#'   some hierarchical config entry.
#'
#' @examples
#' if (sits_run_examples()) {
#'     .conf_exists("run_tests") # TRUE
#'     .conf("run_tests")
#'     .conf_exists("not_existing_entry") # FALSE
#' }
NULL
#' @title Check if a key exists in config
#' @name .conf_exists
#' @noRd
#' @param throw_error  Should an error be thrown if test fails?
#' @returns  A logical value or an error if key not found and
#'   `throw_error` is `TRUE`.
.conf_exists <- function(..., throw_error = FALSE) {
    key <- c(...)
    exists <- !is.null(.try(sits_env[["config"]][[key]], .default = NULL))
    if (!exists && throw_error) {
        stop("key '", paste(key, collapse = "->"), "' not found in config")
    }
    # Return test
    exists
}
#' @title Get a config value based on a key
#' @noRd
#' @returns A value in config or an error if key does not exists.
.conf <- function(...) {
    key <- c(...)
    # Check for key existence and throws an error if it not exists
    .conf_exists(key, throw_error = TRUE)
    sits_env[["config"]][[c(key)]]
}
#' @title Config functions eo_cube
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @description
#' These are syntactic sugar functions to easily access config options for
#' bands of `eo_cube` cubes which is a S3 class representation
#' for an Earth Observation cube. It is the primary data used to obtain a
#' classification map.
#
#' The config entries of a `eo_cube` are located in
#' `sources -> <SOURCE> -> collections -> <COLLECTION>` key.
#' Values for source, collection, and band are uppercase.
#'
#' @examples
#' if (sits_run_examples()) {
#'     # tests if 'BDC -> MOD13Q1-6.1 -> NDVI' key exists in config
#'     .conf_eo_band_exists(
#'         source = "BDC",
#'         collection = "MOD13Q1-6.1",
#'         band = "NDVI"
#'     )
#'     # get configuration for band NDVI of 'BDC -> MOD13Q1-6' collection
#'     x <- .conf_eo_band(
#'         source = "BDC",
#'         collection = "MOD13Q1-6.1",
#'         band = "NDVI"
#'     )
#' }
NULL
#' @title Check if a band entry exists in config
#' @noRd
#' @param source  Data source.
#' @param collection  Collection in the data source.
#' @param band  Band name.
#' @returns  A logical value or an error if `source` or `collections`
#'   does not exists.
.conf_eo_band_exists <- function(source, collection, band) {
    # source, collection, and band are uppercase
    source <- toupper(source)
    collection <- toupper(collection)
    band <- .band_eo(band)
    # Check for source and collection and throws an error if it not exists
    .conf_exists(
        "sources", source, "collections", collection,
        throw_error = TRUE
    )
    # Test for band and return
    .conf_exists("sources", source, "collections", collection, "bands", band)
}
#' @title Get a config value for a band
#' @noRd
#' @param source  Data source.
#' @param collection  Collection in the data source.
#' @param band  Band name
#' @details
#' If the band is not found, a default value will be returned from config.
#' If neither source nor collection entries are found in configuration file,
#' an error is thrown.
#' @returns  A value in config.
.conf_eo_band <- function(source, collection, band) {
    # Format band name
    band <- .band_eo(band)
    # does the band exists in cube config?
    if (!.conf_eo_band_exists(source, collection, band)) {
        return(NULL)
    }
    # Get band config value and return it
    .conf("sources", source, "collections", collection, "bands", band)
}
#' @title Config functions for derived_cube
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @description
#' These are syntactic sugar functions to easily access config options for
#' bands of `derived_cube` cubes. `derived_cube`s are a S3 class
#' representation of a cube generated by the classification workflow starting
#' from an Earth Observation data cube.
#'
#' There are several classes of `derived_cube`:
#' * probs_cube: multilayer probability cube produced by a
#'   classification with the probabilities attributed to each class by a
#'   model. The possible band names are 'probs', 'bayes', and
#'   'bilat', acronyms for 'probability', 'Bayesian smoothing', and
#'   'Bilateral smoothing'.
#' * class_cube: labeled cube (classified map) produced by choosing
#'   a label for each pixel. Its unique band name is 'class'.
#' * uncertainty_cube: a cube produced to measure the uncertainty of
#'   a classification for each pixel. The possible band names are
#'   'least', 'entropy', and 'margin', acronyms for the method used to
#'   produce the cube.
#'
#' Values for `derived_class` and band are lowercase. This was
#' done to avoid conflicts with `eo_cube` band naming (uppercase).
#' The config entries of a `derived_cube` are located in
#' `derived_cube -> <derived_class>` key.
#'
#' @examples
#' if (sits_run_examples()) {
#'     # get S3 class value that a derived_cube of class 'probs' must have
#'     .conf_derived_s3class("probs")
#' }
#'
NULL
#' @title Get the S3 class values of a `derived_cube`
#' @noRd
#' @param derived_class  A `derived_cube` class name.
#' @return A S3 class.
.conf_derived_s3class <- function(derived_class) {
    # derived_class is lowercase
    derived_class <- tolower(derived_class)
    .conf("derived_cube", derived_class, "s3_class")
}
#' @title Get the S3 class values of a `vector_cube`
#' @noRd
#' @param vector_class  A `vector_cube` class name.
#' @return A S3 class.
.conf_vector_s3class <- function(vector_class) {
    # derived_class is lowercase
    vector_class <- tolower(vector_class)
    .conf("vector_cube", vector_class, "s3_class")
}

#' @title Get a band configuration of a `derived_cube`
#' @noRd
#' @param derived_class  A `derived_cube` class name.
#' @param band  Band name of `derived_cube`.
#' @return  A band configuration.
.conf_derived_band <- function(derived_class, band) {
    # Format band
    band <- .band_derived(band)
    # Derived_class is lowercase
    derived_class <- tolower(derived_class)
    .conf("derived_cube", derived_class, "bands", band)
}
#' @title Band configuration accessors
#' @noRd
#'
#' @author Rolf Simoes, \email{rolf.simoes@@inpe.br}
#'
#' @description
#' These functions are read-only accessors of band_conf objects. A
#' band_conf is an entry of band definition in config. It can be associated
#' to an eo_cube or derived_cube
#'
NULL
#' @title Get the data type from a band configuration
#' @param conf  A band definition value from config.
#' @noRd
#' @return  Data type associated to the configuration
.data_type <- function(conf) {
    .as_chr(conf[["data_type"]][[1]])
}
#' @title Get the missing value from a band configuration
#' @noRd
#' @param conf  A band definition value from config.
#' @return  Missing value associated to the band
.miss_value <- function(conf) {
    .as_dbl(conf[["missing_value"]][[1]])
}
#' @title Get the minimum value from a band configuration
#' @noRd
#' @param conf  A band definition value from config.
#' @return  Minimum value associated to the band
.min_value <- function(conf) {
    .as_dbl(conf[["minimum_value"]][[1]])
}
#' @title Get the maximum value from a band configuration
#' @noRd
#' @param conf  A band definition value from config.
#' @return  Maximum value associated to the band
.max_value <- function(conf) {
    .as_dbl(conf[["maximum_value"]][[1]])
}
#' @title Get the scale factor from a band configuration
#' @noRd
#' @param conf  A band definition value from config.
#' @return  Scale factor associated to the band
.scale <- function(conf) {
    .as_dbl(conf[["scale_factor"]][[1]])
}
#' @title Get the offset value from a band configuration
#' @noRd
#' @param conf  A band definition value from config.
#' @return  Offset value associated to the band
.offset <- function(conf) {
    .as_dbl(conf[["offset_value"]][[1]])
}
#' @title Get the cloud interpolation values from a band configuration
#' @noRd
#' @param conf  A band definition value from config.
#' @return  Cloud interpolation values associated to the band
.cloud_interp_values <- function(conf) {
    .as_int(conf[["interp_values"]])
}
#' @title Get the bit mask flag from a band configuration
#' @noRd
#' @param conf  A band definition value from config.
#' @return  Cloud bit mask values associated to the band.
.cloud_bit_mask <- function(conf) {
    .as_int(conf[["bit_mask"]][[1]])
}
#' @title Get the default parse info for local files  flag
#' @noRd
#' @param parse_info  Parse information set by user
#' @param results_cube Is this a results cube?
#' @return  Valid parse_info information
.conf_parse_info <- function(parse_info, results_cube = FALSE) {
    # is parse info NULL? use the default
    if (!.has(parse_info)) {
        if (results_cube) {
            parse_info <- .conf("results_parse_info_def")
        } else {
            parse_info <- .conf("local_parse_info_def")
        }
        return(parse_info)
    }

    # precondition - does the parse info have band and date?
    if (results_cube) {
        .check_chr_contains(
            parse_info,
            contains = .conf("results_parse_info_col"),
            msg = .conf("messages", ".conf_parse_info_results")
        )
    } else {
        .check_chr_contains(
            parse_info,
            contains = .conf("local_parse_info_col"),
            msg = .conf("messages", ".conf_parse_info")
        )
    }
    return(parse_info)
}