utils::globalVariables(c(
  ".SD", "clockTime", "diffTime", "eventNumber", "eventTime", "eventType", "exts",
  "minEventTime", "maxEventTime", "savetime", "unit"
))

## NOTE: `show` generic is already defined in the methods package

#' Show an Object
#'
#' @param object `simList`
#'
#' @author Alex Chubaty
#' @export
#' @importFrom rlang env_binding_are_lazy
#' @importFrom stats na.omit
#' @importFrom utils capture.output ls.str
#' @include simList-class.R
#' @rdname show-method
setMethod(
  "show",
  signature = "simList",
  definition = function(object) {
    out <- list()
    out[[1]] <- capture.output(
      cat(rep("=", getOption("width"), sep = ""), "\n", sep = "")
    )

    ### simulation dependencies
    out[[2]] <- capture.output(cat(">> Simulation dependencies:\n"))
    out[[3]] <- "use `depends(sim)` to view dependencies for each module"
    out[[4]] <- capture.output(cat("\n"))

    ### simtimes
    out[[5]] <- capture.output(cat(">> Simulation times:\n"))
    out[[6]] <- capture.output(print(rbind(times(object))))
    out[[7]] <- capture.output(cat("\n"))

    ### modules loaded
    out[[8]] <- capture.output(cat(">> Modules:\n"))
    ord <- match(unlist(modules(object)), names(timeunits(object))) |> na.omit()
    out[[9]] <- capture.output(print(
      cbind(Name = unname(modules(object)),
            #Timeunit = c(rep(NA_character_, 4), unname(timeunits(object))[ord])),
            Timeunit = unname(timeunits(object))[ord]),
      quote = FALSE, row.names = FALSE))
    out[[10]] <- capture.output(cat("\n"))

    ### objects loaded
    out[[11]] <- capture.output(cat(">> Objects Loaded:\n"))

    out[[12]] <- if (NROW(inputs(object)[na.omit(inputs(object)$loaded == TRUE), ])) {
      capture.output(print(inputs(object)[na.omit(inputs(object)$loaded == TRUE), ]))
    }
    out[[13]] <- capture.output(cat("\n"))

    ### list stored objects
    out[[14]] <- capture.output(cat(">> Objects stored:\n"))
    env <- envir(object)
    nms <- ls(env)
    lazyNms  <- if (length(nms)) nms[rlang::env_binding_are_lazy(env, nms)] else character(0)
    eagerNms <- setdiff(nms, lazyNms)
    out[[15]] <- capture.output({
      if (length(eagerNms)) print(ls.str(env, name = eagerNms))
      if (length(lazyNms))  cat("Lazy (not yet loaded):", paste(sort(lazyNms), collapse = ", "), "\n")
    })
    out[[16]] <- capture.output(cat("\n"))

    ### params
    omit <- which(names(params(object)) == ".progress")

    p <- mapply(
      function(x, y) {
        vals <- I(as.list(y))
        isFun <- vapply(vals, is.function, FUN.VALUE = logical(1))
        vals[isFun] <- lapply(vals[isFun], format)


        if (length(names(y)) > 0)
          data.frame(Module = x, Parameter = names(y), Value = vals,
                     stringsAsFactors = FALSE, row.names = NULL)
      },
      x = names(params(object))[-omit],
      y = params(object)[-omit],
      USE.NAMES = TRUE, SIMPLIFY = FALSE
    )
    if (length(p)) {
      q <- do.call(rbind, p)
      q <- q[order(q$Module, q$Parameter), ]
    } else {
      q <- cbind(Module = list(), Parameter = list())
    }
    out[[17]] <- capture.output(cat(">> Parameters:\n"))
    out[[18]] <- capture.output(print(q, row.names = FALSE))
    out[[19]] <- capture.output(cat("\n"))

    ### completed events
    out[[20]] <- capture.output(cat(">> Completed Events:\n"))
    out[[21]] <- capture.output(completed(object))
    out[[22]] <- capture.output(cat("\n"))

    ### Current events
    out[[23]] <- capture.output(cat(">> Current Event:\n"))
    out[[24]] <- capture.output(current(object))
    out[[25]] <- capture.output(cat("\n"))

    ### scheduled events
    out[[26]] <- capture.output(cat(">> Scheduled Events:\n"))
    out[[27]] <- capture.output(events(object))
    out[[28]] <- capture.output(cat("\n"))

    ### print result
    cat(unlist(out), fill = FALSE, sep = "\n")
})

# environment ---------------------------------------------------------------------------------

#' Simulation environment
#'
#' Accessor functions for the `.xData` slot, which is the default virtual
#' slot for an S4 class object that inherits from an S3 object (specifically,
#' the `simList` inherits from `environment`) in a `simList` object.
#' These are included for advanced users.
#'
#' Currently, only get and set methods are defined. Subset methods are not.
#'
#' @inheritParams objs
#'
#' @param value The object to be stored at the slot.
#'
#' @return Returns or sets the value of the slot from the `simList` object.
#'
#' @seealso [SpaDES.core-package], specifically the section 1.2.8 on `simList` environment.
#'
#' @aliases simList-accessors-envir
#' @author Alex Chubaty
#' @export
#' @family functions to access elements of a 'simList' object
#' @include simList-class.R
#' @rdname simList-accessors-envir
#'
setGeneric("envir", function(sim) {
  standardGeneric("envir")
})

#' @rdname simList-accessors-envir
setMethod("envir",
          signature = "simList",
          definition = function(sim) {
            return(sim@.xData)
})

#' @export
#' @rdname simList-accessors-envir
setGeneric("envir<-",
           function(sim, value) {
             standardGeneric("envir<-")
})

#' @name envir<-
#' @aliases envir<-,simList-method
#' @rdname simList-accessors-envir
setReplaceMethod("envir",
                 signature = "simList",
                 function(sim, value) {
                   if (!is.environment(value)) stop("Must be an environment")
                   sim@.xData <- value
                   return(sim)
})

# objects -------------------------------------------------------------------------------------

#' Extract or replace an object from the simulation environment
#'
#' The `[[` and `$` operators provide "shortcuts" for accessing
#' objects in the simulation environment.
#' I.e., instead of using `envir(sim)$object` or `envir(sim)[["object"]]`,
#' one can simply use `sim$object` or `sim[["object"]]`.
#'
#' `objs` can take `...` arguments passed to `ls`,
#' allowing, e.g. `all.names=TRUE`
#' `objs<-` requires takes a named list of values to be assigned in
#' the simulation environment.
#'
#' @param sim A `simList` object from which to extract element(s) or in which to replace element(s).
#' @param value objects to assign to the `simList`
#' @param ... passed to `ls`
#'
#' @return Returns or sets a list of objects in the `simList` environment.
#'
#' @family functions to access elements of a 'simList' object
#' @seealso [SpaDES.core-package], specifically the section 1.2.1 on Simulation Parameters.
#'
#' @export
#' @include simList-class.R
#' @aliases simList-accessors-objects
#' @rdname objects
#'
setGeneric("objs", function(sim, ...) {
  standardGeneric("objs")
})

#' @export
#' @rdname objects
setMethod("objs",
          signature = "simList",
          definition = function(sim, ...) {
            w <- lapply(ls(sim@.xData, ...), function(z) {
              eval(parse(text = z), envir = sim@.xData)
            })
            names(w) <- ls(sim@.xData, ...)
            return(w)
})

#' @export
#' @rdname objects
setGeneric("objs<-",
           function(sim, value) {
             standardGeneric("objs<-")
})

#' @name objs<-
#' @aliases objs<-,simList-method
#' @rdname objects
#' @export
setReplaceMethod(
  "objs",
  signature = "simList",
  function(sim, value) {
    if (is.list(value)) {
     list2env(value, envir = sim@.xData)
     newInputs <- data.frame(
       objectName = names(value),
       loadTime = as.numeric(sim@simtimes[["current"]]),
       loaded = TRUE,
       stringsAsFactors = FALSE) |> .fillInputRows(startTime = start(sim))
     inputs(sim) <- rbind(inputs(sim), newInputs)

    # lapply(names(value), function(z) {
    #   sim@.xData[[z]] <- value[[z]]
    # })
    } else {
     stop("must provide a named list.")
    }
    validObject(sim)
    return(sim)
})

# modules -------------------------------------------------------------------------------------

#' Simulation modules and dependencies
#'
#' Accessor functions for the `depends` and `modules` slots in a `simList` object.
#' These are included for advanced users.
#' \tabular{ll}{
#'    [depends()] \tab List of simulation module dependencies. (advanced) \cr
#'    [modules()] \tab List of simulation modules to be loaded. (advanced) \cr
#'    [inputs()] \tab List of loaded objects used in simulation. (advanced) \cr
#' }
#'
#' Currently, only get and set methods are defined. Subset methods are not.
#'
#' @inheritParams objs
#'
#' @param value The object to be stored at the slot.
#'
#' @param hidden Logical. If TRUE, show the default core modules.
#'
#' @return Returns or sets the value of the slot from the `simList` object.
#'
#' @family functions to access elements of a 'simList' object
#' @seealso [SpaDES.core-package], specifically the section 1.2.7 on Modules and dependencies.
#'
#' @aliases simList-accessors-modules
#' @author Alex Chubaty
#' @export
#' @include simList-class.R
#' @rdname simList-accessors-modules
setGeneric("modules", function(sim, hidden = FALSE) {
  standardGeneric("modules")
})

#' @rdname simList-accessors-modules
setMethod(
  "modules",
  signature = "simList",
  definition = function(sim, hidden) {
    if (hidden) {
      mods <- sim@modules
    } else {
      hiddenMods <- unlist(sim@modules) %in% (.pkgEnv$.coreModules |> unlist())
      mods <- sim@modules[!hiddenMods]
    }
    return(mods)
})

#' @export
#' @rdname simList-accessors-modules
setGeneric("modules<-",
           function(sim, value) {
             standardGeneric("modules<-")
})

#' @name modules<-
#' @aliases modules<-,simList-method
#' @rdname simList-accessors-modules
setReplaceMethod("modules",
                 signature = "simList",
                 function(sim, value) {
                   sim@modules <- value
                   validObject(sim)
                   return(sim)
})

# dependencies -------------------------------------------------------------------------------

#' @inheritParams modules
#' @export
#' @include simList-class.R
#' @rdname simList-accessors-modules
#'
setGeneric("depends", function(sim) {
  standardGeneric("depends")
})

#' @export
#' @rdname simList-accessors-modules
setMethod("depends",
          signature("simList"),
          definition = function(sim) {
            return(sim@depends)
})

#' @export
#' @rdname simList-accessors-modules
setGeneric("depends<-",
           function(sim, value) {
             standardGeneric("depends<-")
})

#' @name depends<-
#' @aliases depends<-,simList-method
#' @rdname simList-accessors-modules
#' @export
setReplaceMethod("depends",
                 signature("simList"),
                 function(sim, value) {
                   sim@depends <- value
                   validObject(sim)
                   return(sim)
})

# namespacing ---------------------------------------------------------------------------------

#' Namespacing within `SpaDES`
#'
#' This will only return the module name if it is inside a `spades` call,
#' i.e., it will return `NULL` if used in interactive mode.
#' The related function `currentModule` is simply a rapid accessor for the
#' current module name. This latter will return the module that is in the current
#' event queue, which will never be `NULL`.
#'
#' @inheritParams modules
#'
#' @return `.callingModuleName` returns the name of the module that is currently
#' the active module calling functions like `scheduleEvent`.
#'
#' @author Eliot McIntire
#' @export
#' @importFrom reproducible .grepSysCalls
#' @include simList-class.R
#' @rdname namespacing
#'
setGeneric(".callingModuleName", function(sim) {
  standardGeneric(".callingModuleName")
})

#' @export
#' @rdname namespacing
setMethod(
  ".callingModuleName",
  signature = c("simList"),
  definition = function(sim) {
    # Only return module name if inside a spades call,
    #  because this only makes sense if there is an "active" module
    sc <- sys.calls()
    st <- .grepSysCalls(sc, pattern = "moduleCall")
    #rep(FALSE, length = length(sc))
    #st <- grepl(sc, pattern = "moduleCall")
    if (length(st)) {
      mod <- parse(text = "moduleCall") |>
        eval(envir = sys.frame(st[1] - 1)) |>
        strsplit(split = "\\.") |>
        (function(x) x[[1]][2])()
    } else {
      mod <- NULL
    }
    return(mod)
})

#' @export
#' @rdname namespacing
setGeneric("currentModule", function(sim) {
  standardGeneric("currentModule")
})

#' @export
#' @rdname namespacing
setMethod(
  "currentModule",
  signature = c("simList"),
  definition = function(sim) {
    ret <- sim@current$moduleName
    if (length(ret))
      return(ret)
    else
      return(character(0))
})

# params --------------------------------------------------------------------------------------

