# ==================================================================== #
# TITLE:                                                               #
# AMR: An R Package for Working with Antimicrobial Resistance Data     #
#                                                                      #
# SOURCE CODE:                                                         #
# https://github.com/msberends/AMR                                     #
#                                                                      #
# PLEASE CITE THIS SOFTWARE AS:                                        #
# Berends MS, Luz CF, Friedrich AW, et al. (2022).                     #
# AMR: An R Package for Working with Antimicrobial Resistance Data.    #
# Journal of Statistical Software, 104(3), 1-31.                       #
# https://doi.org/10.18637/jss.v104.i03                                #
#                                                                      #
# Developed at the University of Groningen and the University Medical  #
# Center Groningen in the Netherlands, in collaboration with many      #
# colleagues from around the world, see our website.                   #
#                                                                      #
# This R package is free software; you can freely use and distribute   #
# it for both personal and commercial purposes under the terms of the  #
# GNU General Public License version 2.0 (GNU GPL-2), as published by  #
# the Free Software Foundation.                                        #
# We created this package for both routine data analysis and academic  #
# research and it was publicly released in the hope that it will be    #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY.              #
#                                                                      #
# Visit our website for the full manual and a complete tutorial about  #
# how to conduct AMR data analysis: https://amr-for-r.org              #
# ==================================================================== #

test_that("test-zzz.R", {
  skip_on_cran()

  # Check if these functions still exist in their package (all are in Suggests field)
  # Since GitHub Actions runs every night, we will get emailed when a dependency fails based on this unit test

  # functions used by import_fn()
  import_functions <- c(
    "%chin%" = "data.table",
    "ansi_has_hyperlink_support" = "cli",
    "anti_join" = "dplyr",
    "as.data.table" = "data.table",
    "as_tibble" = "tibble",
    "chmatch" = "data.table",
    "cli_abort" = "cli",
    "cur_column" = "dplyr",
    "cur_group" = "dplyr",
    "document_position" = "rstudioapi",
    "document_range" = "rstudioapi",
    "full_join" = "dplyr",
    "getActiveDocumentContext" = "rstudioapi",
    "has_color" = "crayon",
    "has_internet" = "curl",
    "html_attr" = "rvest",
    "html_children" = "rvest",
    "html_node" = "rvest",
    "html_nodes" = "rvest",
    "html_table" = "rvest",
    "html_text" = "rvest",
    "inner_join" = "dplyr",
    "insertText" = "rstudioapi",
    "left_join" = "dplyr",
    "modifyRange" = "rstudioapi",
    "new_pillar_shaft_simple" = "pillar",
    "progress_bar" = "progress",
    "read_html" = "xml2",
    "right_join" = "dplyr",
    "select" = "dplyr",
    "semi_join" = "dplyr",
    "showQuestion" = "rstudioapi",
    "symbol" = "cli",
    "tibble" = "tibble",
    "where" = "tidyselect",
    "write.xlsx" = "openxlsx"
  )

  # functions that are called directly with ::
  call_functions <- c(
    # cleaner
    "freq" = "cleaner",
    "freq.default" = "cleaner",
    "percentage" = "cleaner",
    # cli
    "ansi_has_hyperlink_support" = "cli",
    "cli_abort" = "cli",
    "cli_inform" = "cli",
    "cli_warn" = "cli",
    "code_highlight" = "cli",
    "format_inline" = "cli",
    "symbol" = "cli",
    # curl
    "has_internet" = "curl",
    # future
    "plan" = "future",
    "nbrOfWorkers" = "future",
    # future.apply
    "future_lapply" = "future.apply",
    # ggplot2
    "aes" = "ggplot2",
    "arrow" = "ggplot2",
    "autoplot" = "ggplot2",
    "element_blank" = "ggplot2",
    "element_line" = "ggplot2",
    "element_text" = "ggplot2",
    "expand_limits" = "ggplot2",
    "facet_wrap" = "ggplot2",
    "fortify" = "ggplot2",
    "geom_col" = "ggplot2",
    "geom_errorbar" = "ggplot2",
    "geom_path" = "ggplot2",
    "geom_point" = "ggplot2",
    "geom_ribbon" = "ggplot2",
    "geom_segment" = "ggplot2",
    "geom_text" = "ggplot2",
    "ggplot" = "ggplot2",
    "labs" = "ggplot2",
    "position_dodge2" = "ggplot2",
    "position_fill" = "ggplot2",
    "scale_colour_discrete" = "ggplot2",
    "scale_discrete_manual" = "ggplot2",
    "scale_fill_discrete" = "ggplot2",
    "scale_fill_manual" = "ggplot2",
    "scale_x_discrete" = "ggplot2",
    "scale_y_continuous" = "ggplot2",
    "scale_y_discrete" = "ggplot2",
    "theme" = "ggplot2",
    "theme_minimal" = "ggplot2",
    "unit" = "ggplot2",
    "xlab" = "ggplot2",
    "ylab" = "ggplot2",
    # knitr
    "asis_output" = "knitr",
    "kable" = "knitr",
    "knit_print" = "knitr",
    "opts_chunk" = "knitr",
    # pillar
    "pillar_shaft" = "pillar",
    "style_na" = "pillar",
    "style_subtle" = "pillar",
    "tbl_format_footer" = "pillar",
    "tbl_sum" = "pillar",
    "type_sum" = "pillar",
    # readxl
    "read_excel" = "readxl",
    # recipes
    "add_step" = "recipes",
    "bake" = "recipes",
    "check_new_data" = "recipes",
    "check_type" = "recipes",
    "has_role" = "recipes",
    "is_trained" = "recipes",
    "prep" = "recipes",
    "print_step" = "recipes",
    "rand_id" = "recipes",
    "recipe" = "recipes",
    "recipes_eval_select" = "recipes",
    "sel2char" = "recipes",
    "step" = "recipes",
    "step_center" = "recipes",
    "tidy" = "recipes",
    # rlang
    "enquos" = "rlang",
    # rmarkdown
    "html_vignette" = "rmarkdown",
    # skimr
    "get_skimmers" = "skimr",
    "inline_hist" = "skimr",
    "sfl" = "skimr",
    # tibble
    "tibble" = "tibble",
    # vctrs
    "vec_arith" = "vctrs",
    "vec_cast" = "vctrs",
    "vec_math" = "vctrs",
    "vec_ptype2" = "vctrs",
    "vec_ptype_abbr" = "vctrs",
    "vec_ptype_full" = "vctrs",
    # usethis
    "use_course" = "usethis"
  )

  import_functions <- c(import_functions, call_functions)

  suggests <- strsplit(utils::packageDescription("AMR")$Suggests, "[,\n ]+")[[1]]
  for (i in seq_len(length(import_functions))) {
    fn <- names(import_functions)[i]
    pkg <- unname(import_functions[i])
    expect_true(pkg %in% suggests,
      info = paste0("package `", pkg, "` is not in Suggests")
    )
    # function should exist in foreign pkg namespace
    if (AMR:::pkg_is_available(pkg,
      also_load = FALSE,
      min_version = if (pkg == "dplyr") "1.0.0" else NULL
    )) {
      if (pkg == "rstudioapi") {
        expect_true(is.function(tryCatch(get(fn, envir = asNamespace(pkg)), error = function(e) NULL)),
          info = paste0("Function does not exist (anymore): function `", pkg, "::", fn, "()`")
        )
      } else {
        expect_true(!is.null(AMR:::import_fn(name = fn, pkg = pkg, error_on_fail = FALSE)),
          info = paste0("Function does not exist (anymore): function `", pkg, "::", fn, "()`")
        )
      }
    } else if (pkg != "rstudioapi") {
      warning("Package '", pkg, "' not available")
    }
  }

  if (AMR:::pkg_is_available("cli")) {
    expect_true(!is.null(cli::symbol$bullet) && is.character(cli::symbol$bullet) && length(cli::symbol$bullet) == 1)
    expect_true(!is.null(cli::symbol$ellipsis) && is.character(cli::symbol$ellipsis) && length(cli::symbol$ellipsis) == 1)
    expect_true(!is.null(cli::symbol$info) && is.character(cli::symbol$info) && length(cli::symbol$info) == 1)
    expect_true(!is.null(cli::symbol$sup_1) && is.character(cli::symbol$sup_1) && length(cli::symbol$sup_1) == 1)
  }
  if (AMR:::pkg_is_available("ggplot2")) {
    # the scale_*_mic() functions rely on these
    expect_true(is.function(ggplot2::scale_x_discrete()$transform))
    expect_true(is.function(ggplot2::scale_y_discrete()$transform))
    expect_true(is.function(ggplot2::scale_colour_discrete()$transform))
    expect_true(is.function(ggplot2::scale_fill_discrete()$transform))
  }
})

test_that("test-zzz.R: no installation-time dependency on suggested packages", {
  skip_on_cran()
  # code outside functions runs when the package is installed, not when it is loaded: anything it takes from a suggested package is then decided by the machine that built the package (e.g., the CRAN binary builders, which have all suggested packages), and fails for users who do not have that package, see .onLoad() in R/zzz.R
  r_dir <- file.path("..", "..", "R")
  skip_if(!dir.exists(r_dir), "R source files not available")
  suggests <- trimws(gsub("[(].*", "", strsplit(read.dcf(file.path(r_dir, "..", "DESCRIPTION"), fields = "Suggests")[1, 1], ",")[[1]]))
  runtime_calls <- c("import_fn", "requireNamespace", "loadNamespace", "pkg_is_available", "l10n_info", "require", "library")
  find_offending <- function(expr) {
    if (!is.call(expr)) {
      return(character(0))
    }
    fn <- expr[[1]]
    if (identical(fn, as.name("function"))) {
      # function bodies run at runtime, so these are fine
      return(character(0))
    }
    found <- character(0)
    fn_name <- if (is.name(fn)) as.character(fn) else if (is.call(fn) && (identical(fn[[1]], as.name("::")) || identical(fn[[1]], as.name(":::")))) as.character(fn[[3]]) else ""
    if (fn_name %in% runtime_calls) {
      found <- paste0(fn_name, "()")
    }
    if ((identical(fn, as.name("::")) || identical(fn, as.name(":::"))) && as.character(expr[[2]]) %in% suggests) {
      found <- paste0(as.character(expr[[2]]), "::", as.character(expr[[3]]))
    }
    c(found, unlist(lapply(as.list(expr)[-1], find_offending)))
  }
  offending <- character(0)
  for (f in list.files(r_dir, pattern = "[.]R$", full.names = TRUE)) {
    exprs <- parse(f, keep.source = TRUE)
    lines <- vapply(FUN.VALUE = integer(1), attr(exprs, "srcref"), function(x) x[1])
    for (i in seq_along(exprs)) {
      found <- find_offending(exprs[[i]])
      if (length(found) > 0) {
        offending <- c(offending, paste0(basename(f), ":", lines[i], ": ", paste(unique(found), collapse = ", ")))
      }
    }
  }
  expect_identical(offending, character(0), info = paste(offending, collapse = "\n"))
})