#' Get and set simulation parameters
#'
#' `params`, `P` and `Par` (an active binding, like "mod") access the parameter
#'  slot in the `simList`.
#' `params` has a replace method, so can be used to update a parameter value.
#'
#' @inheritParams objs
#'
#' @param value The parameter value to be set (in the corresponding `module` and `param`).
#'
#' @param module Optional character string indicating which module params should come from.
#'
#' @param param Optional character string indicating which parameter to choose.
#'
#' @return Returns or sets the value of the slot from the `simList` object.
#'
#' @note The differences between `P()`, `params()` and being explicit with passing arguments
#' are mostly a question of speed and code compactness.
#' The computationally fastest way to get a parameter is to specify `moduleName` and parameter name,
#' as in: `P(sim, "paramName", "moduleName")` (replacing `moduleName` and `paramName` with your
#' specific module and parameter names), but it is more verbose than `P(sim)$paramName`.
#' Note: the important part for speed (e.g., 2-4x faster) is specifying the `moduleName`.
#' Specifying the parameter name is <5% faster.
#'
#' @family functions to access elements of a 'simList' object
#' @seealso [SpaDES.core-package], specifically the section 1.2.1 on Simulation parameters.
#'
#' @aliases parameters
#' @aliases simList-accessors-params
#' @export
#' @include simList-class.R
#' @rdname params
setGeneric("params", function(sim) {
  standardGeneric("params")
})

#' @export
#' @rdname params
setMethod("params",
          signature = "simList",
          definition = function(sim) {
            return(sim@params)
})

#' @export
#' @rdname params
setGeneric("params<-",
           function(sim, value) {
             standardGeneric("params<-")
})

#' @name params<-
#' @aliases params<-,simList-method
#' @rdname params
#' @export
setReplaceMethod("params",
                 signature = "simList",
                 function(sim, value) {
                   sim@params <- value
                   validObject(sim)
                   return(sim)
})

#' `P` is a concise way to access parameters within a module. It works more like
#' a namespaced function in the sense that the module from which it is called is the
#' default place it will look for the parameter. To access a parameter from within
#' a module, you can use `P(sim)$paramName` instead of `params(sim)$moduleName$paramName`.
#' You can also use `Par`, which is an Active Binding to `P(sim)`.
#'
#' @aliases simList-accessors-params
#' @export
#' @importFrom reproducible .grepSysCalls
#' @importFrom utils getSrcFilename
#' @include simList-class.R
#' @rdname params
#' @examples
#' s <- simInit()
#' # add a parameter to tmp module
#' params(s)$tmp <- list(a = 1)
#'
#' # Only work inside a module, inside a function with `sim` is an argument
#' # P(s, "a") # get "a" parameter inside the current module
#' # Par$a     # same. Get "a" parameter inside the current module
#'
P <- function(sim, param, module) UseMethod("P")

#' @export
P.simList <- function(sim, param, module) {
  if (missing(sim)) stop("P takes a simList as first argument")
  # Check for changed order

  # first check if inside an event
  module1 <- sim@current$moduleName
  mods <- modules(sim)
  if (length(module1) == 0) {
    # then check if inside a .inputObjects call
    inSimInit <- .grepSysCalls(sys.calls(), pattern = "(^.parseModule)")
    if (length(inSimInit)) {
      inSimInit <- c(inSimInit + 1) # bump up one because S4 actually runs in a .local
      for (isi in inSimInit) {
        module1 <- get0("m", sys.frame(isi))
        if (!is.null(module1))
          break
      }
    } else {
      inManualCall <- .grepSysCalls(sys.calls(), pattern = "(\\.mods\\$|\\[)")
      if (length(inManualCall)) { # this is the case where a user calls the function using the full path
        #   sim$.mods$module$fn(sim)
        pp <- parse(text = sys.calls()[[inManualCall[1]]])
        gg <- gsub("^.+\\.mods(\\$|\\[\\[)", "", as.character(pp)[[1]])
        module1 <- strsplit(gg, split = "\\$|\\[")[[1]][1]
      } else {
        modFilePaths <- checkPath(names(mods))

        scalls <- sys.calls()
        whereInSC <- .grepSysCalls(scalls, "^P\\(|^SpaDES.core::P\\(")
        while (whereInSC > 1) {
          poss <- scalls[whereInSC - 1]
          fn <- as.character(poss[[1]][[1]])
          fn <- try(get(fn, envir = sys.frames()[whereInSC - 1][[1]]), silent = TRUE)
          if (!is(fn, "try-error")) {
            modulePath <- getSrcFilename(fn, full.names = TRUE)
            if (length(modulePath) > 0) {
              module1 <- lapply(modFilePaths, function(x) grep(pattern = x, checkPath(modulePath)))
              if (length(module1[[1]]) > 0)  break
            }
          }
          whereInSC <- whereInSC - 1
        }

        if (length(module1[[1]])) {
          module1 <- mods[[module1[[1]]]]
        }
      }
    }
  }

  reversalMessage <- paste0(
    "P has changed the order of its parameters, with 'param' now second to ",
    " allow for easier access to specific parameters inside a module. ",
    "It looks like this call to P is still using the old order with 'module' second. ",
    "Returning the old behaviour for now; this may not reliably work in the future. ",
    "Please change the order"
  )
  # This is to catch cases of reverse order -- order of args changed to sim, params, then module
  if (!missing(param)) {
    if (param %in% names(sim@params)) {# test if the param is a module name
      if (!missing(module)) {
        if (module %in% ls(sim@params[[param]], all.names = TRUE) ||
            module %in% .knownDotParams) {
          warning(reversalMessage)
          module1 <- param
          param <- module
        }
      } else { # module is missing; can't be reversal, but can be incorrect module --> params
        if (any(param %in% mods) && is.null(module1)) {
          module1 <- param
        }
        # module1 is in list of modules; param is not in parameters --> this is likely a reversal
        warning(reversalMessage)
        param <- NULL
      }
    } else {
      module1 <- module
    } # param is not a module name --> probably using new parameter order --> correct
  } else {
    param <- NULL
    if (!missing(module))
      module1 <- module
  }
  module <- module1

  if (length(module) == 0) {
    return(sim@params)
  }

  if (is.null(param)) {
    return(sim@params[[module]])
  } else {
    return(sim@params[[module]][[param]])
  }
}

#' @rdname params
#' @export
`P<-` <- function(sim, param, module, value) {
  if (missing(sim)) stop("P takes a simList as first argument")
  if (missing(module)) {
    # first check if inside an event
    module <- sim@current$moduleName
    if (length(module) == 0) {
      # then check if inside a .inputObjects call
      inSimInit <- .grepSysCalls(sys.calls(), pattern = "(^.parseModule)")
      if (any(inSimInit)) {
        module <- get("m", sys.frame(inSimInit[2]))
      }
    }
    if (length(module) == 0) {
      # if not in either place, it is a fail
      stop("Please specify module")
    }
  }
  if (missing(param)) {
    if (is(value, "list")) {
      if (all(names(P(sim, module = module)) %in% names(value))) {
        sim@params[[module]] <- value
      } else {
        stop("Please specify param as an argument")
      }
    } else {
      stop("Please specify param as an argument")
    }
  } else {
    sim@params[[module]][[param]] <- value
  }
  return(sim)
}

# globals -------------------------------------------------------------------------------------

#' Get and set global simulation parameters
#'
#' `globals`, and the alias `G`, accesses or sets the "globals"
#' in the `simList`. This currently is not an explicit slot in the `simList`,
#' but it is a `.globals` element in the `params` slot of the `simList`.
#'
#' @inheritParams params
#'
#' @family functions to access elements of a 'simList' object
#' @seealso [SpaDES.core-package], specifically the section 1.2.1 on Simulation Parameters.
#'
#' @export
#' @include simList-class.R
#' @rdname globals
setGeneric("globals", function(sim) {
  standardGeneric("globals")
})

#' @export
#' @rdname globals
setMethod("globals",
          signature = "simList",
          definition = function(sim) {
            return(sim@params$.globals)
})

#' @export
#' @rdname globals
setGeneric("globals<-",
           function(sim, value) {
             standardGeneric("globals<-")
})

#' @aliases globals<-,simList-method
#' @export
#' @name globals<-
#' @rdname globals
setReplaceMethod("globals",
                 signature = "simList",
                 function(sim, value) {
                   sim@params$.globals <- value
                   sim <- updateParamsFromGlobals(sim)
                   validObject(sim)
                   return(sim)
})

#' @export
#' @rdname globals
setGeneric("G", function(sim) {
  standardGeneric("G")
})

#' @export
#' @rdname globals
setMethod("G",
          signature = "simList",
          definition = function(sim) {
            return(sim@params$.globals)
})

#' @export
#' @rdname globals
setGeneric("G<-",
           function(sim, value) {
             standardGeneric("G<-")
})

#' @name G<-
#' @aliases G<-,simList-method
#' @rdname globals
#' @export
setReplaceMethod("G",
                 signature = "simList",
                 function(sim, value) {
                   sim@params$.globals <- value
                   validObject(sim)
                   return(sim)
})

# parameters ----------------------------------------------------------------------------------

#' @details
#' `parameters` will extract only the metadata with the metadata defaults,
#' NOT the current values that may be overwritten by a user. See examples.
#' @inheritParams params
#' @param asDF Logical. For `parameters`, if TRUE, this will produce a single
#'                 data.frame of all model parameters. If FALSE, then it will return
#'                 a data.frame with 1 row for each parameter within nested lists,
#'                 with the same structure as `params`.
#'
#' @include simList-class.R
#' @export
#' @rdname params
#' @examples
#' if (requireNamespace("SpaDES.tools", quietly = TRUE) &&
#'       packageVersion("SpaDES.tools") > "3.0.0") {
#'   opts <- options("spades.moduleCodeChecks" = FALSE) # not necessary for example
#'   modules <- list("randomLandscapes")
#'   paths <- list(modulePath = getSampleModules(tempdir()))
#'   mySim <- simInit(modules = modules, paths = paths,
#'                    params = list(.globals = list(stackName = "landscape")))
#'
#'   # update some parameters using assignment -- currently only params will work
#'   params(mySim)$randomLandscapes$nx <- 200
#'   params(mySim)$randomLandscapes$ny <- 200
#'
#'   parameters(mySim) # Does not contain these user overridden values
#'
#'   # These next 2 are same here because they are not within a module
#'   P(mySim)          # Does contain the user overridden values
#'   params(mySim)     # Does contain the user overridden values
#'
#'   # NOTE -- deleting a parameter will affect params and P, not parameters
#'   params(mySim)$randomLandscapes$nx <- NULL
#'   params(mySim)$randomLandscapes$ny <- NULL
#'
#'   parameters(mySim) # Shows nx and ny
#'
#'   # These next 2 are same here because they are not within a module
#'   P(mySim)          # nx and ny are Gone
#'   params(mySim)     # nx and ny are Gone
#'
#'   options(opts) # reset
#' }
setGeneric("parameters", function(sim, asDF = FALSE) {
  standardGeneric("parameters")
})

#' @export
#' @rdname params
setMethod("parameters",
          signature = "simList",
          definition = function(sim, asDF) {
            if (any(!unlist(lapply(sim@depends@dependencies, is.null)))) {
              if (asDF) {
                tmp <- lapply(sim@depends@dependencies, function(x) {
                  out <- x@parameters
                })
                tmp <- do.call(rbind, tmp)
              } else {
                tmp <- lapply(sim@depends@dependencies, function(x) {
                  out <- lapply(seq_len(NROW(x@parameters)),
                                function(y) x@parameters[y, -1])
                  names(out) <- x@parameters$paramName
                  out
                })
              }
            } else {
              tmp <- NULL
            }
            return(tmp)
})

# checkpoint ----------------------------------------------------------------------------------

#' @inheritParams params
#' @export
#' @include simList-class.R
#' @rdname checkpoint
#' @family functions to access elements of a 'simList' object
#'
setGeneric("checkpointFile", function(sim) {
  standardGeneric("checkpointFile")
})

#' @export
#' @rdname checkpoint
setMethod("checkpointFile",
          signature = "simList",
          definition = function(sim) {
            return(sim@params$checkpoint$file)
})

#' @export
#' @rdname checkpoint
setGeneric("checkpointFile<-",
           function(sim, value) {
             standardGeneric("checkpointFile<-")
})

#' @name checkpointFile<-
#' @aliases checkpointFile<-,simList-method
#' @rdname checkpoint
#' @export
setReplaceMethod("checkpointFile",
                 signature = "simList",
                 function(sim, value) {
                   sim@params$checkpoint$file <- value
                   validObject(sim)
                   return(sim)
})

#' @inheritParams params
#' @export
#' @include simList-class.R
#' @rdname checkpoint
#'
setGeneric("checkpointInterval", function(sim) {
  standardGeneric("checkpointInterval")
})

#' @export
#' @rdname checkpoint
setMethod("checkpointInterval",
          signature = "simList",
          definition = function(sim) {
            return(sim@params$checkpoint$interval)
})

#' @export
#' @rdname checkpoint
setGeneric("checkpointInterval<-",
           function(sim, value) {
             standardGeneric("checkpointInterval<-")
})

#' @name checkpointInterval<-
#' @aliases checkpointInterval<-,simList-method
#' @rdname checkpoint
#' @export
setReplaceMethod("checkpointInterval",
                 signature = "simList",
                 function(sim, value) {
                   sim@params$checkpoint$interval <- value
                   validObject(sim)
                   return(sim)
})

# progress ------------------------------------------------------------------------------------

#' Get and set simulation progress bar details
#'
#' The progress bar can be set in two ways in SpaDES. First, by setting values
#' in the `.progress` list element in the params list element passed to [simInit()].
#' Second, at the [spades()] call itself, which can be simpler. See examples.
#'
#' @details Progress Bar:
#' Progress type can be one of  `"text"`, `"graphical"`, or `"shiny"`.
#' Progress interval can be a numeric.
#' These both can get set by passing a
#' `.progress = list(type = "graphical", interval = 1)` into the `simInit` call.
#' See examples.
#'
#' @inheritParams params
#'
#' @return for `progressInterval`, a numeric corresponding to the progress update interval;
#'         for `progressInterval<-`, an updated `simList` object.
#'
#' @export
#' @family functions to access elements of a 'simList' object
#' @include simList-class.R
#' @rdname progress
#'
#' @examples
#' \donttest{
#' if (requireNamespace("SpaDES.tools", quietly = TRUE) &&
#'       packageVersion("SpaDES.tools") > "3.0.0") {
#' opts <- options("spades.moduleCodeChecks" = FALSE) # not necessary for example
#' mySim <- simInit(
#'   times = list(start=0.0, end=100.0),
#'   params = list(.globals = list(stackName = "landscape"),
#'   .progress = list(type = "text", interval = 10),
#'   checkpoint = list(interval = 10, file = "chkpnt.RData")),
#'   modules = list("randomLandscapes"),
#'   paths = list(modulePath = getSampleModules(tempdir()))
#' )
#'
#' # progress bar
#' progressType(mySim) # "text"
#' progressInterval(mySim) # 10
#'
#' # parameters
#' params(mySim) # returns all parameters in all modules
#'               # including .global, .progress, checkpoint
#' globals(mySim) # returns only global parameters
#'
#' # checkpoint
#' checkpointFile(mySim) # returns the name of the checkpoint file
#'                       # In this example, "chkpnt.RData"
#' checkpointInterval(mySim) # 10
#'
#' options(opts) # reset
#' }}
setGeneric("progressInterval", function(sim) {
  standardGeneric("progressInterval")
})

#' @export
#' @rdname progress
setMethod("progressInterval",
          signature = "simList",
          definition = function(sim) {
            return(sim@params$.progress$interval)
})

#' @export
#' @rdname progress
setGeneric("progressInterval<-",
           function(sim, value) {
             standardGeneric("progressInterval<-")
})

#' @name progressInterval<-
#' @aliases progressInterval<-,simList-method
#' @rdname progress
#' @export
setReplaceMethod("progressInterval",
                 signature = "simList",
                 function(sim, value) {
                   sim@params$.progress$interval <- value
                   validObject(sim)
                   return(sim)
})

#' @inheritParams params
#' @include simList-class.R
#' @export
#' @rdname progress
#'
setGeneric("progressType", function(sim) {
  standardGeneric("progressType")
})

#' @export
#' @rdname progress
setMethod("progressType",
          signature = "simList",
          definition = function(sim) {
            return(sim@params$.progress$type)
})

#' @export
#' @rdname progress
setGeneric("progressType<-",
           function(sim, value) {
             standardGeneric("progressType<-")
})

#' @name progressType<-
#' @aliases progressType<-,simList-method
#' @rdname progress
#' @export
setReplaceMethod("progressType",
                 signature = "simList",
                 function(sim, value) {
                   sim@params$.progress$type <- as.character(value)
                   validObject(sim)
                   return(sim)
})

# inputs --------------------------------------------------------------------------------------

#' Simulation inputs
#'
#' Accessor functions for the `inputs` slots in a `simList` object.
#'
#' These functions are one of three mechanisms to add the information about which input files
#' to load in a `spades` call.
#' \enumerate{
#'   \item As arguments to a `simInit` call. Specifically, `inputs` or `outputs`.
#'         See `?simInit`.
#'   \item With the `outputs(simList)` function call.
#'   \item By adding a function called `.inputObjects` inside a module, which will be executed
#'         during the `simInit` call. This last way is the most "modular" way to create
#'         default data sets for your model.
#' }
#'
#' See below for more details.
#'
#' @section inputs function or argument in `simInit`:
#'
#' `inputs` accepts a data.frame, with up to 7 columns.
#' Columns are:
#'
#' \tabular{ll}{
#' `file` \tab required, a character string indicating the file path. There is no
#' default.\cr
#'
#' `objectName` \tab optional, character string indicating the name of the object
#' that the loaded file will be assigned to in the `simList`. This object
#' can therefore be accessed with `sim$xxx` in any module, where
#' `objectName = "xxx"`. Defaults to the filename without file extension or
#' directory information.\cr
#'
#' `fun` \tab optional, a character string indicating the function to use to
#' load that file. Defaults to the known extensions in `SpaDES` (found by
#' examining `.fileExtensions()`). The `package` and `fun` can be
#' jointly specified here as `"packageName::functionName"`, e.g.,
#' `"terra::rast"`.\cr
#'
#' `package` \tab optional character string indicating the package in
#' which to find the `fun`);\cr
#'
#' `loadTime` \tab optional numeric, indicating when in simulation time the file
#' should be loaded. The default is the highest priority at `start(sim)`,
#' i.e., at the very start. \cr
#'
#' `interval` \tab optional numeric, indicating at what interval should this same
#' exact file  be reloaded from disk, e.g,. 10 would mean every 10 time units. The
#' default is NA or no interval, i.e, load the file only once as described in
#' `loadTime` \cr
#'
#' `arguments` \tab is a list of lists of named arguments, one list for each
#' `fun`. For example, if `fun="raster"`, `arguments = list(native = TRUE)`
#' will pass the argument "native = TRUE" to raster.  If there is only one list,
#' then it is assumed to apply to all files and will be recycled as per normal R
#' rules of recycling for each `fun`.\cr
#' }
#'
#' Currently, only `file` is required. All others will be filled with defaults
#' if not specified.
#'
#' See the modules vignette for more details (`browseVignettes("SpaDES.core")`).
#'
#' @section `.inputObjects` function placed inside module:
#'
#' Any code placed inside a function called `.inputObjects` will be run during
#' `simInit()` for the purpose of creating any objects required by this module,
#' i.e., objects  identified in the `inputObjects` element of `defineModule`.
#' This is useful if there is something required before simulation to produce the module
#' object dependencies, including such things as downloading default datasets, e.g.,
#' `downloadData('LCC2005', modulePath(sim))`.
#' Nothing should be created here that does not create an named object in `inputObjects`.
#' Any other initiation procedures should be put in the "init" `eventType` of the `doEvent` function.
#' Note: the module developer can use `sim$.userSuppliedObjNames` inside the function to
#' selectively skip unnecessary steps because the user has provided those `inputObjects` in the
#' `simInit` call. e.g., the following code would look to see if the user had passed `defaultColor`
#' into during `simInit`. If the user had done this, then this function would not override
#' that value with 'red'. If the user has not passed in a value for `defaultColor`, then
#' the module will get it here:
#'
#' \code{if (!('defaultColor' \%in\% sim$.userSuppliedObjNames)) \{
#'  sim$defaultColor <- 'red'
#' \}}
#'
#' @inheritParams objs
#'
#' @param value The object to be stored at the slot. See Details.
#'
#' @return Returns or sets the value(s) of the `input` or `output` slots
#' in the `simList` object.
#'
#' @family functions to access elements of a 'simList' object
#' @seealso [SpaDES.core-package], specifically the section 1.2.2 on loading and saving.
#'
#' @include simList-class.R
#' @importFrom data.table is.data.table
#' @importFrom stats na.omit
#' @export
#' @name inputs
#' @aliases simList-accessors-inout
#' @rdname simList-accessors-inputs
#' @example inst/examples/example_inputs.R
setGeneric("inputs", function(sim) {
  standardGeneric("inputs")
})

#' @export
#' @rdname simList-accessors-inputs
setMethod("inputs",
          signature = "simList",
          definition = function(sim) {

            simUnit <- sim@simtimes[["timeunit"]]
            loadTimeUnit <- attr(sim@inputs$loadTime, "unit")
            if (is.null(loadTimeUnit)) loadTimeUnit <- simUnit
            out <- if (is.na(pmatch(loadTimeUnit, simUnit)) &
                       (length(sim@inputs$loadTime) > 0)) {
              # note the above line captures empty loadTime,
              # whereas is.na does not
              if (any(!is.na(sim@inputs$loadTime))) {
                if (!is.null(sim@inputs$loadTime)) {
                  obj <- copy(sim@inputs) # don't change original sim
                  set(obj, NULL, j = "loadTime", convertTimeunit(obj$loadTime, obj$unit, sim@.xData))
                  #obj[, loadTime := convertTimeunit(loadTime, unit, sim@.xData)]
                  obj[]
                }
              } else {
                sim@inputs
              }
            } else {
              sim@inputs
            }

            return(out)
})

#' @export
#' @rdname simList-accessors-inputs
setGeneric("inputs<-",
           function(sim, value) {
             standardGeneric("inputs<-")
})

#' @name inputs<-
#' @aliases inputs<-,simList-method
#' @rdname simList-accessors-inputs
#' @export
setReplaceMethod(
  "inputs",
  signature = "simList",
  function(sim, value) {
    if (length(value) > 0) {
      whFactors <- sapply(value, function(x) is.factor(x))
      if (any(whFactors)) {
        value[, whFactors] <- sapply(value[, whFactors], as.character)
      }

      if (!is.data.frame(value)) {
        if (!is.list(value)) {
          stop("inputs must be a list, data.frame")
        }
        value <- data.frame(value, stringsAsFactors = FALSE)
      }
      sim@inputs <- .fillInputRows(value, start(sim))
    } else {
      sim@inputs <- value
    }
    # Deal with objects and files differently... if files (via inputs arg in simInit)...
    # Deal with file names
    # 2 things: 1. if relative, concatenate inputPath
    #           2. if absolute, don't use inputPath
    if (NROW(value) > 0) {
      sim@inputs[["file"]][is.na(sim@inputs$file)] <- NA

      # If a filename is provided, determine if it is absolute path, if so,
      # use that, if not, then append it to inputPath(sim)
      isAP <- isAbsolutePath(as.character(sim@inputs$file))
      sim@inputs[["file"]][!isAP & !is.na(sim@inputs$file)] <-
        file.path(inputPath(sim),
                  sim@inputs[["file"]][!isAP & !is.na(sim@inputs$file)])

      if (!all(names(sim@inputs) %in% .fileTableInCols)) {
        stop(paste("input table can only have columns named",
                   paste(.fileTableInCols, collapse = ", ")))
      }
      if (any(is.na(sim@inputs[["loaded"]]))) {
        if (!all(is.na(sim@inputs[["loadTime"]]))) {
          newTime <- sim@inputs[["loadTime"]][is.na(sim@inputs$loaded)]
          attributes(newTime)$unit <- sim@simtimes[["timeunit"]]

          for (nT in newTime) {
            attributes(nT)$unit <- timeunit(sim)
            sim <- scheduleEvent(sim, nT, "load", "inputs", .first() - 1)
          }
          toRemove <- duplicated(rbindlist(list(current(sim), events(sim))),
                                 by = c("eventTime", "moduleName", "eventType"))
          if (any(toRemove)) {
            if (NROW(current(sim)) > 0)
              toRemove <- toRemove[-seq_len(NROW(current(sim)))]
            events(sim) <- events(sim)[!toRemove]
          }

        } else {
          sim@inputs[["loadTime"]][is.na(sim@inputs$loadTime)] <- sim@simtimes[["current"]]
          newTime <- sim@inputs[["loadTime"]][is.na(sim@inputs$loaded)] |>
            min(na.rm = TRUE)
          attributes(newTime)$unit <- "seconds"
          sim <- scheduleEvent(sim, newTime, "load", "inputs", .first() - 1)
        }
      }
    }
    possNewUSON <- inputs(sim)$objectName
    sim$.userSuppliedObjNames <- if (is.null(sim$.userSuppliedObjNames)) {
      possNewUSON
    } else {
      unique(c(sim$.userSuppliedObjNames, possNewUSON))
    }

    return(sim)
})

# outputs -------------------------------------------------------------------------------------

#' Simulation outputs
#'
#' Accessor functions for the `outputs` slots in a `simList` object.
#'
#' These functions are one of three mechanisms to add information about which output files to save.
#' \enumerate{
#'   \item As arguments to a `simInit` call. Specifically, `inputs` or `outputs`.
#'         See `?simInit`.
#'   \item With the `outputs(simList)` function call.
#'   \item By adding a function called `.inputObjects` inside a module, which will be executed
#'         during the `simInit` call. This last way is the most "modular" way to create
#'         default data sets for your model.
#' }
#'
#' See below for more details.
#'
#' @section outputs function or argument in `simInit`:
#'
#' `outputs` accepts a data.frame similar to the `inputs` data.frame, but
#' with up to 7 columns.
#'
#' \tabular{ll}{
#' `objectName` \tab required, character string indicating the name of the object
#' in the `simList` that will be saved to disk (without the `sim$` prefix).\cr
#'
#' `file` \tab optional, a character string indicating the file path to save to.
#' The default is to concatenate `objectName` with the model timeunit and
#' `saveTime`, separated by underscore, '`_`'. So a default filename would be
#' `"Fires_year1.rds"`.\cr
#'
#' `fun` \tab optional, a character string indicating the function to use to
#' save that file. The default is [saveRDS()] \cr
#'
#' `package` \tab optional character string indicating the package in
#' which to find the `fun`);\cr
#'
#' `saveTime` \tab optional numeric, indicating when in simulation time the file
#' should be saved. The default is the lowest priority at `end(sim)`,
#' i.e., at the very end. \cr
#'
#' `arguments` \tab optional list of lists of named arguments, one list for each
#' `fun`. For example, if `fun = "write.csv"`,
#' `arguments = list(row.names = TRUE)` will pass the argument
#' `row.names = TRUE` to `write.csv`  If there is only one list,
#' then it is assumed to apply to all files and will be recycled as per normal R
#' rules of recycling for each `fun`.\cr
#'
#' `eventPriority` \tab optional numeric setting the priority given to saving the
#'  specified object. If not set, it defaults to `.last()`. If set to a low value,
#'  e.g., 0, 1, 2 and `saveTime` is `start(sim)`, it should give "initial conditions"
#'  at `saveTime`.
#' }
#'
#' See the modules vignette for more details (`browseVignettes("SpaDES.core")`).
#'
#' @note The automatic file type handling only adds the correct extension from a given
#' `fun` and `package`. It does not do the inverse, from a given extension find the
#' correct `fun` and `package`.
#'
#' @inheritParams inputs
#'
#' @export
#' @include simList-class.R
#' @importFrom data.table := data.table
#' @importFrom stats na.omit
#' @seealso [registerOutputs()] which enables files that are saved to be added to
#' the `simList` using the `outputs(sim)` mechanism, so the files that are saved
#' during a module event can be tracked at the `simList` level. [saveSimList()]
#' which will optionally add all the outputs that are tracked into an archive.
#'
#' @name outputs
#' @rdname simList-accessors-outputs
#'
#' @example inst/examples/example_outputs.R
setGeneric("outputs", function(sim) {
  standardGeneric("outputs")
})

#' @export
#' @rdname simList-accessors-outputs
setMethod(
  "outputs",
  signature = "simList",
  definition = function(sim) {
    simUnit <- sim@simtimes[["timeunit"]]
    saveTimeUnit <- attr(sim@outputs$saveTime, "unit")
    if (is.null(saveTimeUnit)) saveTimeUnit <- simUnit

    out <- if (is.na(pmatch(saveTimeUnit, simUnit)) &
               length(sim@outputs$saveTime) > 0) {
      ## note the above line captures empty saveTime, whereas is.na does not
      if (any(!is.na(sim@outputs$saveTime))) {
        if (!is.null(sim@outputs$saveTime)) {
          obj <- copy(sim@outputs) # don't change original sim
          obj[, saveTime := convertTimeunit(saveTime, unit, sim@.xData)]
          obj[]
          obj
        }
      } else {
        sim@outputs
      }
    } else {
      sim@outputs
    }
    return(out)
  })

#' @export
#' @rdname simList-accessors-outputs
setGeneric("outputs<-",
           function(sim, value) {
             standardGeneric("outputs<-")
})

#' @aliases outputs<-,simList-method
#' @export
#' @importFrom data.table setDT
#' @importFrom tools file_ext
#' @name outputs<-
#' @rdname simList-accessors-outputs
setReplaceMethod(
  "outputs",
  signature = "simList",
  function(sim, value) {
    if (NROW(value)) {
       if (!is.data.frame(value)) {
         if (!is.list(value)) {
           stop("outputs must be a list or data.frame")
         }
         value <- data.frame(value, stringsAsFactors = FALSE)
       }

       sim@outputs <- .fillOutputRows(value, end(sim))

       ## coerce any factors to the correct class
       for (col in which(sapply(sim@outputs, is.factor))) {
         sim@outputs[[col]] <- as(sim@outputs[[col]], class(.fileTableOut()[[col]]))
       }

       ## if saveTime not provided, give it end(sim)
       sim@outputs[["saveTime"]][is.na(sim@outputs$saveTime)] <-
         end(sim, sim@simtimes[["timeunit"]])
       attributes(sim@outputs$saveTime)$unit <- sim@simtimes[["timeunit"]]

       ## Deal with file names
       ## 3 things: 1. if relative, concatenate outputPath
       ##           2. if absolute, don't use outputPath
       ##           3. concatenate time to file name in all cases
       ## If no filename provided, use the object name
       sim@outputs[["file"]][is.na(sim@outputs$file)] <-
         paste0(sim@outputs$objectName[is.na(sim@outputs$file)])
       ## If a filename is provided, determine if it is absolute path, if so,
       ## use that, if not, then append it to outputPath(sim)

       normedOP <- normalizePath(outputPath(sim), winslash = "/", mustWork = FALSE)
       alreadyWithOutputPath <- grepl(pattern = paste0("^", normedOP), sim@outputs$file)

       # alreadyWithOutputPath <- grepl(pattern = paste0("^", normPath(outputPath(sim))), sim@outputs$file)
       # alreadyWithOutputPath <- grepl(pattern = paste0("^", outputPath(sim)), sim@outputs$file)
       if (any(!alreadyWithOutputPath)) {
         isAP <- isAbsolutePath(as.character(sim@outputs$file))

         sim@outputs[["file"]][!isAP[!alreadyWithOutputPath]] <-
           file.path(outputPath(sim), sim@outputs[["file"]][!isAP])
       }

       ## If there is no function provided, then use saveRDS, from package base
       sim@outputs[["fun"]][is.na(sim@outputs$fun)] <- "saveRDS"
       sim@outputs[["package"]][is.na(sim@outputs$package)] <- "base"

       ## file extension stuff
       fileExts <- .saveFileExtensions()
       fileExtsHere <- setDT(fileExts)[setDT(sim@outputs[, c("fun", "package")]),
                                       on = c("fun", "package")]
       fe <- fileExtsHere$exts

       ## grep allows for file extensions from 1 to 5 characters
       wh <- !grepl(pattern = "\\..{1,5}$", sim@outputs$file) & nzchar(fe, keepNA = TRUE)
       if (anyNA(fe[wh])) {
         messageDF(unique(fileExtsHere), verbose = TRUE)
         stop("outputs(sim) are specified along with fun and package, but no file extension. ",
              "Please set `options('spades.saveFileExtensions' = xxx)` where `xxx` is a ",
              "data.frame where column `exts` that specifies file extension is not NA ",
              "(see example message above and also described in ?spadesOptions)")
       }
       sim@outputs[["file"]][wh] <- paste0(sim@outputs[["file"]][wh], ".", fe[wh])

       ## If the file name already has a time unit on it,
       ## i.e., passed explicitly by user, then don't postpend again
       txtTimeA <- paste0(attr(sim@outputs[["saveTime"]], "unit"))
       txtTimeB <- paddedFloatToChar(
         sim@outputs[["saveTime"]],
         ceiling(log10(end(sim, sim@simtimes[["timeunit"]]) + 1))
       )
       # Add time unit and saveTime to filename, without stripping extension
       wh <- !grepl(txtTimeA, sim@outputs$file)
       fns <- sim@outputs[["file"]][wh]
       sim@outputs[["file"]][wh] <- paste0(
         tools::file_path_sans_ext(fns),
         "_", txtTimeA, txtTimeB[wh],
         ifelse(nzchar(tools::file_ext(fns), keepNA = TRUE) , ".", ""),
         ifelse(nzchar(tools::file_ext(fns), keepNA = TRUE) , tools::file_ext(fns), "")
       )
     } else {
       sim@outputs <- value
     }

     if (!all(.fileTableOutCols %in% names(sim@outputs))) {
       stop(paste("output table must have columns named",
                  paste(.fileTableOutCols, collapse = ", ")))
     }

    return(sim)
})

outputsAppend <- function(outputs, saveTime, objectName = NA, file = NA, fun = NA,
                          args = I(list(NA)), ...) {
  if (!is(args, "list") && !is(args, "AsIs")) {
    stop("args must a list (with same length as file) of lists (with named elements), ",
         ", wrapped with I(  )")
  }
  if (length(args) < length(file)) {
    args <- I(rep(args, length(file)))
  }
  df <- data.frame(file = file, saved = TRUE, objectName = objectName, fun = fun, args = args)

  outs <- .fillOutputRows(df, endTime = saveTime)
  if (!is(outputs[[.txtArguments]], "AsIs")) {
    ## needed for rbindlist
    outputs[[.txtArguments]] <- I(outputs[[.txtArguments]])
  }
  rbindlist(list(outputs, outs), use.names = TRUE, fill = TRUE)
}

#' Add file name of a saved object to `outputs(sim)`
#'
#' If a module saves a file to disk during events, it can be useful to keep track
#' of the files that are saved e.g., for [saveSimList()] so that all files can
#' be added to the archive. In addition to setting `outputs` at the `simInit`
#' stage, a module developer can also put this in a using any saving mechanism that
#' is relevant (e.g., `qs2::qs_save`, `saveRDS` etc.). When a module event does this
#' it can be useful to register that saved file. `registerOutputs` offers an additional
#' mechanism to do this. See examples.
#'
#' @export
#' @name registerOutputs
#' @rdname simList-accessors-outputs
#' @param sim A `simList`. If missing, then the function will search in the call
#'    stack, so it will find it if it is in a `SpaDES` module.
#' @param filename The filename to register in the `outputs(sim)` data.frame. If
#'    missing, an attempt will be made to search for either a `file` or `filename`
#'    argument in the call itself. This means that this function can be used with
#'    the pipe, as long as the returned return from the upstream pipe function is
#'    a filename or if it is `NULL` (e.g., `saveRDS`), then it will find the `file`
#'    argument and use that.
#' @param ... Not used.
#'
#' @details
#' Note using `registerOutputs`: a user can pass any other
#' arguments to `registerOutputs` that are in the
#' `outputs(sim)` data.frame, such as `objectName`, `fun`, `package`, though these
#' will not be used to save the files as this function is only about
#' registering an output that has already been saved.
#'
#' @seealso [Plots()], [outputs()]
#' @return A `simList` which will be the `sim` passed in with a new object registered
#'   in the `outputs(sim)`
#' @examples
#' # For `registerOutputs`
#' sim <- simInit()
#' # This would normally be a save call, e.g., `writeRaster`
#' tf <- reproducible::tempfile2(fileext = ".tif")
#' sim <- registerOutputs(sim, filename = tf)
#'
#' # Using a pipe
#' tf <- reproducible::tempfile2(fileext = ".rds")
#' sim$a <- 1
#' sim <- saveRDS(sim$a, tf) |> registerOutputs()
#' # confirm:
#' outputs(sim) # has object --> saved = TRUE
#'
registerOutputs <- function(filename, sim, ...) {
  fn <- substitute(filename)

  simIsIn <- NULL
  simIsIn <- parent.frame() # try for simplicity sake... though the .whereInStack would get this too

  if (missing(sim)) {
    sim <- NULL
  }
  if (is.null(sim)) {
    if (!exists("sim", simIsIn, inherits = FALSE))
      simIsIn <- try(.whereInStack("sim"), silent = TRUE)
  }
  sim <- get0("sim", simIsIn, inherits = FALSE)

  if (is.name(fn)) {
    filename <- try(eval(fn, envir = simIsIn), silent = TRUE)
  }

  if (!is.character(filename)) {
    fnNames <- names(fn)
    if (is.null(fnNames)) {
      fn <- match.call(eval(fn[[1]]), fn)
      fnNames <- names(fn) # redo
    }
    theFileArg <- NULL
    if (!is.null(fnNames)) {
      theFileArg <- grep("^file$|^filename$", names(fn), value = TRUE)
    }
    if (!is.null(theFileArg)) {
      filename <- try(eval(fn[[theFileArg]], envir = simIsIn), silent = TRUE)
    }
  }
  if (is(filename, "try-error")) {
    stop("Couldn't guess filename; please pass it explicitly")
  }

  sim@outputs <- outputsAppend(sim@outputs, saveTime = time(sim), file = filename, ...)

  sim
}

# inputArgs + outputArgs ----------------------------------------------------------------------

#' `inputArgs` and `outputArgs` are ways to specify any arguments that are needed for
#' file loading and file saving. This is still somewhat experimental.
#'
#' @inheritParams inputs
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-inputs
#'
setGeneric("inputArgs", function(sim) {
  standardGeneric("inputArgs")
})

#' @export
#' @rdname simList-accessors-inputs
setMethod("inputArgs",
          signature = "simList",
          definition = function(sim) {
            return(sim@inputs[[.fileTableInCols[pmatch("arg", .fileTableInCols)]]])
})

#' @export
#' @rdname simList-accessors-inputs
setGeneric("inputArgs<-",
           function(sim, value) {
             standardGeneric("inputArgs<-")
})

#' @name inputArgs<-
#' @aliases inputArgs<-,simList-method
#' @rdname simList-accessors-inputs
#' @export
setReplaceMethod(
  "inputArgs",
  signature = "simList",
  function(sim, value) {
   if (is.list(value) & !is.data.frame(value)) {
     sim@inputs[[.txtArguments]] <- value
   } else if (is.null(value)) {
     sim@inputs[[.txtArguments]] <- rep(list(NULL), NROW(inputs(sim)))
   } else {
     stop("value passed to inputArgs() must be a list of named elements")
   }

   validObject(sim)
   return(sim)
})

#' @inheritParams inputs
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-outputs
setGeneric("outputArgs", function(sim) {
  standardGeneric("outputArgs")
})

#' @export
#' @rdname simList-accessors-outputs
setMethod("outputArgs",
          signature = "simList",
          definition = function(sim) {
            return(sim@outputs$arg)
})

#' @export
#' @rdname simList-accessors-outputs
setGeneric("outputArgs<-",
           function(sim, value) {
             standardGeneric("outputArgs<-")
})

#' @name outputArgs<-
#' @aliases outputArgs<-,simList-method
#' @rdname simList-accessors-outputs
#' @export
setReplaceMethod(
  "outputArgs",
  signature = "simList",
  function(sim, value) {
    argName <- .fileTableOutCols[pmatch("arg", .fileTableOutCols)]
   if (is.list(value) & !is.data.frame(value)) {
     sim@outputs[[argName]] <- value
   } else if (is.null(value)) {
     sim@outputs[[argName]] <- rep(list(NULL), NROW(outputs(sim)))
   } else {
     stop("value passed to outputArgs() must be a list of named elements")
   }
   validObject(sim)
   return(sim)
})

# paths ---------------------------------------------------------------------------------------

#' Specify paths for modules, inputs, outputs, and temporary rasters
#'
#' Accessor functions for the `paths` slot in a `simList` object.
#'
#' These are ways to add or access the file paths used by [spades()].
#' There are five file paths: `cachePath`, `modulePath`,
#' `inputPath`, `outputPath`, and `rasterPath`.
#' Each has a function to get or set the value in a `simList` object.
#' If no paths are specified, the defaults are as follows:
#'
#' \itemize{
#'   \item `cachePath`: `getOption("reproducible.cachePath")`;
#'   \item `inputPath`: `getOption("spades.modulePath")`;
#'   \item `modulePath`: `getOption("spades.inputPath")`;
#'   \item `outputPath`: `getOption("spades.outputPath")`;
#'   \item `rasterPath`: `file.path(getOption("spades.scratchPath"), "raster")`;
#'   \item `scratchPath`: `getOption("spades.scratchPath")`;
#'   \item `terraPath`: `file.path(getOption("spades.scratchPath"), "terra")`
#' }
#'
#' @inheritParams params
#'
#' @return Returns or sets the value of the slot from the `simList` object.
#'
#' @family functions to access elements of a 'simList' object
#' @seealso [SpaDES.core-package], specifically the section 1.2.4 on Simulation Paths.
#'
#' @include simList-class.R
#' @importFrom stats na.omit
#' @export
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#'
setGeneric("paths", function(sim) {
  standardGeneric("paths")
})

#' @export
#' @rdname simList-accessors-paths
setMethod("paths",
          signature = "simList",
          definition = function(sim) {
            return(sim@paths)
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("paths<-",
           function(sim, value) {
             standardGeneric("paths<-")
})

#' @name paths<-
#' @aliases paths<-,simList-method
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
#' @export
setReplaceMethod(
  "paths",
  signature = "simList",
  function(sim, value) {
    ## get named elements and their position in value list
    wh <- pmatch(names(sim@paths), names(value)) # always length 7, NA if no name match, number if yes
    whValueNamed <- which(!is.na(pmatch(names(value), names(sim@paths)))) # length of names of value
    whValueUnnamed <- rep(TRUE, length(value))
    if (length(whValueNamed)) whValueUnnamed[whValueNamed] <- FALSE

    ## start with .paths()
    emptyOnes <- unlist(lapply(sim@paths, is.null))
    if (sum(emptyOnes) > 0) sim@paths[emptyOnes] <- .paths()[emptyOnes]

    ## override with named ones
    sim@paths[!is.na(wh)] <- value[na.omit(wh)]

    ## keep named elements, use unnamed in remaining order:
    ##  cache, input, module, output
    if (length(na.omit(wh)) < length(value)) {
      whichNamed <- which(!is.na(wh))
      whichUnnamed <- (seq_along(sim@paths))
      if (length(whichNamed) > 0) whichUnnamed <- whichUnnamed[-whichNamed]
      sim@paths[whichUnnamed][seq_len(sum(whValueUnnamed))] <- value[whValueUnnamed]
    }

    ## Don't need to create an archive in the paths directory, just have to create the directory
    checkPath(sim@paths$cachePath, create = TRUE)

    validObject(sim)
    return(sim)
})

## cachePath ----------------------------------------------------------------------------------

#' @inheritParams paths
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
#'
setGeneric("cachePath", function(sim) {
  standardGeneric("cachePath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("cachePath",
          signature = "simList",
          definition = function(sim) {
            return(sim@paths$cachePath)
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("cachePath<-",
           function(sim, value) {
             standardGeneric("cachePath<-")
})

#' @name cachePath<-
#' @aliases cachePath<-,simList-method
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#' @export
setReplaceMethod(
  "cachePath",
  signature = "simList",
  function(sim, value) {
    sim@paths$cachePath <- unname(unlist(value))
    validObject(sim)
    return(sim)
})

## inputPath ----------------------------------------------------------------------------------

#' @inheritParams paths
#' @include simList-class.R
#' @export
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#'
setGeneric("inputPath", function(sim) {
  standardGeneric("inputPath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("inputPath",
          signature = "simList",
          definition = function(sim) {
            return(sim@paths$inputPath)
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("inputPath<-",
           function(sim, value) {
             standardGeneric("inputPath<-")
})

#' @name inputPath<-
#' @aliases inputPath<-,simList-method
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#' @export
setReplaceMethod(
  "inputPath",
  signature = "simList",
  function(sim, value) {
    sim@paths$inputPath <- unname(unlist(value))
    validObject(sim)
    return(sim)
})

## outputPath ----------------------------------------------------------------------------------

#' @inheritParams paths
#' @include simList-class.R
#' @export
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#'
setGeneric("outputPath", function(sim) {
  standardGeneric("outputPath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("outputPath",
          signature = "simList",
          definition = function(sim) {
            return(sim@paths$outputPath)
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("outputPath<-",
           function(sim, value) {
             standardGeneric("outputPath<-")
})

#' @name outputPath<-
#' @aliases outputPath<-,simList-method
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#' @export
setReplaceMethod(
  "outputPath",
  signature = "simList",
  function(sim, value) {
    sim@paths$outputPath <- unname(unlist(value))
    checkPath(sim@paths$outputPath, create = TRUE)
    if (NROW(outputs(sim)) > 0) {
     if ("saved" %in% colnames(outputs(sim))) {
       notYetSaved <- !outputs(sim)$saved | is.na(outputs(sim)$saved)
       outputs(sim)$file[notYetSaved] <- file.path(sim@paths$outputPath,
                                                   basename(outputs(sim)$file[notYetSaved]))
     }
    }
    validObject(sim)
    return(sim)
})

#' @inheritParams paths
#' @include simList-class.R
#' @export
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#'
setGeneric("figurePath", function(sim) {
  standardGeneric("figurePath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("figurePath",
          signature = "simList",
          definition = function(sim) {
            moduleName <- current(sim)[["moduleName"]]
            if (length(moduleName) == 0) {
              fp <- file.path(sim@paths$outputPath, "figures")
            } else {
              fp <- file.path(sim@paths$outputPath, "figures", moduleName)
            }
            fp <- checkPath(fp, create = TRUE)
            return(fp)
})

#' @inheritParams paths
#' @include simList-class.R
#' @export
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#'
setGeneric("logPath", function(sim) {
  standardGeneric("logPath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("logPath",
          signature = "simList",
          definition = function(sim) {
            lp <- getOption("spades.logPath", file.path(sim@paths[["outputPath"]], "log")) |>
              checkPath(create = TRUE)
            return(lp)
})

## modulePath ----------------------------------------------------------------------------------

#' @inheritParams paths
#' @param module The optional character string of the module(s) whose
#'               paths are desired. If omitted, will return all module paths,
#'               if more than one exist.
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("modulePath", function(sim, module) {
  standardGeneric("modulePath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("modulePath",
          signature = "simList",
          definition = function(sim, module) {
            if (!missing(module)) {
              mods <- unlist(lapply(sim@modules, function(x) x %in% module))
              dirname(names(mods)[mods])
            } else {
              sim@paths$modulePath
            }
})

#' @export
#' @rdname simList-accessors-paths
setGeneric("modulePath<-",
           function(sim, value) {
             standardGeneric("modulePath<-")
})

#' @name modulePath<-
#' @aliases modulePath<-,simList-method
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#' @export
setReplaceMethod(
  "modulePath",
  signature = "simList",
  function(sim, value) {
    sim@paths$modulePath <- unname(unlist(value))
    validObject(sim)
    return(sim)
})

## scratchPath ---------------------------------------------------------------------------------

#' @inheritParams paths
#'
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("scratchPath", function(sim) {
  standardGeneric("scratchPath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("scratchPath",
          signature = "simList",
          definition = function(sim) {
            sim@paths$scratchPath
})

#' @export
#' @rdname simList-accessors-paths
setGeneric("scratchPath<-",
           function(sim, value) {
             standardGeneric("scratchPath<-")
})

#' @name scratchPath<-
#' @aliases scratchPath<-,simList-method
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#' @export
setReplaceMethod(
  "scratchPath",
  signature = "simList",
  function(sim, value) {
    sim@paths$scratchPath <- unname(unlist(value))
    checkPath(sim@paths$scratchPath, create = TRUE)
    validObject(sim)
    return(sim)
})

## rasterPath ----------------------------------------------------------------------------------

#' @inheritParams paths
#'
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("rasterPath", function(sim) {
  standardGeneric("rasterPath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("rasterPath",
          signature = "simList",
          definition = function(sim) {
            sim@paths$rasterPath
})

#' @export
#' @rdname simList-accessors-paths
setGeneric("rasterPath<-",
           function(sim, value) {
             standardGeneric("rasterPath<-")
})

#' @name rasterPath<-
#' @aliases rasterPath<-,simList-method
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#' @export
setReplaceMethod(
  "rasterPath",
  signature = "simList",
  function(sim, value) {
    sim@paths$rasterPath <- unname(unlist(value))
    checkPath(sim@paths$rasterPath, create = TRUE)
    validObject(sim)
    return(sim)
})

## terraPath ----------------------------------------------------------------------------------

#' @inheritParams paths
#'
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("terraPath", function(sim) {
  standardGeneric("terraPath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("terraPath",
          signature = "simList",
          definition = function(sim) {
            sim@paths$terraPath
})

#' @export
#' @rdname simList-accessors-paths
setGeneric("terraPath<-",
           function(sim, value) {
             standardGeneric("terraPath<-")
})

#' @name terraPath<-
#' @aliases terraPath<-,simList-method
#' @aliases simList-accessors-paths
#' @rdname simList-accessors-paths
#' @export
setReplaceMethod(
  "terraPath",
  signature = "simList",
  function(sim, value) {
    sim@paths$terraPath <- unname(unlist(value))
    checkPath(sim@paths$terraPath, create = TRUE)
    validObject(sim)
    return(sim)
})

#' @description
#' `dataPath` will return `file.path(modulePath(sim), currentModule(sim), "data")`.
#' `dataPath`, like `currentModule`,is namespaced. This means that when
#' it is used inside a module, then it will return *that model-specific* information.
#' For instance, if used inside a module called `"movingAgent"`,
#' then `currentModule(sim)`
#' will return `"movingAgent"`, and `dataPath(sim)` will return
#' `file.path(modulePath(sim), "movingAgent", "data")`
#'
#' @inheritParams paths
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setGeneric("dataPath", function(sim) {
  standardGeneric("dataPath")
})

#' @export
#' @rdname simList-accessors-paths
#' @aliases simList-accessors-paths
setMethod("dataPath",
          signature = "simList",
          definition = function(sim) {
            return(file.path(modulePath(sim, currentModule(sim)), currentModule(sim), "data"))
})

# time ----------------------------------------------------------------------------------------

#' Time usage in `SpaDES`
#'
#' Functions for the `simtimes` slot of a `simList` object
#' and its elements. To maintain modularity, the behaviour of these functions depends
#' on where they are used. In other words, different modules can have their own
#' timeunit. `SpaDES` converts these to seconds when running a simulation, but
#' shows the user time in the units of the model as shown with `timeunit(sim)`
#'
#' @note These have default behaviour that is based on the calling frame timeunit.
#' When used inside a module, then the time is in the units of the module.
#' If used in an interactive mode, then the time will be in the units of the
#' simulation.
#'
#' Additional methods are provided to access the current, start, and end times
#' of the simulation:
#'
#' \tabular{ll}{
#'    `time` \tab Current simulation time.\cr
#'    `start` \tab Simulation start time.\cr
#'    `end` \tab Simulation end time.\cr
#'    `timeunit` \tab Simulation timeunit.\cr
#'    `timeunits` \tab Module timeunits.\cr
#'    `times` \tab List of all simulation times (current, start, end, timeunit).\cr
#' }
#'
#' @param unit   Character. One of the time units used in `SpaDES`.
#'
#' @param x A `simList`
#'
#' @param value  A time, given as a numeric, optionally with a unit attribute,
#'               but this will be deduced from the model time units or module
#'               time units (if used within a module).
#'
#' @param ...    Additional parameters.
#'
#' @return Returns or sets the value of the slot from the `simList` object.
#'
#' @seealso [SpaDES.core-package], specifically the section 1.2.5 on Simulation times;
#'   [elapsedTime()],
#'
#' @aliases simList-accessors-times
#' @author Alex Chubaty and Eliot McIntire
#' @export
#' @family functions to access elements of a 'simList' object
#' @include simList-class.R
#' @include times.R
#' @rdname simList-accessors-times
setGeneric("times", function(x, ...) {
  standardGeneric("times")
})

#' @export
#' @rdname simList-accessors-times
#' @aliases simList-accessors-times
setMethod(
  "times",
  signature = "simList",
  definition = function(x) {
    mUnit <- .callingFrameTimeunit(x)
    if (is.null(mUnit)) {
      mUnit <- NA_character_
    }
    t <- list(
      current = time(x, x@simtimes[["timeunit"]]),
      start = start(x, x@simtimes[["timeunit"]]),
      end = end(x, x@simtimes[["timeunit"]]),
      timeunit = x@simtimes[["timeunit"]]
    )
    return(t)
})

#' @export
#' @rdname simList-accessors-times
#' @aliases simList-accessors-times
setGeneric("times<-", function(x, value) {
  standardGeneric("times<-")
})

#' @name times<-
#' @aliases times<-,simList-method
#' @export
#' @rdname simList-accessors-times
#' @aliases simList-accessors-times
setReplaceMethod(
  "times",
   signature = "simList",
   function(x, value) {
     value <- as.list(value)
     if (!all(is(value$current, "numeric"),
            is(value$start, "numeric"),
            is(value$end, "numeric"),
            is(value$timeunit, "character"))) {
       stop("Please supply a named list, current, start, end, and timeunit")
     }

     if (is.null(attributes(value$current)$unit))
       attributes(value$current)$unit <- value$timeunit
     if (is.null(attributes(value$start)$unit))
       attributes(value$start)$unit <- value$timeunit
     if (is.null(attributes(value$end)$unit))
       attributes(value$end)$unit <- value$timeunit

     x@simtimes$current <- convertTimeunit(value$current, "second", x@.xData)
     x@simtimes$start <- convertTimeunit(value$start, "second", x@.xData)
     x@simtimes$end <- convertTimeunit(value$end, "second", x@.xData)
     x@simtimes$timeunit <- value$timeunit

     validObject(x)

     return(x)
})

#' @export
#' @importFrom stats time
#' @include simList-class.R
#' @include times.R
#' @rdname simList-accessors-times
time.simList <- function(x, unit, ...) {
    if (missing(unit)) {
      unit <- .callingFrameTimeunit(x)
      if (is.null(unit)) {
        unit <- NA_character_
      }
    }
    if (isTRUE(!startsWith(unit, "second"))) {

      t <- convertTimeunit(x@simtimes[["current"]], unit, x@.xData,
                           skipChecks = TRUE)
      return(t)
    }
    t <- x@simtimes[["current"]]
    return(t)
}

#' @aliases simList-accessors-times
#' @export
#' @rdname simList-accessors-times
setGeneric("time<-", function(x, value) {
  standardGeneric("time<-")
})

#' @aliases time<-,simList-method
#' @aliases simList-accessors-times
#' @export
#' @name time<-
#' @rdname simList-accessors-times
setReplaceMethod(
  "time",
   signature = "simList",
   function(x, value) {
     if (is.null(attributes(value)$unit)) {
       attributes(value)$unit <- x@simtimes[["timeunit"]]
     }
     x@simtimes$current <- convertTimeunit(value, "second", x@.xData)

     if (!is.numeric(x@simtimes$current)) stop("time must be a numeric")
     if (!any(pmatch(.spadesTimes, attr(x@simtimes$current, "unit")))) {
       stop("time must be one of", paste(.spadesTimes, collapse = ", "))
     }
     return(x)
})

#' @export
#' @importFrom stats end
#' @include times.R
#' @include simList-class.R
#' @rdname simList-accessors-times
end <- function(x, ...) UseMethod("end")

#' @export
#' @rdname simList-accessors-times
end.simList <- function(x, unit, ...) {
    if (missing(unit)) {
      unit <- .callingFrameTimeunit(x)
      if (is.null(unit))
        unit <- NA_character_
    }
    if (!is.na(unit)) {
      # if (is.na(pmatch("second", unit))) {
      if (!startsWith(unit, "second")) {
        # i.e., if not in same units as simulation
        t <- convertTimeunit(x@simtimes$end, unit, x@.xData)
        return(t)
      }
    }
    t <- x@simtimes$end
    return(t)
}

#' @aliases simList-accessors-times
#' @export
#' @rdname simList-accessors-times
setGeneric("end<-", function(x, value) {
  standardGeneric("end<-")
})

#' @aliases end<-,simList-method
#' @aliases simList-accessors-times
#' @export
#' @name end<-
#' @rdname simList-accessors-times
setReplaceMethod(
  "end",
  signature = "simList",
  function(x, value) {
    # convert time units, if required
    if (is.null(attributes(value)$unit)) {
      attributes(value)$unit <- x@simtimes[["timeunit"]]
    }
    x@simtimes$end <- convertTimeunit(value, "second", x@.xData)
    validObject(x)
    return(x)
})

#' @export
#' @importFrom stats start
#' @include simList-class.R
#' @include times.R
#' @rdname simList-accessors-times
start <- function(x, ...) UseMethod("start")

#' @export
#' @rdname simList-accessors-times
start.simList <- function(x, unit = NULL, ...) {
    if (is.null(unit)) {
      unit <- .callingFrameTimeunit(x)
      if (is.null(unit)) {
        unit <- NA_character_
      }
    }

    if (!is.na(unit)) {
      # if (is.na(pmatch("second", unit))) {
      if (!startsWith(unit, "second")) {

        # i.e., if not in same units as simulation
        t <- convertTimeunit(x@simtimes$start, unit, x@.xData)
        return(t)
      }
    }
    t <- x@simtimes$start
    return(t)
}

#' @export
#' @rdname simList-accessors-times
#' @aliases simList-accessors-times
setGeneric("start<-", function(x, value) {
  standardGeneric("start<-")
})

#' @name start<-
#' @aliases start<-,simList-method
#' @aliases simList-accessors-times
#' @rdname simList-accessors-times
setReplaceMethod(
  "start",
   signature = "simList",
   function(x, value) {
     # convert time units, if required
     if (is.null(attributes(value)$unit)) {
       attributes(value)$unit <- x@simtimes[["timeunit"]]
     }
     x@simtimes$start <- convertTimeunit(value, "second", x@.xData)
     validObject(x)
     return(x)
})

#' @inheritParams times
#' @include simList-class.R
#' @include times.R
#' @keywords internal
#' @rdname namespacing
.callingFrameTimeunit <- function(x) {
  if (is.null(x)) return(NULL)
  mod <- x@current[["moduleName"]]
  out <- x@simtimes[["timeunit"]] # default -- whole simList
  if (!is.null(x@.xData[[".timeunits"]])) {
    outPoss <- x@.xData[[".timeunits"]]
  } else {
    outPoss <- timeunits(x)
  }
  outPoss <- if (length(mod) > 0) {
    outPoss[[mod]]
  } else {
    out
  }
  if (!is.null(outPoss)) out <- unlist(outPoss)
  return(out)
}

#' @details `timeunit` will extract the current units of the time used in a
#' simulation (i.e., within a `spades` call).
#' If it is set within a `simInit`, e.g.,
#' `times=list(start=0, end=52, timeunit = "week")`, it will set the
#' units for that simulation.
#' By default, a `simInit` call will use the smallest unit contained within
#' the metadata for the modules being used. If there are parent modules, then the
#' parent module timeunit will be used even if one of its children is a smaller timeunit.
#' If all modules, including parents, are set to `NA`, `timeunit` defaults to seconds.
#' If parents are set to `NA`, then the set of modules defined by that parent module
#' will be given the smallest units of the children.
#'
#' Currently, available units are "second", "hours", day", "week", "month", and
#' "year" can be used in the metadata of a module.
#'
#' The user can also define a new unit. The unit name can be anything, but the
#' function definition must be of the form `dunitName`, e.g., `dyear`
#' or `dfortnight`.
#' The unit name is the part without the `d` and the function name definition
#' includes the `d`. This new function, e.g.,
#' `dfortnight <- function(x) lubridate::duration(dday(14))`
#' can be placed anywhere in the search path or in a module.
#'
#' @aliases simList-accessors-times
#' @export
#' @include simList-class.R
#' @rdname simList-accessors-times
setGeneric("timeunit", function(x) {
  standardGeneric("timeunit")
})

#' @aliases simList-accessors-times
#' @export
#' @rdname simList-accessors-times
setMethod("timeunit",
          signature = "simList",
          definition = function(x) {
            return(x@simtimes[["timeunit"]])
})

#' @aliases simList-accessors-times
#' @export
#' @rdname simList-accessors-times
setGeneric("timeunit<-",
           function(x, value) {
             standardGeneric("timeunit<-")
})

#' @aliases timeunit<-,simList-method
#' @aliases simList-accessors-times
#' @export
#' @name timeunit<-
#' @rdname simList-accessors-times
setReplaceMethod(
  "timeunit",
  signature = "simList",
  function(x, value) {
    value <- as.character(value)
    if (checkTimeunit(value, envir = x@.xData)) {
        x@simtimes$timeunit <- value
    } else {
      x@simtimes$timeunit <- NA_character_
    }
    validObject(x)
    return(x)
})

#' @details `timeunits` will extract the current units of the time of all
#' modules used in a simulation.
#' This is different from `timeunit` because it is not necessarily
#' associated with a `spades` call.
#'
#' In many cases, the "simpler" use of each of these functions may be slower
#' computationally. For instance, it is much faster to use `time(sim, "year")`
#' than `time(sim)`. So as a module developer, it is advantageous to
#' write out the longer one, minimizing the looking up that R must do.
#'
#' @aliases simList-accessors-times
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-times
setGeneric("timeunits", function(x) {
  standardGeneric("timeunits")
})

#' @aliases simList-accessors-times
#' @export
#' @rdname simList-accessors-times
setMethod(
  "timeunits",
  signature = "simList",
  definition = function(x) {
    isNonParent <- !unlist(lapply(x@depends@dependencies, function(y) {
      if (!is.null(y)) {
        length(y@childModules) > 0
      } else {
        FALSE
      }
    }))
    if (all(unlist(lapply(x@depends@dependencies[isNonParent], is.null)))) {
      timestepUnits <- NULL
    } else {
      timestepUnits <- lapply(x@depends@dependencies[isNonParent], function(y) {
        y@timeunit
      })
      names(timestepUnits) <- unlist(lapply(x@depends@dependencies[isNonParent], function(y) {
        y@name
      }))
    }
    return(timestepUnits)
})


# events --------------------------------------------------------------------------------------

#' Simulation event lists
#'
#' Accessor functions for the `events` and `completed` slots of a
#' `simList` object. These path functions will extract the values that were
#' provided to the `simInit` function in the `path` argument.
#'
#' By default, the event lists are shown when the `simList` object is printed,
#' thus most users will not require direct use of these methods.
#' \tabular{ll}{
#'    `events` \tab Scheduled simulation events (the event queue).\cr
#'    `completed` \tab Completed simulation events.\cr
#' }
#'
#' Currently, only get and set methods are defined. Subset methods are not.
#'
#' @note Each event is represented by a [data.table::data.table()] row consisting of:
#'  \itemize{
#'    \item `eventTime`: The time the event is to occur.
#'    \item `moduleName`: The module from which the event is taken.
#'    \item `eventType`: A character string for the programmer-defined event type.
#'  }
#'
#' @inheritParams objs
#'
#' @param unit   Character. One of the time units used in `SpaDES`.
#'
#' @param value The object to be stored at the slot.
#'
#' @return Returns or sets the value of the slot from the `simList` object.
#'
#' @seealso [SpaDES.core-package], specifically the section 1.2.6 on Simulation event queues.
#'
#' @aliases simList-accessors-events
#' @export
#' @family functions to access elements of a 'simList' object
#' @importFrom data.table := copy data.table
#' @importFrom stats setNames
#' @include simList-class.R
#' @rdname simList-accessors-events
setGeneric("events", function(sim, unit) {
  standardGeneric("events")
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setMethod(
  "events",
  signature = c("simList", "character"),
  definition = function(sim, unit) {
    obj <- rbindlist(sim@events)
    if (length(unit) != 1) {
      stop("unit must be length 1")
    }
    # if (is.na(pmatch("second", unit)) && (length(sim@events) > 0)) {
    if (!startsWith(unit, "second") && (length(sim@events) > 0)) {
      ## note the above line captures empty eventTime, whereas is.na does not
      if (any(!is.na(obj$eventTime))) {
        if (!is.null(obj$eventTime)) {
          obj[, eventTime := convertTimeunit(eventTime, unit, sim@.xData)]
          obj[]
        }
       } #else {
    }

    ## catch NULL/empty data.table and use empty event list
    if (NROW(obj) == 0 && NCOL(obj) == 0) {
      obj <- .emptyEventListDT
    }
    return(obj)
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setMethod("events",
          signature = c("simList", "missing"),
          definition = function(sim, unit) {
            res <- events(sim, sim@simtimes[["timeunit"]])
            return(res)
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setGeneric("events<-",
           function(sim, value) {
             standardGeneric("events<-")
})

#' @aliases events<-,simList-method
#' @aliases simList-accessors-events
#' @export
#' @name events<-
#' @rdname simList-accessors-events
setReplaceMethod(
  "events",
   signature = "simList",
   function(sim, value) {
     if (!is(value, "data.table")) stop("Event queue must be a data.table")
     if (!identical(names(value), .emptyEventListCols))
       stop("Event queue must be a data.table with columns: ",
            paste(.emptyEventListCols, collapse = ", "), ".")
     if (is.null(attributes(value$eventTime)$unit)) {
       attributes(value$eventTime)$unit <- sim@simtimes[["timeunit"]]
     }
     if (is.na(pmatch("second", attributes(value$eventTime)$unit))) {
       value[, eventTime := convertTimeunit(eventTime, "second", sim@.xData)]
     }

     if (NROW(value)) {
       sim@events <- lapply(seq_len(NROW(value)), function(x) as.list(value[x, ]))
     } else {
       sim@events <- list()
     }
     return(sim)
})

## conditional events --------------------------------------------------------------------------

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setGeneric("conditionalEvents", function(sim, unit) {
  standardGeneric("conditionalEvents")
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setMethod(
  "conditionalEvents",
  signature = c("simList", "character"),
  definition = function(sim, unit) {
    if (length(unit) != 1) stop("unit must be length 1")
    if (exists("._conditionalEvents", envir = sim, inherits = FALSE)) {
      conds <- sim$._conditionalEvents
      conds <- lapply(conds, function(x) {
        if (is.call(x$condition)) {
          x$condition <- deparse(x$condition)
        } else {
          x$condition <- as.character(x$condition)
        }
        x
      })
      obj <- rbindlist(conds)
      # if (is.na(pmatch("second", unit)) && (length(conds) > 0)) {
      if (!startsWith(unit, "second") && (length(conds) > 0)) {
        # note the above line captures empty eventTime, whereas is.na does not
        if (any(!is.na(obj$minEventTime)) && (any(!is.na(obj$maxEventTime)))) {
          if (!is.null(obj$minEventTime) && !is.null(obj$maxEventTime)) {
            obj[, minEventTime := convertTimeunit(minEventTime, unit, sim@.xData)]
            obj[, maxEventTime := convertTimeunit(maxEventTime, unit, sim@.xData)]
            obj[]
          }
        }
      }
      return(obj)
    } else {
      return(NULL)
    }
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setMethod("conditionalEvents",
          signature = c("simList", "missing"),
          definition = function(sim, unit) {
            res <- conditionalEvents(sim, sim@simtimes[["timeunit"]])
            return(res)
})

#' @inheritParams events
#'
#' @aliases simList-accessors-events
#' @export
#' @importFrom data.table rbindlist
#' @importFrom stats setNames
#' @include simList-class.R
#' @rdname simList-accessors-events
#'
setGeneric("current", function(sim, unit) {
  standardGeneric("current")
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setMethod(
  "current",
  signature = c("simList", "character"),
  definition = function(sim, unit) {
    # out <- if (is.na(pmatch("second", unit)) & (length(sim@current$eventTime))) {
    out <- if (!startsWith(unit, "second") && (length(sim@current$eventTime))) {
      # note the above line captures empty eventTime, whereas `is.na` does not
      if (any(!is.na(sim@current$eventTime))) {
        if (!is.null(sim@current$eventTime)) {
          sim@current$eventTime <- convertTimeunit(sim@current$eventTime, unit, sim@.xData)
          sim@current
        }
      } else {
        sim@current
      }
    } else {
      sim@current
    }
    return(rbindlist(list(out)))
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setMethod("current",
          signature = c("simList", "missing"),
          definition = function(sim, unit) {
            out <- current(sim, sim@simtimes[["timeunit"]])
            return(out)
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setGeneric("current<-",
           function(sim, value) {
             standardGeneric("current<-")
})

#' @aliases current<-,simList-method
#' @aliases simList-accessors-events
#' @export
#' @name current<-
#' @rdname simList-accessors-events
setReplaceMethod("current",
                 signature = "simList",
                 function(sim, value) {
                   if (!is(value, "data.table")) stop("Event queue must be a data.table")
                   if (!identical(names(value), .emptyEventListCols)) {
                     stop("Event queue must be a data.table with columns: ",
                          paste(.emptyEventListCols, collapse = ", "), ".")
                   }
                   sim@current <- as.list(value)
                   return(sim)
})

#' @inheritParams events
#' @param times Logical. Should this function report the `clockTime`.
#'
#' @aliases simList-accessors-events
#' @export
#' @importFrom data.table := data.table
#' @importFrom stats setNames
#' @include simList-class.R
#' @rdname simList-accessors-events
setGeneric("completed", function(sim, unit, times = TRUE) {
  standardGeneric("completed")
})

#' @aliases simList-accessors-events
#' @export
#' @importFrom data.table rbindlist set setkeyv :=
#' @rdname simList-accessors-events
setMethod(
  "completed",
  signature = c("simList", "character"),
  definition = function(sim, unit, times = TRUE) {
    obj <- as.list(sim@completed)
    obj <- rbindlist(obj, idcol = if (length(sim@completed)) "eventNumber" else NULL)

    if (length(sim@completed)) {
      obj[, eventNumber := as.numeric(eventNumber)]
      setkeyv(obj, "eventNumber")
      if (!isTRUE(times)) {
        set(obj, NULL, grep("^[.]_", names(obj)), NULL)
      }
      # if (is.na(pmatch("second", unit)) & (length(sim@completed))) {
      if (!startsWith(unit, "second") & (length(sim@completed))) {
        # note the above line captures empty eventTime, whereas `is.na` does not
        if (any(!is.na(obj$eventTime))) {
          if (!is.null(obj$eventTime)) {
            if (!is.null(obj[[._txtClockTime]])) {
              obj[, `:=`(eventTime = convertTimeunit(eventTime, unit, sim@.xData))]
                         #clockTime = obj[[._txtClockTime]],
                         #._clockTime = NULL)]
            }
          }
        }
      }
      obj[]
      set(obj, NULL, "eventNumber", NULL) # remove the eventNumber column to match other event queues
    }
    return(obj)
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setMethod("completed",
          signature = c("simList", "missing"),
          definition = function(sim, unit, times = TRUE) {
            out <- completed(sim, sim@simtimes[["timeunit"]], times = times)
            return(out)
})

#' @aliases simList-accessors-events
#' @export
#' @rdname simList-accessors-events
setGeneric("completed<-",
           function(sim, value) {
             standardGeneric("completed<-")
})

#' @aliases completed<-,simList-method
#' @aliases simList-accessors-events
#' @export
#' @name completed<-
#' @rdname simList-accessors-events
setReplaceMethod(
  "completed",
  signature = "simList",
  function(sim, value) {
    if (!is(value, "data.table")) stop("Completed queue must be a data.table")
    if (!identical(names(value), .emptyEventListCols)) {
      stop("Event queue must be a data.table with columns: ",
           paste(.emptyEventListCols, collapse = ", "), ".")
    }
    sim@completed <- new.env(parent = emptyenv())
    if (NROW(value)) {
      integerVals <- seq_len(NROW(value))
      outList <- lapply(integerVals, function(x) as.list(value[x, ]))
      names(outList) <- as.character(integerVals)
      list2env(outList, envir = sim@completed)
    }
    return(sim)
})

#' Add simulation dependencies
#'
#' Internal function.
#' Adds a `.moduleDeps` object to the simulation dependency list.
#'
#' @inheritParams objs
#'
#' @param x   A named list containing the parameters used to construct a new
#'            `.moduleDeps` object.
#'
#' @return A `simList` object.
#'
#' @include simList-class.R
#' @family functions to access elements of a 'simList' object
#' @keywords internal
#' @rdname addDepends
#'
#' @author Alex Chubaty
#'
setGeneric(".addDepends", function(sim, x) {
  standardGeneric(".addDepends")
})

#' @rdname addDepends
setMethod(
  ".addDepends",
  signature(sim = "simList", x = ".moduleDeps"),
  definition = function(sim, x) {
    deps <- sim@depends
    n <- length(deps@dependencies)
    if (n == 1L) {
      if (is.null(deps@dependencies[[1L]])) n <- 0L
    }
    deps@dependencies[[n + 1L]] <- x
    dupes <- which(duplicated(deps@dependencies))
    if (length(dupes)) deps@dependencies <- deps@dependencies[-dupes]
    depends(sim) <- deps
    return(sim)
})


# packages ------------------------------------------------------------------------------------

#' strip GitHub repo info from vector of packages
#'
#' @keywords internal
.cleanPkgs <- function(pkgs) {
  Require::extractPkgName(pkgs)
  # pkgs <- gsub(".*\\/+(.+)(@.*)",  "\\1", pkgs)
  # pkgs <- gsub(".*\\/+(.+)",  "\\1", pkgs)
  # pkgs <- sub("[[:space:]]*\\(>=.*", "", pkgs)
  #
  # return(pkgs)
}

#' Get module or simulation package dependencies
#'
#' @param sim  A `simList` object.
#'
#' @param modules Character vector, specifying the name or vector of names of module(s)
#' @param paths Character vector, specifying the name or vector of names of paths(s) for
#'              those modules. If path not specified, it will be taken from
#'              `getOption("spades.modulePath")`, which is set with `setPaths()`)
#' @param filenames Character vector specifying filenames of modules (i.e.
#'                 combined path & module. If this is specified, then `modules` and
#'                 `path` are ignored.
#' @param clean Optional logical. If `TRUE`, it will scrub any references to
#'              GitHub repositories, e.g., "PredictiveEcology/reproducible" will be
#'              returned as "reproducible".
#'
#' @inheritParams .parseModulePartial
#'
#' @return A sorted character vector of package names.
#'
#' @aliases simList-accessors-packages
#' @author Alex Chubaty & Eliot McIntire
#' @export
#' @include simList-class.R
#' @family functions to access elements of a 'simList' object
#' @rdname packages
setGeneric("packages", function(sim, modules, paths, filenames, envir,
                                clean = FALSE, ...) {
  standardGeneric("packages")
})

#' @export
#' @rdname packages
#' @aliases simList-accessors-packages
setMethod(
  "packages",
  signature(sim = "ANY"),
  definition = function(sim, modules, paths, filenames, envir,
                        clean = FALSE, ...) {
    if (missing(sim)) {
      ## can either have no sim, or can have a sim that is incomplete,
      ## i.e., with no reqdPkgs slot filled
      depsInSim <- list(NULL)
    } else {
      depsInSim <- sim@depends@dependencies
      if (is.null(depsInSim[[1]])) return(character()) # basically for empty simList objects
    }

    if (!is.null(depsInSim[[1]])) {
      ## check within dependencies slot for any elements, if not NULL, one will be reqdPkgs
      pkgs <- lapply(depsInSim, function(x) {
        x@reqdPkgs
      }) |> unlist()
      pkgs <- unique(pkgs)
      if (!any(grepl("SpaDES.core", pkgs)))
        pkgs <- c("SpaDES.core", pkgs)
      if (!is.null(pkgs))
        pkgs <- sort(pkgs)
    } else {
      if (!missing(filenames))  {
        paths <- filenames
        if (missing(modules)) {
          modules <- sub(basename(paths), replacement = "", pattern = ".R")
        }
      } else if (!missing(modules)) {
        prefix <- if (!all(file.exists(modules))) {
          if (!missing("paths")) {
            pre <- paths
          } else {
            pre <- getOption("spades.modulePath")
          }
          file.path(pre, modules)
        } else {
          modules
        }
        paths <- file.path(prefix, paste0(modules, ".R"))
      } else {
        stop("one of sim, modules, or filename must be supplied.")
      }

      if (missing(envir)) {
        envir <- NULL
      }

      pkgs <- lapply(paths, function(paths) {
        pkgs <- .parseModulePartial(filename = paths, defineModuleElement = "reqdPkgs",
                                    envir = envir) |>
          unlist() # |> unique()
        pkgs <- pkgs[!duplicated(pkgs)]
        if (!is.null(pkgs)) {
          pkgs <- sort(pkgs)
        } else {
          pkgs <- character(0)
        }
        pkgs <- pkgs[nzchar(pkgs)]
        pkgs <- pkgs[!duplicated(pkgs)]
        if (!any(grepl("SpaDES.core", pkgs)))
          pkgs <- c("SpaDES.core", pkgs)
        return(pkgs)
      })
      names(pkgs) <- modules
    }
    if (isTRUE(clean)) {
      pkgs <- .cleanPkgs(pkgs)
    }
    return(unique(pkgs))
})


# inputObjects --------------------------------------------------------------------------------

#' Metadata accessors
#'
#' These accessors extract the metadata for a module (if specified) or all modules
#' in a `simList` if not specified.
#'
#' @inheritParams P
#' @param path The path to the module., i.e., the `modulePath`.
#'    Only relevant if `sim` not supplied.
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
#'
setGeneric("inputObjects", function(sim, module, path) {
  standardGeneric("inputObjects")
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("inputObjects",
          signature(sim = "simList"),
          definition = function(sim, module, path) {
            if (missing(module)) {
              module <- current(sim)[["moduleName"]]
              if (NROW(module) == 0)
                module <- unlist(modules(sim))
            }
            module <- setdiff(module, .coreModules())
            out <- if (length(module) > 0) {
              if (length(module) > 1) {
                lapply(sim@depends@dependencies[module], function(deps)
                  deps@inputObjects)
              } else {
                sim@depends@dependencies[[module]]@inputObjects
              }
            } else {
              ._inputObjectsDF()
            }
            return(out)
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("inputObjects",
          signature(sim = "missing"),
          definition = function(sim, module, path) {
            out <- inputOrOutputObjects(type = "inputObjects", module = module, path = path)
            return(out)
})

inputOrOutputObjects <- function(type, module, path) {
  if (missing(path)) {
    path <- getPaths()$modulePath
  }
  names(module) <- module
  mm <- lapply(module, function(m)
    moduleMetadata(module = m, path = path, defineModuleListItems = type)[[type]])
  mm
}


# outputObjects -------------------------------------------------------------------------------

#' @inheritParams P
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
#'
setGeneric("outputObjects", function(sim, module, path) {
  standardGeneric("outputObjects")
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("outputObjects",
          signature = "simList",
          definition = function(sim, module, path) {
            if (missing(module)) {
              module <- current(sim)[["moduleName"]]
              if (NROW(module) == 0)
                module <- unlist(modules(sim))
            }
            module <- setdiff(module, .coreModules())
            out <- if (length(module) > 0) {
              if (length(module) > 1) {
                lapply(sim@depends@dependencies[module], function(deps)
                  deps@outputObjects)
              } else {
                sim@depends@dependencies[[module]]@outputObjects
              }
            } else {
              ._outputObjectsDF()
            }
            return(out)
          })

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("outputObjects",
          signature(sim = "missing", module = "ANY"),
          definition = function(sim, module, path) {
            inputOrOutputObjects(type = "outputObjects", module = module, path = path)
})

# outputObjectNames ---------------------------------------------------------------------------

#' @inheritParams P
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
#'
setGeneric("outputObjectNames", function(sim, module) {
  standardGeneric("outputObjectNames")
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("outputObjectNames",
          signature = "simList",
          definition = function(sim, module) {
            out <- if (NROW(modules(sim)) > 0) {
              outObjs <- outputObjects(sim)
              allObjNames <- if (is(outObjs, "list")) {
                allObjNames <- lapply(outObjs, function(x) x$objectName)
                if (!missing(module)) {
                  allObjNames <- allObjNames[[module]]
                }
                allObjNames
              } else {
                list(outObjs$objectName)
              }
            } else {
              NULL
            }
            return(out)
})

# reqdPkgs -----------------------------------------------------------------------------------

#' @inheritParams P
#' @param module Character vector of module name(s)
#' @param modulePath That path where `module` can be found. If set already
#'   using `setPaths`, it will use that. This will be ignored if `sim`
#'   is supplied and is required if `sim` not supplied
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
#'
#' @examples
#' \donttest{
#' # set modulePath
#' setPaths(modulePath = getSampleModules(tempdir()))
#' # use Require and reqdPkgs
#' pkgs <- reqdPkgs(module = c("caribouMovement", "randomLandscapes", "fireSpread"))
#' }
setGeneric("reqdPkgs", function(sim, module, modulePath) {
  standardGeneric("reqdPkgs")
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("reqdPkgs",
          signature = "simList",
          definition = function(sim, module, modulePath) {
            if (missing(module)) {
              module <- current(sim)
              if (NROW(module) == 0)
                module <- unlist(modules(sim))
            }
            out <- if (length(module) > 1) {
              lapply(sim@depends@dependencies[module], function(deps)
                unlist(deps@reqdPkgs))
            } else {
              unlist(sim@depends@dependencies[[module]]@reqdPkgs)
            }
            return(out)
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("reqdPkgs",
          signature = "missing",
          definition = function(sim, module, modulePath) {
            if (missing(modulePath))
              modulePath <- getOption("spades.modulePath")
            names(module) <- module
            out <- lapply(module, function(mod) {
              unlist(.parseModulePartial(filename = file.path(modulePath, mod, paste0(mod, ".R")),
                                  defineModuleElement = "reqdPkgs") )
            })
            return(out)
})

# documentation -------------------------------------------------------------------------------

#' @inheritParams P
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
#'
setGeneric("documentation", function(sim, module) {
  standardGeneric("documentation")
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("documentation",
          signature = "simList",
          definition = function(sim, module) {
            if (missing(module)) {
              module <- current(sim)
              if (NROW(module) == 0)
                module <- unlist(modules(sim))
            }
            out <- if (length(module) > 1) {
              lapply(sim@depends@dependencies[module], function(deps)
                deps@documentation)
            } else {
              sim@depends@dependencies[[module]]@documentation
            }
            return(out)
})


#' @name citation
#' @rdname citation
setGeneric("citation", function(package, lib.loc = NULL, auto = NULL, module = character()) {
  standardGeneric("citation")
})

# citation ------------------------------------------------------------------------------------

#' A citation method for `SpaDES` modules
#'
#' This is a wrapper around [utils::citation()] for cases with `package` is a
#' `character` string. Otherwise, it takes a `simList`.
#'
#' @param package For compatibility with [utils::citation()]. This can be
#'                a `simList` or a character string for a package name.
#' @inheritParams P
#' @inheritParams utils::citation
#' @include simList-class.R
#' @export
#' @name citation
#' @rdname citation
#' @return The citation information for a SpaDES module.
#'
#' @aliases citation,simList-method
setMethod("citation",
          signature = "simList",
          definition = function(package, lib.loc, auto, module) {
            if (missing(module)) {
              module <- current(package)
              if (NROW(module) == 0)
                module <- unlist(modules(package))
            }
            out <- if (length(module) > 1) {
              lapply(package@depends@dependencies[module], function(deps)
                deps@citation)
            } else {
              package@depends@dependencies[[module]]@citation
            }
            return(out)
})

#' @export
#' @rdname citation
#' @name citation
#' @aliases citation,character-method
setMethod("citation",
          signature = "character",
          definition = function(package, lib.loc, auto, module) {
            utils::citation(package = package, lib.loc = lib.loc, auto = auto)
})

# session info --------------------------------------------------------------------------------

#' @inheritParams P
#' @inheritParams utils::citation
#' @include simList-class.R
#' @export
#' @rdname simList-accessors-metadata
#'
#' @aliases simList-accessors-metadata
setGeneric("sessInfo", function(sim) {
  standardGeneric("sessInfo")
})

#' @export
#' @rdname simList-accessors-metadata
#' @aliases simList-accessors-metadata
setMethod("sessInfo",
          signature = "simList",
          definition = function(sim) {
            return(sim@.xData[["._sessionInfo"]])
})

#' Show which objects were first created in a `simInit` or `spades` call
#'
#' This does an `rbindlist(sim$._objectsCreated)`.
#' This object in the `sim` records the yellow message that reports on when objects are created.
#'
#' @param sim A `simList` object that contains data.table `objects`
#'
#' @export
#' @importFrom data.table data.table rbindlist setorderv
#' @aliases newObjectsCreated
#' @aliases objectsCreated
#' @rdname simList-accessors-objects
#' @return The `data.table` of the objects created, alongside the `current(sim)`
#' at each moment of creation.
newObjectsCreated <- function(sim) {
  if (!is.null(sim$._objectsCreated)) {
    dt <- rbindlist(sim$._objectsCreated)
    setorderv(dt, "newObjects")
    print(format(as.data.frame(dt), justify = "left"))
  } else {
    dt <- data.table(newObjects = character(), .emptyEventListDT)
  }
  invisible(dt)
}

# elapsedTime ---------------------------------------------------------------------------------

#' @export
#' @include simList-class.R
#' @include times.R
#' @rdname simList-accessors-times
elapsedTime <- function(x, ...) UseMethod("elapsedTime")

#' @param byEvent Logical. If `TRUE`, the elapsed time will be by module and event;
#'                `FALSE` will report only by module. Default is `TRUE`.
#'
#' @inheritParams base::difftime
#' @export
#' @rdname simList-accessors-times
#' @examples
#'
#' # Elapsed Time
#' s1 <- simInit()
#' s2 <- spades(s1)
#' elapsedTime(s2)
#' elapsedTime(s2, units = "mins")
elapsedTime.simList <- function(x, byEvent = TRUE, units = "auto", ...) {
  comp <- completed(x)

  if (!is.null(comp)) {
    comp <- comp[, list(moduleName, eventType,
                          diffTime = diff(c(x@.xData[["._firstEventClockTime"]], get(._txtClockTime))))]
    theBy <- if (isTRUE(byEvent)) {
      c("moduleName", "eventType")
    } else {
      c("moduleName")
    }
    ret <- comp[, list(elapsedTime = sum(diffTime)), by = theBy] #nolint
    a <- ret$elapsedTime
    if (identical(units, "auto")) {
      unt <- "secs"
      if (any(a > minutesInSeconds)) {
        unt <- "mins"
      } else if (any(a > hoursInSeconds)) {
        unt <- "hours"
      } else if (any(a > daysInSeconds)) {
        unt <- "days"
      }
    } else {
      # This one won't allow "auto"
      unt <- units
      units(a) <- units
    }
    st <- Sys.time()
    a <- round(difftime(a + st, st, units = unt), 3) # work around for forcing a non seconds unit, allowing "auto"

    ret[, elapsedTime := a]
  } else {
    ret <- NULL
  }
  return(ret[])
}

#' @inheritParams inputObjects
#'
#' @return
#' `moduleObjects` returns a data.table with 4 columns, `module`, `objectName`, `type`, and `desc`,
#' pulled directly from the object metadata in the `createsOutputs` and `expectsInputs`. These
#' will be determined either from a `simList` or from the module source code.
#'
#' @export
#' @importFrom data.table set rbindlist setcolorder
#' @importFrom reproducible .whereInStack
#' @rdname objects
moduleObjects <- function(sim, module, path) {
  simTry <- NULL # can't set `sim = NULL` because `.whereInStack`; also next line check
  if (missing(sim)) {
    if (missing(module)) {
      browser()
      simTry <- suppressWarnings(try(get("sim", .whereInStack("sim")), silent = TRUE))
    }
    sim <- simTry
  }

  if (!is.null(sim)) {
    path <- modulePath(sim)
    if (missing(module))
      module <- modules(sim)
    a <- Map(nam = unlist(unname(module)),
        mod = module, function(mod, nam) inputObjects(sim, module = mod))
    b <- Map(nam = unlist(unname(module)),
             mod = module, function(mod, nam) inputObjects(sim, module = mod))
    a <- rbindlist(a, idcol = "module", fill = TRUE)
    b <- rbindlist(b, idcol = "module", fill = TRUE)
  } else {
    if (missing(path)) {
      path <- getOption("spades.modulePath")
    }
    if (missing(module)) {
      module <- dir(path)
    }
    a <- Map(nam = unlist(unname(module)), pat = path,
             mod = module, function(mod, nam, pat)
               inputObjects(module = mod, path = pat)[[1]])
    b <- Map(nam = unlist(unname(module)), pat = path,
             mod = module, function(mod, nam, pat)
               outputObjects(module = mod, path = pat)[[1]])

    a <- rbindlist(a, fill = TRUE, use.names = TRUE, idcol = "module")
    b <- rbindlist(b, fill = TRUE, use.names = TRUE, idcol = "module")
  }
  set(a, NULL, "type", "input")
  srcURL <- "sourceURL"
  if (srcURL %in% colnames(a))
    set(a, NULL, "sourceURL", NULL)
  set(b, NULL, "type", "output")
  if (srcURL %in% colnames(b))
    set(b, NULL, "sourceURL", NULL)
  d <- rbindlist(list(a, b), use.names = TRUE, fill = TRUE)
  data.table::setcolorder(d, neworder = c("objectName", "module", "type"))
  d[]
}

#' @export
#' @rdname objects
#' @param objects A character vector of length >= 1 with name(s) of objects to look
#'   for in the metadata. This is used in a `grep`, meaning it will do partial
#'   matching (e.g., `"studyArea"` will find `"studyArea"` and `"studyAreaLarge"`).
#'   User can use regular expressions.
#' @return
#' `findObjects` returns a data.table similar to `moduleObjects`, but with only the
#' objects provided by `objects`.
#' @importFrom data.table set rbindlist
#' @examples
#' # findObjects
#' path <- getSampleModules(tempdir())
#' findObjects(path = path, module = dir(path), objects = "caribou")
findObjects <- function(objects, sim, module, path) {
  mo <- moduleObjects(sim, module, path)
  mo[grep(paste(objects, collapse = "|"), objectName), ]
}

#' Extract an intact `simList` but with subset of objects
#'
#' This is copies the non-object components of a `simList` (e.g., events, etc.)
#' then selects only the objects listed in `i` using `Copy(mget(i, envir(sim)))`
#' and adds them to the returned `simList`.
#'
#' @author Eliot McIntire
#' @param i A character vector of objects to select.
#' @param j Not used.
#' @param ... Not used.
#' @param drop Not used.
#' @param x A `simList`
#'
#' @return
#' The `[` method returns a complete `simList` class with all the slots
#'   copied from the original, but only the named objects in `i` are returned.
#' @examples
#' s <- simInit()
#' s$a <- 1
#' s$b <- 2
#' s$d <- 3
#' s[c("a", "d")] # a simList with only 2 objects
#'
#'
#' @export
setMethod(
  "[",
  signature = list(x = "simList", i = "character"),
  function(x, i, ...) {
    x2 <- Copy(x, objects = 2)
    list2env(Copy(mget(i, envir = envir(x))), envir = envir(x2))
    x2
  }
)

