utils::globalVariables(c(".", ".I", "tagKey", "whi"))

#' @keywords internal
.savedSimEnv <- new.env()
.savedSimEnv$.sim <- list() ## placeholder for future simList

#' Retrieve environment for saving interrupted simulations
#'
#' If the user sets `options(reproducible.memoisePersist = TRUE)`,
#' the global environment will be used, otherwise, a package environment.
#'
#' @param envir an environment to use to store the `.sim` (`simList`) object.
#'              default is to use the user's global environment (`.GlobalEnv`).
#'
#' @export
#' @rdname savedSimEnv
savedSimEnv <- function(envir = .GlobalEnv) {
  if (isTRUE(getOption("reproducible.memoisePersist"))) {
    envir
  } else {
    .savedSimEnv
  }
}

#' Process a simulation event
#'
#' Internal function called from `spades`.
#'
#' Calls the module corresponding to the event call, and executes the event.
#'
#' Here, we implement a simulation in a more modular fashion so it's easier to add
#' submodules to the simulation. We use S4 classes and methods.
#'
#' @param sim Character string for the `simList` simulation object.
#' @param useFuture Experimental use of future::future package. Not fully implemented.
#'
#' @inheritParams spades
#' @return Returns the modified `simList` object.
#'
#' @references Matloff, N. (2011). The Art of R Programming (ch. 7.8.3).
#'             San Francisco, CA: No Starch Press, Inc. ISBN 978-1-59327-384-2.
#'
#' @author Alex Chubaty
#' @export
#' @importFrom data.table data.table rbindlist fread
#' @importFrom reproducible Cache messageDF
#' @importFrom Require messageVerbose
#' @importFrom utils write.table
#' @include helpers.R memory-leaks.R
#' @keywords internal
#' @rdname doEvent
doEvent <- function(sim, debug = FALSE, notOlderThan,
                    useFuture = getOption("spades.futureEvents", FALSE),
                    events = NULL,
                    ...) {
  if (!inherits(sim, "simList")) {
    stop("doEvent can only accept a simList object")
  }

  set_console_width(update = TRUE) # sets options(width = XXX) to correct width

  # core modules
  core <- .pkgEnv$.coreModules

  if (isTRUE(useFuture)) {
    # Check here if resolved
    curForFuture <- sim@events[[1]]
    if (!curForFuture[["moduleName"]] %in% .pkgEnv$.coreModulesMinusSave) {
      if (length(sim$.simFuture)) {
        modInFuture <- modNameInFuture(sim$.simFuture)
        futureNeeds <- getFutureNeeds(deps = sim@depends@dependencies,
                                      curModName = modInFuture[1])#sim$.simFuture[[1]]$thisModOutputs$dontAllowModules)#curForFuture[["moduleName"]])
        canProceed <- if (length(futureNeeds)) {
          # with the assumption that the "unresolved" future could schedule itself,
          # must block any module who's outputs are needed by the same module as the
          # unresolved future module
          nextScheduledEvent <- curForFuture$moduleName
          if (nextScheduledEvent %in% "save") {
            outs <- outputs(sim)
            objsNeeded <- outs$objectName[outs$saveTime == events(sim)$eventTime[1]]
            nOtherFutures <- length(sim$.simFuture) - 1
            futureNeedsOther <- lapply(seq(nOtherFutures) + 1, function(i)
              getFutureNeeds(deps = sim@depends@dependencies,
                             curModName = modInFuture[i]))
            futureNeedsOther <- append(list(futureNeeds), futureNeedsOther)
            futureNeedsOtherDAM <- lapply(futureNeedsOther, function(fno) fno$dontAllowModules)
            futureNeeds$dontAllowModules <- colSums(Reduce(rbind, futureNeedsOtherDAM)) > 0
          }
          immediateDownstream <- names(futureNeeds$dontAllowModules)[futureNeeds$dontAllowModules]

          if (length(immediateDownstream) && !nextScheduledEvent %in% "save")
            immediateDownstream <- immediateDownstream[immediateDownstream %in% curForFuture$moduleName]#&&
          length(immediateDownstream) == 0
        } else {
          TRUE
        }

        if (!canProceed || future::resolved(sim$.simFuture[[1]][[1]])) {
          cause <- if (!canProceed) paste0(curForFuture$moduleName, " requires outputs from ", modInFuture[1])
          else if (curForFuture$moduleName == "save") paste0("Current event is 'save'; so resolving all")
          else paste0(modInFuture[1], " finished running")

          sim <- resolveFutureNow(sim, cause = cause)
          return(invisible(sim))
        }
      }
    }
  }

  if (length(sim@current) == 0) {
    # get next event from the queue and remove it from the queue
    if (length(sim@events)) {
      # Section for allowing events to be specified in `spades` call
      dots <- list(...)
      eventIndex <- if (!is.null(events))
        isListedEvent(sim@events, events) else 1L

      if (eventIndex == 0L) {
        slot(sim, "current", check = FALSE) <- list() # same as no events left
      } else {
        # Do same check as would be done with "slot(..., check = FALSE)", but much faster
        if (is.list(sim@events[[eventIndex]]))
          slot(sim, "current", check = FALSE) <- sim@events[[eventIndex]]
        if (is.list(sim@events[-eventIndex]))
          slot(sim, "events", check = FALSE) <- sim@events[-eventIndex]
      }
    } else {
      # no more events, return empty event list
      slot(sim, "current", check = FALSE) <- list() # this is guaranteed to be a list
    }
  }

  # catches the situation where no future event is scheduled,
  #  but stop time is not reached
  cur <- sim@current

  # loggingMessage helpers
  simNestingRevert <- sim[[._txtSimNesting]]
  on.exit(sim[[._txtSimNesting]] <- simNestingRevert, add = TRUE)
  sim[[._txtSimNesting]] <- simNestingOverride(sim, sim@current$moduleName)
  ._simNesting <- sim[[._txtSimNesting]]

  curModuleName <- cur[["moduleName"]]
  if  (length(cur) == 0) {
    # Test replacement for speed
    #slot(sim, "simtimes")[["current"]] <- sim@simtimes[["end"]] + 1
    st <- slot(sim, "simtimes")
    st[["current"]] <- sim@simtimes[["end"]] + 1
    slot(sim, "simtimes", check = FALSE) <- st
  } else {
    # if the current time is greater than end time, then don't run it
    if (cur[["eventTime"]] <= sim@simtimes[["end"]]) {
      fnEnv <- sim@.xData[[dotMods]][[curModuleName]]

      # This allows spades to run even if all the functions are in the .GlobalEnv;
      #   while this is generally bad practice, and none of the tools in spades
      #   enable this to happen, this allows a user can manually run individual functions
      #   like `doEvent.XXX` and `scheduleEvent`, then run `spades(sim)` without failing
      if (is.null(fnEnv)) {
        if (!curModuleName %in% .coreModules())
          fnEnv <- asNamespace("SpaDES.core")
      }
      fnEnvIsSpaDES.core <- identical(fnEnv, asNamespace("SpaDES.core"))

      # update current simulated time
      # Test replacement for speed
      st <- slot(sim, "simtimes")
      st[["current"]] <- cur[["eventTime"]]
      slot(sim, "simtimes", check = FALSE) <- st

      # call the module responsible for processing this event
      moduleCall <- paste("doEvent", curModuleName, sep = ".")
      # Modules can use either the doEvent approach or defineEvent approach, with doEvent taking priority
      if (!is.null(fnEnv)) {
        if (!exists(moduleCall, envir = fnEnv)) {
          moduleCallSeparateEventFns <- makeEventFn(curModuleName, cur[["eventType"]])
          if (!is.null(sim@.xData[[eventFnElementEnvir()]])) {
            fnEnv <- sim@.xData[[eventFnElementEnvir()]][[moduleCallSeparateEventFns]]$envir
            moduleCall <- moduleCallSeparateEventFns
          } else {
            if (exists(moduleCallSeparateEventFns, envir = fnEnv)) { # don't specify inherits = FALSE because might be elsewhere
              moduleCall <- moduleCallSeparateEventFns
            }
          }
        }
      }

      # if debug is TRUE
      if (is.null(attr(sim, "needDebug"))) {
        attr(sim, "needDebug") <- if (length(debug) > 1) {
          !(all(unlist(lapply(debug, identical, FALSE))))
        } else {
          !identical(debug, FALSE)
        }
      }
      if (attr(sim, "needDebug") + 1) {
        debugHere <- if (!is.numeric(debug)) debug else ifelse(debug < 1, debug + 1, debug)
        # debugMessage(ifelse(debug < 1, debug + 1, debug), sim, cur, fnEnv, curModuleName)
        debugMessage(debugHere, sim, cur, fnEnv, curModuleName)
      }

      # if the moduleName exists in the simList -- i.e,. go ahead with doEvent
      moduleIsInSim <- curModuleName %in% sim@modules
      if (!moduleIsInSim && !fnEnvIsSpaDES.core)
        stop("Invalid module call. The module `", curModuleName, "` wasn't specified to be loaded.")
      # if (curModuleName %in% sim@modules) {
      if (curModuleName %in% core) {
        sim <- get(moduleCall)(sim, cur[["eventTime"]], cur[["eventType"]])
      } else {
        # for future caching of modules
        cacheIt <- FALSE
        eventSeed <- sim@params[[curModuleName]][[".seed"]][[cur[["eventType"]]]]
        a <- sim@params[[curModuleName]][[._txtDotUseCache]]
        if (!is.null(a)) {
          #.useCache is a parameter
          if (!identical(FALSE, a)) {
            #.useCache is not FALSE
            if (!isTRUE(a)) {
              #.useCache is not TRUE
              if (cur[["eventType"]] %in% a) {
                cacheIt <- TRUE
              } else if (inherits(a, "POSIXt")) {
                cacheIt <- TRUE
                notOlderThan <- a
              }
            } else {
              cacheIt <- TRUE
            }
          }
        }


        # browser(expr = exists("._doEvent_2"))
        showSimilar <- if (is.null(sim@params[[curModuleName]][[".showSimilar"]]) ||
                           isTRUE(is.na(sim@params[[curModuleName]][[".showSimilar"]]))) {
          isTRUE(getOption("reproducible.showSimilar", FALSE))
        } else {
          isTRUE(sim@params[[curModuleName]][[".showSimilar"]])
        }

        # This is to create a namespaced module call
        # if (!.pkgEnv[["skipNamespacing"]])
        #   .modifySearchPath(sim@depends@dependencies[[curModuleName]]@reqdPkgs,
        #                     removeOthers = FALSE)

        skipEvent <- FALSE
        if (!is.null(eventSeed)) {
          if (exists(".Random.seed", inherits = FALSE, envir = .GlobalEnv))
            initialRandomSeed <- .Random.seed
          set.seed(eventSeed) # will create .Random.seed
        }

        .pkgEnv <- as.list(get(".pkgEnv", envir = asNamespace("SpaDES.core")))
        if (useFuture) {
          # stop("using future for spades events is not yet fully implemented")
          futureNeeds <- getFutureNeeds(deps = sim@depends@dependencies,
                                        curModName = cur[["moduleName"]])

          # In general... allow a spawning, unless it is literally next event
          #   This is just a heuristic because other events could be inserted before
          #    the next event ... but this is a decent guess
          # don't use cur from above because it is "seconds" which mess with future

          # by running scheduleEvents first, we can see what the "next" event will actually
          #   be so we can determine what inputs will be needed.
          simNext <- runScheduleEventsOnly(sim, currnt = cur) # run the scheduleEvents only
          nextScheduledEvent <- simNext@events[[1]]$moduleName

          objsNeeded <- NULL
          if (nextScheduledEvent %in% "save") {
            outs <- outputs(sim)
            objsNeeded <- outs$objectName[outs$saveTime == events(sim)$eventTime[1]]
          }
          objsNeededForNextMod <- futureNeeds$anyModInputs[[nextScheduledEvent]]
          # selfObjects <- futureNeeds$thisModOutputs[futureNeeds$thisModOutputs %in% futureNeeds$thisModsInputs]
          objsNeeded <- na.omit(unique(c(objsNeeded, objsNeededForNextMod)))#, selfObjects)))
          if (!any(futureNeeds$thisModOutputs %in% objsNeeded)) {
            spacing <- paste(rep(" ", sim[["._spadesDebugWidth"]][1] + 1), collapse = "")
            messageVerbose(
              cli::col_magenta(paste0(spacing, cur[["moduleName"]], " outputs not needed by ",
                                      "next module (", nextScheduledEvent, ")")),
              verbose = 1 - (debug %in% FALSE))
            simFuture <- sim$.simFuture
            sim$.simFuture <- list()
            cur2 <- unlist(current(sim))
            cur2[["eventTime"]] <- as.numeric(cur2[["eventTime"]])
            sim <- .runEventFuture(sim, cacheIt, debug, moduleCall, fnEnv, cur2, notOlderThan,
                                   showSimilar = showSimilar, .pkgEnv, envir = environment(),
                                   futureNeeds = futureNeeds)
            sim$.simFuture <- append(simFuture, sim$.simFuture)
            # sim <- runScheduleEventsOnly(sim, currnt = cur2) # run the scheduleEvents only
            sim@events <- simNext@events
            skipEvent <- TRUE
          }
        }

        if (!skipEvent) {
          sim <- .runEvent(sim, cacheIt, debug, moduleCall, fnEnv, cur, notOlderThan,
                           showSimilar = showSimilar, .pkgEnv)
        }

        if (!is.null(eventSeed)) {
          if (exists("initialRandomSeed", inherits = FALSE))
            .Random.seed <- initialRandomSeed
        }

        # browser(expr = exists("._doEvent_3"))
        if (!fnEnvIsSpaDES.core) {
          if (!exists(curModuleName, envir = sim@.xData[[dotMods]], inherits = FALSE))
            stop("The module named ", curModuleName, " just corrupted the object with that ",
                 "name from from the simList. ",
                 "Please remove the section of code that does this in the event named: ",
                 cur[["eventType"]])

          if (!is.environment(get(curModuleName, envir = sim@.xData[[dotMods]])))
            stop("The module named ", curModuleName, " just corrupted the object with that ",
                 "name from from the simList. ",
                 "Please remove the section of code that does this in the event named: ",
                 cur[["eventType"]])

          if (!exists("mod", envir = sim@.envir[[dotMods]][[curModuleName]], inherits = FALSE)) {
            if (!isNamespace(tryCatch(asNamespace(.moduleNameNoUnderscore(curModuleName)),
                                      silent = TRUE, error = function(x) FALSE)
            ))
              warning("The module named ", curModuleName, " just deleted the object named 'mod' from ",
                   "sim$", curModuleName, ". ",
                   "Please remove the section of code that does this in the event named: ",
                   cur[["eventType"]])
          }
        }
      }

      # add to list of completed events
      if (.pkgEnv[["spades.keepCompleted"]]) { # can skip it with option
        # cur[[._txtClockTime]] <- Sys.time() # adds between 1 and 3 microseconds, per event b/c R won't let us use .Internal(Sys.time())
        sim <- appendCompleted(sim, cur)
      }

      # current event completed, replace current with empty
      slot(sim, "current", check = FALSE) <- list() # is a list
    } else {
      # update current simulated time and event
      # Test replacement for speed
      #slot(sim, "simtimes")[["current"]] <- sim@simtimes[["end"]] + 1
      st <- slot(sim, "simtimes")
      st[["current"]] <- sim@simtimes[["end"]] + 1
      slot(sim, "simtimes", check = FALSE) <- st

      # i.e., if no more events
      slot(sim, "events", check = FALSE) <- append(list(sim@current), sim@events) # will be a list b/c append
      slot(sim, "current", check = FALSE) <- list() # is a list
    }
  }

  if (exists("objectSynonyms", envir = sim, inherits = FALSE)) {
    sim <- .checkObjectSynonyms(sim)
  }

  return(invisible(sim))
}

################################################################################
#' Schedule a simulation event
#'
#' Adds a new event to the simulation's event queue, updating the simulation object.
#'
#' Here, we implement a simulation in a more modular fashion so it's easier to add
#' submodules to the simulation. We use S4 classes and methods, and use `data.table`
#' instead of `data.frame` to implement the event queue (because it is much faster).
#'
#' @param sim            A `simList` simulation object.
#'
#' @param eventTime      A numeric specifying the time of the next event.
#'
#' @param moduleName     A character string specifying the module from which to
#'                       call the event. If missing, it will use
#'                       `currentModule(sim)`
#'
#' @param eventType      A character string specifying the type of event from
#'                       within the module.
#'
#' @param eventPriority  A numeric specifying the priority of the event.
#'                       Lower number means higher priority. As a best practice, it is
#'                       recommended that decimal values are conceptual
#'                       grouped by their integer values (e.g., 4.0, 4.25, 4.5 are conceptually
#'                       similar).
#'                       See [priority()].
#' @param .skipChecks Logical. If `TRUE`, then internal checks that arguments match
#'                    expected types are skipped. Should only be used if speed is critical.
#'
#' @return Returns the modified `simList` object.
#'
#' @include priority.R
#' @export
#' @rdname scheduleEvent
#' @seealso [priority()], [scheduleConditionalEvent()]
#'
#' @author Alex Chubaty
#'
#' @references Matloff, N. (2011). The Art of R Programming (ch. 7.8.3).
#'             San Francisco, CA: No Starch Press, Inc. ISBN 978-1-59327-384-2.
#'
#' @examples
#'  sim <- simInit()
#'  sim <- scheduleEvent(sim, time(sim) + 1.0, "fireSpread", "burn") # default priority
#'  sim <- scheduleEvent(sim, time(sim) + 1.0, "fireSpread", "burn", .normal()) # default priority
#'
#'  sim <- scheduleEvent(sim, time(sim) + 1.0, "fireSpread", "burn", .normal()-1) # higher priority
#'  sim <- scheduleEvent(sim, time(sim) + 1.0, "fireSpread", "burn", .normal()+1) # lower priority
#'
#'  sim <- scheduleEvent(sim, time(sim) + 1.0, "fireSpread", "burn", .highest()) # highest priority
#'  sim <- scheduleEvent(sim, time(sim) + 1.0, "fireSpread", "burn", .lowest()) # lowest priority
#'  events(sim) # shows all scheduled , with eventTime and priority
scheduleEvent <- function(sim,
                          eventTime,
                          moduleName,
                          eventType,
                          eventPriority = .pkgEnv$.normalVal,
                          .skipChecks = FALSE) {

  if (missing(moduleName)) moduleName <- currentModule(sim)

  if (!.skipChecks) {
    if (!inherits(sim, "simList")) {
      stop("sim must be a simList")  ## July 2022: R 4.2 flags against using class()
    }

    if (!is.numeric(eventTime)) {
      if (is.na(eventTime)) {
        eventTime <- NA_real_
      } else {
        stop(paste(
          "Invalid or missing eventTime. eventTime must be a numeric.",
          "This is usually caused by an attempt to scheduleEvent at time NULL",
          "or by using an undefined parameter."
        ))
      }
    }
    if (!is.character(eventType)) stop("eventType must be a character")
    if (!is.character(moduleName)) stop("moduleName must be a character")
    if (!is.numeric(eventPriority)) stop("eventPriority must be a numeric")

  }
  if (length(eventTime)) {
    sim <- appendEvents(sim, eventTime, eventType, moduleName, eventPriority)
  } else {
    warning(
      paste(
        "Invalid or missing eventTime. ",
        "This is usually caused by an attempt to scheduleEvent at an empty eventTime ",
        "or by using an undefined parameter."
      )
    )
  }

  return(invisible(sim))
}

#' Schedule a conditional simulation event
#'
#' Adds a new event to the simulation's conditional event queue,
#' updating the simulation object by creating or appending to
#' `sim$._conditionalEvents`.
#' *This is very experimental. Use with caution.*
#'
#' This conditional event queue will be assessed at every single event in the normal event
#' queue. If there are no conditional events, then `spades` will proceed as normal.
#' As conditional event conditions are found to be true, then it will trigger a call to
#' `scheduleEvent(...)` with the current time passed to `eventTime` *and*
#' it will remove the conditional event from the conditional queue.
#' If the user would like the triggered conditional event to occur as the very next event,
#' then a possible strategy would be to set `eventPriority` of the conditional event
#' to very low or even negative to ensure it gets inserted at the top of the event queue.
#'
#' @inheritParams scheduleEvent
#'
#' @param minEventTime   A numeric specifying the time before which the event should not occur,
#'         even if the condition is met. Defaults to `start(sim)`
#'
#' @param maxEventTime   A numeric specifying the time after which the event should not occur,
#'         even if the condition is met. Defaults to `end(sim)`
#'
#' @param condition A string, call or expression that will be assessed for `TRUE`
#'      after each event in the regular event queue.
#'      It can access objects in the `simList` by using functions of `sim`,
#'      e.g., `"sim$age > 1"`
#'
#' @return Returns the modified `simList` object, i.e., `sim$._conditionalEvents`.
#'
#'
#' @include priority.R
#' @export
#' @rdname scheduleConditionalEvent
#' @seealso [scheduleEvent()], [conditionalEvents()]
#'
#' @author Eliot McIntire
#'
#' @references Matloff, N. (2011). The Art of R Programming (ch. 7.8.3).
#'             San Francisco, CA: No Starch Press, Inc. ISBN 978-1-59327-384-2.
#'
#' @examples
#'   sim <- simInit(times = list(start = 0, end = 2))
#'   condition <- "sim$age > 1" # provide as string
#'   condition <- quote(sim$age > 1) # provide as a call
#'   condition <- expression(sim$age > 1) # provide as an expression
#'   sim <- scheduleConditionalEvent(sim, condition, "firemodule", "burn")
#'   conditionalEvents(sim)
#'   sim <- spades(sim) # no changes to sim$age, i.e., it is absent
#'   events(sim) # nothing scheduled
#'   sim$age <- 2 # change the value
#'   sim <- spades(sim) # Run spades, the condition is now true, so event is
#'                      #  scheduled at current time
#'   events(sim)        # now scheduled in the normal event queue
scheduleConditionalEvent <- function(sim,
                                     condition,
                                     moduleName,
                                     eventType,
                                     eventPriority = .normal(),
                                     minEventTime = start(sim),
                                     maxEventTime = end(sim)) {
  if (!inherits(sim, "simList")) {
    stop("sim must be a simList") ## July 2022: R 4.2 flags against using class()
  }

  if (!is.numeric(minEventTime)) {
    if (is.na(minEventTime)) {
      eventTime <- NA_real_
    } else {
      stop(paste(
        "Invalid or missing minEventTime. minEventTime must be a numeric.",
        "This is usually caused by an attempt to scheduleEvent at time NULL",
        "or by using an undefined parameter."
      ))
    }
  }
  if (!is.numeric(maxEventTime)) {
    if (is.na(maxEventTime)) {
      eventTime <- NA_real_
    } else {
      stop(paste(
        "Invalid or missing maxEventTime. maxEventTime must be a numeric.",
        "This is usually caused by an attempt to scheduleEvent at time NULL",
        "or by using an undefined parameter."
      ))
    }
  }

  if (!is.character(eventType)) stop("eventType must be a character")
  if (!is.character(moduleName)) stop("moduleName must be a character")
  #if (missing(eventPriority)) eventPriority <- .pkgEnv$.normalVal
  if (!is.numeric(eventPriority)) stop("eventPriority must be a numeric")

  if (length(condition)) {
    #if (!is.na(condition)) {

    # Convert quote or "" to expression
    if (is.call(condition)) {
      cond <- as.expression(condition)
    } else if (is.character(condition)) {
      cond <- parse(text = condition)
    } else if (is.expression(condition)) {
      cond <- condition
    } else {
      stop("condition must be a character string or call or expression")
    }

    # minEventTime
    minEventTimeInSeconds <- calculateEventTimeInSeconds(sim, minEventTime, moduleName)
    attr(minEventTimeInSeconds, "unit") <- "second"

    # maxEventTime
    maxEventTimeInSeconds <- calculateEventTimeInSeconds(sim, maxEventTime, moduleName)
    attr(maxEventTimeInSeconds, "unit") <- "second"

    newEventList <- list(list(
      condition = cond,
      minEventTime = minEventTimeInSeconds,
      maxEventTime = maxEventTimeInSeconds,
      moduleName = moduleName,
      eventType = eventType,
      eventPriority = eventPriority
    ))
    numEvents <- length(sim$._conditionalEvents)

    # put new event into event queue
    if (numEvents == 0L) {
      sim$._conditionalEvents <- newEventList
    } else {
      sim$._conditionalEvents <- append(sim$._conditionalEvents, newEventList)
      needSort <- TRUE
      if (minEventTimeInSeconds > sim$._conditionalEvents[[numEvents]]$minEventTime) {
        needSort <- FALSE
      } else if (minEventTimeInSeconds == sim$._conditionalEvents[[numEvents]]$minEventTime &&
                 eventPriority >= sim$._conditionalEvents[[numEvents]]$eventPriority) {
        needSort <- FALSE
      }
      if (needSort) {
        ord <- order(unlist(lapply(sim$._conditionalEvents, function(x) x$eventTime)),
                     unlist(lapply(sim$._conditionalEvents, function(x) x$eventPriority)))
        sim$._conditionalEvents <- sim$._conditionalEvents[ord]
      }
      #      }
    }
  } else {
    warning(
      paste(
        "Invalid or missing condition ",
        "This is usually caused by an attempt to scheduleEvent at an empty condition ",
        "or by using an undefined parameter."
      )
    )
  }

  return(invisible(sim))
}

################################################################################
#' Run a spatial discrete event simulation
#'
#' Here, we implement a simulation in a more modular fashion so it's easier to add
#' submodules to the simulation. We use S4 classes and methods, and use `data.table`
#' instead of `data.frame` to implement the event queue (because it is much faster).
#'
#' @param sim A `simList` simulation object, generally produced by `simInit`.
#'
#' @param debug Optional tools for invoking debugging. Supplying a `list`
#'              will invoke the more powerful `logging` package. See details.
#'              Default is to use the value in `getOption("spades.debug")`.
#'
#' @param progress Logical (`TRUE` or `FALSE` show a graphical progress bar),
#'                 character (`"graphical"`, `"text"`) or numeric indicating
#'                 the number of update intervals to show in a graphical progress bar.
#'
#' @param cache Logical. If `TRUE`, then the `spades` call will be cached.
#'              This means that if the call is made again with the same `simList`,
#'              then `spades` will return the return value from the previous run
#'              of that exact same `simList`. Default `FALSE`. See Details.
#'              See also the vignette on caching for examples.
#'
#' @param .plotInitialTime Numeric. Temporarily override the `.plotInitialTime`
#'                                  parameter for all modules. See Details.
#'
#' @param .saveInitialTime Numeric. Temporarily override the `.plotInitialTime`
#'                                  parameter for all modules. See Details.
#'
#' @param .plots Character. Sets the parameter of this name in all modules.
#'   See [Plots()] for possible values. The parameter is intended to slowly
#'   take over from `.plotInitialTime` as a mechanism to turn on or off plotting.
#'   For backwards compatibility, if `.plotInitialTime` is not set in this `spades` call,
#'   but this `.plots` is used, two things will happen: setting this without `"screen"`
#'   will turn off all plotting; setting this with `"screen"` will trigger
#'   plotting for any modules that use this parameter but will have no effect on
#'   other modules. To get plotting, therefore, it may be necessary to also set
#'   `.plotInitialTime = start(sim)`.
#'
#' @param notOlderThan Date or time. Passed to `reproducible::Cache` to update the cache.
#'                     Default is `NULL`, meaning don't update the cache.
#'                     If `Sys.time()` is provided, then it will force a recache,
#'                     i.e., remove old value and replace with new value.
#'                     Ignored if `cache` is `FALSE`.
#' @param events A character vector or a named list of character vectors. If specified,
#'   the simulations will only do the events indicated here. If a named list, the names
#'   must correspond to the modules and the character vectors can be specific events within
#'   each of the named modules. With the `list` form, all unspecified modules
#'   will run *all* their events, including internal spades modules, e.g., `save`,
#'   that get invoked with the `outputs` argument in  `simInit`. However, if NOT a named list
#'   internal spades modules' events will not run, if not listed in the character vector.
#'   See example.
#'
#' @param ... Any. Can be used to make a unique cache identity, such as "replicate = 1".
#'            This will be included in the `Cache` call, so will be unique
#'            and thus `spades` will not use a cached copy as long as
#'            anything passed in `...` is unique, i.e., not cached previously.
#'
#' @return Invisibly returns the modified `simList` object.
#'
#' @seealso [SpaDES.core-package()],
#' [simInit()], and the caching vignette (very important for reproducibility):
#' <https://spades-core.predictiveecology.org/articles/iii-cache.html> which
#' uses [reproducible::Cache()].
#'
#'
#' @details
#' The is the workhorse function in the SpaDES package. It runs simulations by
#' implementing the rules outlined in the `simList`.
#'
#' This function gives simple access to two sets of module parameters:
#' `.plotInitialTime` and with `.plotInitialTime`. The primary use of
#' these arguments is to temporarily turn off plotting and saving. "Temporary"
#' means that the `simList` is not changed, so it can be used again with
#' the `simList` values reinstated. To turn off plotting and saving, use
#' `.plotInitialTime = NA` or `.saveInitialTime = NA`. NOTE: if a
#' module did not use `.plotInitialTime` or `.saveInitialTime`, then
#' these arguments will not do anything.
#'
#' @section Caching with SpaDES:
#'
#' There are numerous ways in which Caching can be used within SpaDES. Please
#' see the vignette
#' <https://spades-core.predictiveecology.org/articles/iii-cache.html>
#' for many examples. Briefly, functions, events, modules, entire spades calls or
#' experiment calls (see <https://github.com/PredictiveEcology/SpaDES.experiment>)
#' can be cached and mixtures of all of these will work. For functions, simply
#' wrap the call with `Cache`, moving the original function name into
#' the first argument of Cache. For events or modules, set the module `parameters`,
#' `.useCache`, e.g.,
#' `simInit(..., parameters = list(myModule = list(.useCache = "init")))`.
#' This can be set to an event name, which will cache that event, or a logical,
#' which will cache *every* event in that module. Event and module caching
#' makes most sense when the event or module only runs once, such as an initialization
#' or data preparation event/module. Caching an entire simulation is actually just
#' a function call to `simInitAndSpades`, for example. So, simply writing
#' `Cache(simInitAndSpades, modules = ...)` will effectively cache a whole simulation.
#' Finally for experiments, it is just like a function call:
#' `Cache(simInitandExperiment, ...)`. The final way Caching can be done is in
#' `experiment` or `spades`, by setting the `cache` argument.
#'
#' If `cache` is TRUE, this allows for a seamless way to "save" results
#' of a simulation. The  user does not have to intentionally do any saving manually.
#' Instead, upon a call to `spades` in which the `simList` is identical,
#' the function will simply return the result that would have come if it had
#' been rerun. Use this with caution, as it will return exactly the result from
#' a previous run, even if there is stochasticity internally.
#' Caching is only based on the input `simList.`
#' See also the vignette on caching for examples.
#'
#' @section `debug`:
#'
#' The most powerful way to use debug is to invoke the `logging`
#' R package. To invoke this, `debug` must be a list with up to 3
#' named elements:
#' `console`, `file`, and `debug`. Each of these list elements
#' must be a list (including empty `list()` for defaults) with the
#' sub-list elements here:
#' \tabular{lll}{
#'   `console` \tab `level` \tab The `level`, see below, of information shown\cr
#'   `file` \tab `append` \tab Logical. If `TRUE`, the default, then
#'                                       log entries are appended to file, if it exists\cr
#'               \tab `file` \tab A filename. Defaults to `log.txt`\cr
#'               \tab `level` \tab The `level`, see below, of information shown\cr
#'   `debug` \tab See possible values below\cr
#'   }
#'
#' `level` can be a number from 0 to 100 or a character string matching one
#' of the values in `logging::loglevels`. These are hierarchical levels of
#' information passed to the console. Set a lower number for more information and a
#' higher number for less information. Errors in code will be shown if `level`
#' is set to `"ERROR"` or `40` or above; warnings in code will be shown if
#' `level` is set to `"WARN"` or `30` or above;
#' normal messages in code will
#' be shown if `level` is set to `"INFO"` or `20` or above. For
#' consistency with base R messaging, if default level is used, then normal
#' messaging via `message` will be shown; this means that `suppressMessages`
#' will work to suppress messaging only when level is set to `"INFO"` or `20`.
#' Some functions in the SpaDES ecosystem may have information at the lower levels,
#' but currently, there are few to none.
#'
#' `debug` is specified as a non-list argument to `spades` or as
#' `list(debug = ...)`, then it can be a logical, a quoted call, a character vector
#' or a numeric scalar (currently 1 or 2) or a list of any of these to get multiple
#' outputs. This will be run at the start of every event. The following options for debug
#' are available. Each of these can also be in a list to get multiple outputs:
#'
#' \tabular{ll}{
#'   `TRUE` \tab `current(sim)` will be printed at the start of each event as
#'                     it runs\cr
#'   a function name (as character string) \tab If a function, then it will be run on the
#'                                            `simList`, e.g., "time" will run
#'                                            `time(sim)` at each event.\cr
#'   `moduleName` (as character string) \tab All calls to that module will be entered
#'                                         interactively\cr
#'   `eventName` (as character string) \tab All calls that have that event name (in any module)
#'                                        will be entered interactively\cr
#'   `c(<moduleName>, <eventName>)`  \tab Only the event in that specified module
#'                                             will be entered into. \cr
#'   Any other R expression expressed as a character string or quoted call \tab
#'                                 Will be evaluated with access to the `simList` as `sim`.
#'                                If this is more than one character string, then all will
#'                                be printed to the screen in their sequence. \cr
#'   A numeric scalar, currently 1 or 2 (maybe others) \tab This will print out alternative forms of event
#'                                           information that users may find useful \cr
#' }
#'
#' If not specified in the function call, the package
#' option `spades.debug` is used.
#'
#' If `options("spades.browserOnError" = TRUE)` (experimental still) if
#' there is an error, it will attempt to open a browser
#' in the event where the error occurred. You can edit, and then press `c` to continue
#' or `Q` to quit, plus all other normal interactive browser tools.
#' `c` will trigger a reparse and events will continue as scheduled, starting
#' with the one just edited. There may be some unexpected consequences if the
#' `simList` objects had already been changed before the error occurred.
#'
#' @note The debug option is primarily intended to facilitate building simulation
#' models by the user.
#' Will print additional outputs informing the user of updates to the values of
#' various `simList` slot components.
#' See <https://github.com/PredictiveEcology/SpaDES/wiki/Debugging> for details.
#'
#' @author Alex Chubaty and Eliot McIntire
#' @importFrom cli ansi_strip col_blue col_magenta start_app
#' @importFrom data.table setDTthreads
#' @seealso vignettes
#' @export
#' @rdname spades
#' @references Matloff, N. (2011). The Art of R Programming (ch. 7.8.3).
#'             San Francisco, CA: No Starch Press, Inc. ISBN 978-1-59327-384-2.
#'
#' @examples
#' \donttest{
#' if (requireNamespace("SpaDES.tools", quietly = TRUE) &&
#'       packageVersion("SpaDES.tools") > "3.0.0") {
#'   # some options are not necessary when not interactive
#'   opts <- options("spades.moduleCodeChecks" = FALSE, "spades.useRequire" = FALSE)
#'   if (!interactive()) opts <- append(opts, options("spades.plots" = NA))
#'   mySim <- simInit(
#'    times = list(start = 0.0, end = 1.0, timeunit = "year"),
#'    params = list(
#'      randomLandscapes = list(nx = 10, ny = 10),
#'      .globals = list(stackName = "landscape", burnStats = "nPixelsBurned",
#'                      .plots = NA) # plotting off --> not relevant for example
#'    ),
#'    modules = list("randomLandscapes", "fireSpread", "caribouMovement"),
#'    paths = list(modulePath = getSampleModules(tempdir()))
#'   )
#'   spades(mySim)
#'
#' # Example of `events` misuse: only the .inputObjects runs because "init"
#' # (an internal event) was not listed, does not run and, therefore, does
#' # not schedule other events
#' spades(mySim, events = c(".inputObjects", "burn", "move", "stats"))
#' completed(mySim)
#'
#' # Example of correct use of `events`: this adequately narrows down the
#' # events to be executed by a particular module, without affecting the
#' # events of other modules or internal events
#' spades(mySim, events = list(caribouMovement = c(".inputObjects", "init", "move")))
#' completed(mySim)
#'
#'   options(opts) # reset options
#' }
#' }
#'
setGeneric(
  "spades",
  function(sim, debug = getOption("spades.debug"), progress = NA, cache,
           .plotInitialTime = NULL, .saveInitialTime = NULL, notOlderThan = NULL,
           events = NULL, .plots = getOption("spades.plots", NULL), ...) {
    standardGeneric("spades")
  })

#' @rdname spades
setMethod(
  "spades",
  signature(sim = "simList", cache = "missing"),
  definition = function(sim, debug, progress, cache, .plotInitialTime, .saveInitialTime,
                        notOlderThan, events, .plots, ...) {
    ## set the options; then set them back on exit
    optsFromDots <- dealWithOptions(sim = sim, dotNames = ...names())
    if (!is.null(optsFromDots$optsPrev)) {
      ## remove from `sim` as these should not be there
      rm(list = unique(names(optsFromDots$optionsAsProvided)), envir = envir(sim))
      on.exit({
        ## reset options in session
        options(optsFromDots$optsPrev)
        ## put them back in simList for reassessment during spades
        if (exists("sim", inherits = FALSE))
          list2env(optsFromDots$optionsAsProvided, envir = envir(sim))
      }, add = TRUE)
    }

    ## loggingMessage helpers
    ._simNesting <- simNestingSetup(...)
    # sim[[._txtSimNesting]] <- ._simNesting
    sim[[._txtSimNesting]] <- ._simNesting

    # cacheChaining -- remove Cache tag if it isn't inside a simInitAndSpades call
    cacheChaining <- getOption("spades.cacheChaining", FALSE)
    if (isTRUE(cacheChaining)) {
      inSIAS <- .grepSysCalls(sys.calls(), "simInitAndSpades|simInitAndExperiment")
      if (length(inSIAS) == 0) {
        attr(sim, "tags") <- NULL # a bit draconian; remove the cacheId... when the goal is just to say, "don't do cacheChaining"
      }
    }

    opt <- options("encoding" = "UTF-8")
    # if (isTRUE(getOption("spades.allowSequentialCaching"))) {
    #   opt <- append(opt, options(reproducible.showSimilarDepth = 6))
    # }
    on.exit(options(opt), add = TRUE)

    if (is.character(getOption("spades.covr", FALSE)) &&  getOption("spades.covr2", TRUE) ) {
      modNam <- getOption("spades.covr")
      tf <- tempfile();
      on.exit(unlink(tf))
      cat(file = tf, paste("spades(sim, events = ", capture.output(dput(events)),
                           ", .plotInitialTime = ", .plotInitialTime, ")", collapse = "\n"))
      sim[[dotMods]][[modNam]]$sim <- sim
      opts <- options("spades.covr2" = FALSE) ## turn off this chunk 2nd time through
      on.exit(options(opts), add = TRUE)
      aa <- covr::environment_coverage(sim[[dotMods]][[modNam]], test_files = tf)
      rm(list = "sim", envir = sim[[dotMods]][[modNam]])
      options("spades.covr2" = TRUE)
      if (is.null(.pkgEnv$._covr)) .pkgEnv$._covr <- list()
      .pkgEnv$._covr <- append(.pkgEnv$._covr, list(aa))
      return(savedSimEnv()$.sim)
    }
    oldWd <- getwd()
    on.exit({
      setwd(oldWd)
    }, add = TRUE)
    # useNormalMessaging <- TRUE
    useLoggingPkg <- is.list(debug)
    if (useLoggingPkg) {
      if (requireNamespace("logging", quietly = TRUE)) {
        debug <- setupDebugger(debug)
        useLoggingPkg <- !(# !useLoggingPkg ||
          all(!grepl("writeToConsole", names(logging::getLogger()[["handlers"]]))))
      }  else {
        useLoggingPkg <- FALSE
      }
      if (!useLoggingPkg)
        debug <- unlist(debug)
      # }
    }
    if (!identical(debug, getOption("spades.debug"))) {
      opts <- options("spades.debug" = debug)
      on.exit(options(opts), add = TRUE)
    }


    ## need to recheck package loading because `simInit` may have been cached
    if (getOption("spades.loadReqdPkgs", TRUE)) {
      pkgs <- packages(sim)
      loadPkgs(pkgs)
    }

    sim <- withCallingHandlers({
      cli::start_app(output = "message", .auto_close = TRUE, .envir = environment())
      .pkgEnv$.inProgressBar <- FALSE
      .pkgEnv$.progressLastShown <- NULL

      ## RecoverMode Step 1 -- set up
      recoverModeTypo()
      # recoverModeWrong <- getOption("spades.recoverMode")
      # if (!is.null(recoverModeWrong)) {
      #   warning("Please set options('recoveryMode') with a 'y', not options('recoverMode')")
      # }
      recoverMode <- getOption("spades.recoveryMode", FALSE)

      ## If there already is a sim object saved in the package .savdeSimEnv, it may have objects,
      ##   and those objects may have temporary files from file-backed objects stored.
      ##   This will remove those file-backed temp files.
      clearFileBackedObjs(savedSimEnv()$.sim$.recoverableObjs, recoverMode)
      svdSimEnv <- savedSimEnv() # can't assign to a function
      svdSimEnv$.sim <- NULL
      svdSimEnv$.sim <- sim # set up pointer
      ## RecoverMode Step 1 -- End

      ## set the options("spades.xxxPath") to the values in the sim@paths
      oldGetPaths <- getPaths()
      do.call(setPaths, append(sim@paths, list(silent = TRUE)))
      on.exit({
        do.call(setPaths, append(list(silent = TRUE), oldGetPaths))
      }, add = TRUE)

      if (!is.null(sim@.xData[["._randomSeed"]])) {
        message("Resetting .Random.seed of session to the pre-existing value \n",
                "because sim$._randomSeed is not NULL. ",
                "To get a different seed, run: sim$._randomSeed <- NULL to clear it.")
        assign(".Random.seed", sim@.xData$._randomSeed[[1]], envir = .GlobalEnv)
        if (!is.null(sim$._rng.kind)) {
          do.call("RNGkind", as.list(sim$._rng.kind))
        }
        sim@.xData[["._randomSeed"]] <- NULL
        sim@.xData[["._rng.kind"]] <- NULL
      }
      if (is.null(sim@.xData[["._startClockTime"]]))
        sim@.xData[["._startClockTime"]] <- Sys.time()

      if (is.list(events)) {
        unspecifiedEvents <- setdiff(unlist(modules(sim, TRUE)), names(events))
        unspecifiedEvents <- setdiff(unspecifiedEvents, "progress")
        if (NROW(sim@outputs) == 0L)
          unspecifiedEvents <- setdiff(unspecifiedEvents, "save")
        if (NROW(sim@inputs) == 0L)
          unspecifiedEvents <- setdiff(unspecifiedEvents, "load")
        useChkpnt <- !any(is.na(params(sim)$checkpoint))
        if (!useChkpnt)
          unspecifiedEvents <- setdiff(unspecifiedEvents, "checkpoint")
        if (length(unspecifiedEvents)) {
          message("NOTE: ", paste(unspecifiedEvents, collapse = ", "), " not specified in events argument. ")
          message("This means all events in the module(s) will run. You may have intended to add e.g.,")
          message(" list(", unspecifiedEvents[1], "= 'init')")
        }
      }

      ## This sets up checking for memory leaks
      if (is.null(sim@.xData[["._knownObjects"]])) {
        moduleNames <- unname(modules(sim))
        names(moduleNames) <- moduleNames
        sim@.xData[["._knownObjects"]] <- lapply(moduleNames, function(x) character())
        sim@.xData[["._knownObjects"]]$sim <- character()
      }
      if (is.null(sim@.xData[["._simRndString"]]))
        sim@.xData[["._simRndString"]] <- rndstr(1, 8, characterFirst = TRUE)
      .pkgEnv$searchPath <- search()
      .pkgEnv[["spades.browserOnError"]] <- (interactive() & !identical(debug, FALSE) &
                                               getOption("spades.browserOnError"))
      .pkgEnv[["spades.nCompleted"]] <- getOption("spades.nCompleted")
      # .pkgEnv[["skipNamespacing"]] <- !getOption("spades.switchPkgNamespaces")
      .pkgEnv[["spades.keepCompleted"]] <- getOption("spades.keepCompleted", TRUE)

      ## Memory Use
      ## memory estimation of each event/sim
      if (getOption("spades.memoryUseInterval", 0) > 0) {
        if (requireNamespace("future", quietly = TRUE) &&
            requireNamespace("future.callr", quietly = TRUE)) {
          originalPlan <- future::plan()
          sim <- memoryUseSetup(sim, originalPlan)
          on.exit({
            sim <- memoryUseOnExit(sim, originalPlan)
          }, add = TRUE)
        } else {
          stop(.message$futureMessage)
        }
      }

      ## timeunits gets accessed every event -- this should only be needed once per simList
      sim@.xData$.timeunits <- timeunits(sim)
      on.exit({
        rm(".timeunits", envir = sim@.xData)


        ## RecoverMode Step 2 -- on exit
        if (isTRUE(getOption("spades.saveSimOnExit", FALSE))) {
          sim <- saveSimOnExit(recoverMode, sim, rmo)
        }
        ## RecoverMode Step 2 -- End

        # For restarting R -- a few extra pieces, including saving the simList as the last thing
        # if (!is.null(sim$._restartRList)) {
        #   sim@simtimes[["current"]] <- sim@events[[1]]$eventTime
        #   sim$._restartRList$.spadesCall <- match.call()
        #
        #   restartFormals <- formals(restartR)
        #   # can change end(sim) back to original now because we are already ending
        #   end(sim) <- sim$._restartRList$endOrig
        #   restartR(
        #     sim = sim,
        #     reloadPkgs = getOption("spades.restartR.reloadPkgs", restartFormals$reloadPkgs),
        #     .First = getOption("spades.restartR..First", restartFormals$.First),
        #     .RDataFile = getOption("spades.restartR.filename", sim$._restartRList$simFilename),
        #     restartDir = getOption("spades.restartR.restartDir", restartFormals$restartDir)
        #   )
        # }

        # seconds <- "secs"
        # sim$._totalElapsedTime <- difftime(Sys.time(), sim$._startClockTime, units = seconds)
        # subtractOff <- difftime(Sys.time(), tail(completed(sim)[["clockTime"]], 1), units = seconds)
        # sim$._elapsedTimeIncompleteFinaleEvent <- subtractOff
      }, add = TRUE)

      if (!is.null(.plots)) {
        sim@params <- updateParamSlotInAllModules(
          sim@params, .plots, ".plots",
          needClass = "character",
          needValuesMess = paste0("It must be one or more of 'screen', ",
                                  "'object', 'raw' and any of the classes that ggplot2::ggsave ",
                                  "can handle, e.g., 'png'"))
        if (is.null(.plotInitialTime) && !any(.plots %in% "screen"))
          sim@params <- updateParamSlotInAllModules(
            sim@params, NA_integer_, ".plotInitialTime",
            needClass = "integer")
        if (!is.null(.plotInitialTime) && !is.na(.plotInitialTime)) {
          message("Both .plots and .plotInitialTime are supplied; using .plots")
          if (!is.numeric(.plotInitialTime) && is.na(.plotInitialTime))
            .plotInitialTime <- start(sim)
        }
      }

      if (!is.null(.plotInitialTime)) {
        sim@params <- updateParamSlotInAllModules(
          sim@params, .plotInitialTime, ".plotInitialTime",
          needClass = "numeric")
        if (is.na(.plotInitialTime))
          sim@params <- updateParamSlotInAllModules(
            sim@params, NA_character_, ".plots",
            needClass = "character")
      }
      if (!is.null(.saveInitialTime)) {
        sim@params <- updateParamSlotInAllModules(
          sim@params, .saveInitialTime, ".saveInitialTime",
          needClass = "numeric")
      }

      if (!is.na(progress)) {
        tu <- sim@simtimes[["timeunit"]]
        if (isTRUE(progress)) {
          progress <- "graphical"
        }
        if (is.numeric(progress)) {
          sim@params$.progress$interval <- (end(sim, tu) - start(sim, tu)) / progress
          progress <- "graphical"
        }

        if (!is.na(pmatch(progress, "graphical"))) {
          sim@params$.progress$type <- "graphical"
        } else if (!is.na(pmatch(progress, "text"))) {
          sim@params$.progress$type <- "text"
        }

        if (!is.na(sim@params$.progress$type) &&
            is.na(sim@params$.progress$interval)) {
          sim@params$.progress$interval <- NULL
        }
      }

      if (!(all(unlist(lapply(debug, identical, FALSE))))) {
        .pkgEnv[[".spadesDebugFirst"]] <- TRUE
        # sim[["._spadesDebugWidth"]] <- c(9, 10, 9, 13)
      }

      sim@.xData[["._firstEventClockTime"]] <- Sys.time()

      ## This was introduced when sim@completed became an environment for speed purposes
      ## (list got slow as size increased)
      ## This is an attempt to deal with the expected behaviour of a list --
      ## i.e., delete it if this appears to be the original sim object again passed in
      if (length(sim@completed)) {
        existingCompleted <- sort(as.integer(ls(sim@completed, sorted = FALSE)))
        prevStart <- get(as.character(existingCompleted[1]), envir = sim@completed)
        # prevEnd <- get(as.character(existingCompleted[length(existingCompleted)]), envir = sim@completed)
        if (length(.grepSysCalls(sys.calls(), "restartSpades")) == 0 &&
            length(sim@.xData$._ranInitDuringSimInit) == 0 &&
            prevStart$eventType != ".inputObjects")  { # don't crop off completed events if Init(s) ran during simInit
          prevEvUnit <- attr(prevStart[["eventTime"]], "unit")
          stTime <- start(sim, unit = prevEvUnit)
          if (stTime <= prevStart[["eventTime"]] && (time(sim, unit = prevEvUnit) == stTime))
            sim@completed <- new.env(parent = emptyenv())
        }
      }

      ## RecoverMode Step 3 -- Initiate the RMO (recovery mode object)
      if (recoverMode > 0) {
        thisSpadesCallRandomStr <- basename(tempfile(pattern = "rmo"))
        on.exit({
          toDel <- dir(dotRMOFilepath(thisSpadesCallRandomStr), full.names = TRUE)
          if (length(toDel) > 0)
            unlink(toDel)
                 }, add = TRUE) # for file-backed files)
        rmo <- NULL ## the recovery mode object
        allObjNames <- outputObjectNames(sim)
        if (is.null(allObjNames)) recoverMode <- 0
      }
      ## RecoverMode Step 3 -- End

      useFuture <- getOption("spades.futureEvents", FALSE)
      if (useFuture) {
        if (!requireNamespace("future", quietly = TRUE))
          stop("To use 'spades.futureEvents', please run \ninstall.packages('future') ")

        message(cli::col_magenta("useFuture is set to TRUE; this will attempt to spawn events"))
        message(cli::col_magenta("  in a separate process, if their outputs are not needed immediately"))
        message(cli::col_magenta("  STILL EXPERIMENTAL. Use cautiously."))
        message(cli::col_magenta("  User must manage future::plan, e.g., \nfuture::plan(multisession(workers = 2))"))
        sim$.futureEventsSkipped <- 0
        sim$.simFuture <- list()
      }

      ## There are some edge cases where there is an event scheduled before current time,
      ##   even though current time is after end time
      if (length(sim@events)) {
        specialStart <- sim@events[[1]][["eventTime"]] < sim@simtimes[["current"]] &&
          sim@simtimes[["current"]] > sim@simtimes[["end"]]
        if (isTRUE(specialStart)) sim@simtimes[["current"]] <- sim@events[[1]][["eventTime"]]
      }

      simDTthreads <- getOption("spades.DTthreads", 1L)
      message("Using setDTthreads(", simDTthreads, "). To change: 'options(spades.DTthreads = X)'.")
      origDTthreads <- setDTthreads(simDTthreads)
      on.exit(setDTthreads(origDTthreads), add = TRUE)

      while (sim@simtimes[["current"]] <= sim@simtimes[["end"]]) {
        ## RecoverMode Step 4 -- Do Pre
        if (recoverMode > 0) {
          rmo <- recoverModePre(sim, rmo, allObjNames, recoverMode, thisSpadesCallRandomStr = thisSpadesCallRandomStr)
        }

        sim <- doEvent(sim, debug = debug, notOlderThan = notOlderThan,
                       events = events, ...)  # process the next event

        ## RecoverMode Step 5 -- Do Post
        if (recoverMode > 0) {
          rmo <- recoverModePost(sim, rmo, recoverMode)
        }
        ## Conditional Scheduling -- adds only 900 nanoseconds per event, if none exist
        if (exists("._conditionalEvents", envir = sim, inherits = FALSE)) {
          condEventsToOmit <- integer()
          for (condNum in seq(sim$._conditionalEvents)) {
            cond <- sim$._conditionalEvents[[condNum]]
            if (isTRUE(eval(cond$condition))) {
              curTime <- time(sim)
              if (curTime >= cond$minEventTime && curTime <= cond$maxEventTime) {
                message("  Conditional Event -- ", cond$condition, " is true. Scheduling for now")
                sim <- scheduleEvent(sim, eventTime = curTime, moduleName = cond$moduleName,
                                     eventType = cond$eventType, eventPriority = cond$eventPriority)
                condEventsToOmit <- c(condEventsToOmit, condNum)
              }
            }
          }
          if (length(condEventsToOmit)) {
            sim$._conditionalEvents <- sim$._conditionalEvents[-condEventsToOmit]
            if (length(sim$._conditionalEvents) == 0) {
              rm("._conditionalEvents", envir = sim)
            }
          }
        }
        # if (useFuture) {
        #   if (length(sim$.simFuture) > 1) {
        #     for (simFut in seq_along(sim$.simFuture)) {
        #       if (future::resolved(sim$.simFuture[[1]][[1]])) {
        #         sim <- resolveFutureNow(sim, cause = paste0(modNameInFuture(sim$.simFuture[1]), " finished running"))
        #       }
        #     }
        #   }
        # }
      }
      if (useFuture) {
        if (length(sim$.simFuture)) {
          for (simFut in seq_along(sim$.simFuture)) {
            sim <- resolveFutureNow(sim, cause = "End of simulation")
          }
        }
        message(cli::col_magenta(sim$.futureEventsSkipped, " events ran in futures"))
      }
      sim@simtimes[["current"]] <- sim@simtimes[["end"]]

      ## for determining if clean ending to spades call
      .pkgEnv$.cleanEnd <- TRUE

      if (!is.null(sim$._restartRList)) {
        sim@simtimes[["current"]] <- sim@events[[1]]$eventTime
        sim$._restartRList$.spadesCall <- match.call()

        restartFormals <- formals(restartR)
        # can change end(sim) back to original now because we are already ending
        end(sim) <- sim$._restartRList$endOrig
        restartR(
          sim = sim,
          reloadPkgs = getOption("spades.restartR.reloadPkgs", restartFormals$reloadPkgs),
          .First = getOption("spades.restartR..First", restartFormals$.First),
          .RDataFile = getOption("spades.restartR.filename", sim$._restartRList$simFilename),
          restartDir = getOption("spades.restartR.restartDir", restartFormals$restartDir)
        )
      }
      return(invisible(sim))
    },
    warning = function(w) {
      w$message <- gsub("^In modCall\\(sim = sim.+\"]]\\): ", "", w$message)
      if (any(grepl("NAs introduced by coercion", w$message))) {
        if (useLoggingPkg) { # && requireNamespace("logging", quietly = TRUE)) {
          logging::logwarn(paste0(collapse = " ", c(names(w), w)))
        }
      }
      if (any(grepl("In .+:", w$message))) {
        warningSplitOnColon(w)
        invokeRestart("muffleWarning")
      } else if (isTRUE(any(grepl("'package:stats' may not be available when loading",
                                  w$message)))) {
        invokeRestart("muffleWarning")
      } else {
        warning(w)
        tryCatch(invokeRestart("muffleWarning"), error = function(e) NULL)
      }
    },
    error = function(e) {
      if (useLoggingPkg) { # && requireNamespace("logging", quietly = TRUE)) {
        if (isTRUE(any(debug > 0))) {
          logging::logerror(e)
        }
      } else {
        fn <- get0("onError")
        if (!is.null(fn)) {
          fn(sim)
        }
        stop(e)
      }
    },
    message = function(m) {
      msg <- m$message
      # Detect cli progress ticks routed through message() by start_app(output="message").
      # \r = carriage return (in-place overwrite); \x1b[...[A-HJ-KST] = cursor-movement/erase
      # CSI sequences (A=up, B=down, J=erase display, K=erase line, S/T=scroll);
      # \x1b[?...[hl] = cursor show/hide. Color/SGR codes (\x1b[31m etc.) end in 'm' and
      # are intentionally excluded so colored regular messages are not mistaken for ticks.
      if (isTRUE(grepl("\r|\x1b\\[[0-9;]*[A-HJ-KST]|\x1b\\[\\?[0-9;]+[hl]", msg, perl = TRUE))) {
        clean <- trimws(cli::ansi_strip(msg))
        if (nchar(clean) == 0L) {
          tryCatch(invokeRestart("muffleMessage"), error = function(e) NULL)
          return()
        }
        now <- Sys.time()
        if (!isTRUE(.pkgEnv$.inProgressBar)) {
          .pkgEnv$.inProgressBar <- TRUE
          .pkgEnv$.progressLastShown <- now
          message(loggingMessage(clean))
        } else if (as.numeric(now - .pkgEnv$.progressLastShown) >=
                   getOption("spades.progressInterval", 2)) {
          message(loggingMessage(clean))
          .pkgEnv$.progressLastShown <- now
        }
        tryCatch(invokeRestart("muffleMessage"), error = function(e) NULL)
        return()
      }
      .pkgEnv$.inProgressBar <- FALSE
      if (useLoggingPkg) { # && requireNamespace("logging", quietly = TRUE)) {
        logging::loginfo(msg)
      } else {
        if (isTRUE(any(grepl("\b", msg)))) {
          msg <- paste0("\b", gsub("\b *", " ", msg), "\b")
        }
        message(loggingMessage(msg))
      }
      # This will "muffle" the original message
      tryCatch(invokeRestart("muffleMessage"), error = function(e) NULL)
    }
    )
    return(invisible(sim))
})

#' @rdname spades
#' @importFrom reproducible Cache
setMethod(
  "spades",
  signature(cache = "logical"),
  definition = function(sim,
                        debug,
                        progress,
                        cache,
                        .plotInitialTime,
                        .saveInitialTime,
                        notOlderThan = NULL,
                        events,
                        .plots,
                        ...) {
    stopifnot(inherits(sim, "simList")) ## July 2022: R 4.2 flags against using class()

    oldGetPaths <- getPaths()
    do.call(setPaths, append(list(silent = TRUE), sim@paths))
    on.exit(do.call(setPaths, append(list(silent = TRUE), oldGetPaths)), add = TRUE)

    dots <- list(...)
    omitArgs <- c("cl", "notOlderThan")
    if (isTRUE("omitArgs" %in% names(dots))) {
      omitArgs <- c(dots$omitArgs, omitArgs)
      dots$omitArgs <- NULL
    }

    if (cache) {
      return(
        Cache(spades(sim = sim,
                     debug = debug,
                     progress = progress,
                     .plotInitialTime = .plotInitialTime,
                     .saveInitialTime = .saveInitialTime,
                     omitArgs = omitArgs,
                     notOlderThan = notOlderThan,
                     events = events,
                     .plots = .plots,
                     cache = FALSE,
                     ...
        ))
        # do.call(quote = TRUE, Cache,
        #         args = append(
        #           list(
        #             spades,
        #             sim = sim,
        #             debug = debug,
        #             progress = progress,
        #             .plotInitialTime = .plotInitialTime,
        #             .saveInitialTime = .saveInitialTime,
        #             omitArgs = omitArgs,
        #             notOlderThan = notOlderThan,
        #             events = events,
        #             .plots = .plots
        #           ),
        #           dots
        #        )
        # )
      )
    } else {
      return(
        spades(
          sim,
          debug = debug,
          progress = progress,
          .plotInitialTime = .plotInitialTime,
          .saveInitialTime = .saveInitialTime,
          events = events,
          .plots = .plots
        )
      )
    }
})

#' @keywords internal
#' @importFrom cli bg_yellow
.runEvent <- function(sim, cacheIt, debug, moduleCall, fnEnv, cur, notOlderThan,
                      showSimilar, .pkgEnv) {
  cacheChaining <- getOption("spades.cacheChaining", FALSE)
  classOptions <- moduleSpecificObjects <- NULL # set defaults
  # cacheIt <- cacheChaining || cacheIt
  if (!is.null(sim@depends@dependencies[[cur[["moduleName"]]]]) || cacheChaining) { # allow for super simple simList without a slot outputObjects
    expectsInputs <- sim@depends@dependencies[[cur[["moduleName"]]]]@inputObjects$objectName
    createsOutputs <- sim@depends@dependencies[[cur[["moduleName"]]]]@outputObjects$objectName

    if (cacheIt) { # means that a module or event is to be cached

      fns <- setdiff(ls(fnEnv, all.names = TRUE), c(".inputObjects", "mod", "Par", ".objects")) # .inputObjects is not run in `spades`; mod is same as .objects
      objs <- setdiff(ls(sim@.xData[[dotObjs]][[cur[["moduleName"]]]], all.names = TRUE), c(".inputObjects", "mod", "Par", ".objects")) # .inputObjects is not run in `spades`; mod is same as .objects
      moduleSpecificObjects <-
        c(ls(sim@.xData, all.names = TRUE, pattern = cur[["moduleName"]]), # functions in the main .xData that are prefixed with moduleName
          paste0(attr(fnEnv, "name"), ":", fns), # functions in the namespaced location
          paste0(attr(fnEnv, "name"), ":", objs), # objects in the namespaced location
          na.omit(expectsInputs)) # objects that should exist at the time of calling the module

      #fnsWOhidden <- paste0(cur[["moduleName"]], ":",
      #                      grep("^\\._", fns, value = TRUE, invert = TRUE))
      moduleSpecificOutputObjects <- c(createsOutputs, paste0(dotMods, "$", cur[["moduleName"]]),
                                       paste0(dotObjs, "$", cur[["moduleName"]]),
                                       objSynName
                                       )
      modParamsFull <- sim@params[[cur[["moduleName"]]]]
      paramsDontCacheOnActual <- names(modParamsFull) %in% paramsDontCacheOn
      # simParamsDontCacheOn <- modParamsFull[paramsDontCacheOnActual]
      modParams <- modParamsFull[!paramsDontCacheOnActual]

      classOptions <- classOptionsForCache(events = cur[["eventType"]],
                                           paramsWoKnowns = modParams, dependsSlots = metadataToDigest,
                                           mBase = cur[["moduleName"]])

      # classOptions <- list(events = cur[["eventType"]], current = FALSE, completed = FALSE, simtimes = FALSE,
      #                      paths = FALSE, outputs = FALSE,
      #                      params = modParams,
      #                      modules = cur[["moduleName"]])
    }
  }
  verbose <- debugToVerbose(debug)

  fnCallAsExpr <- if (cacheIt) { # means that a module or event is to be cached
    modCall <- get(moduleCall, envir = fnEnv)
    # if (isTRUE(cur$moduleName %in% "fireSense_dataPrepFit")) browser()

    extraCacheArgs <- sim@params[[cur[["moduleName"]]]][[._txtDotUseCacheArgs]][[cur[["eventType"]]]]
    if (!is.list(extraCacheArgs)) extraCacheArgs <- list()
    isCalls <- sapply(extraCacheArgs, function(x) is.call(x))
    if (isTRUE(any(isCalls))) 
      extraCacheArgs[isCalls] <- lapply(extraCacheArgs[isCalls], eval, envir = environment())
    
    defaultCacheArgs <- list(
      FUN = quote(modCall(sim = sim,
                          eventTime = cur[["eventTime"]],
                          eventType = cur[["eventType"]])),
      .objects = quote(moduleSpecificObjects),
      notOlderThan = quote(notOlderThan),
      outputObjects = quote(moduleSpecificOutputObjects),
      classOptions = quote(classOptions),
      showSimilar = quote(showSimilar),
      cachePath = quote(sim@paths[["cachePath"]]),
      .functionName = quote(paste0(moduleCall, "::", cur[["eventType"]])),
      verbose = quote(verbose),
      userTags = quote(c(paste0("module:", cur[["moduleName"]]),
                         paste0("eventType:", cur[["eventType"]]),
                         paste0("eventTime:", time(sim))))
    )
    as.expression(as.call(c(list(quote(Cache)),
                            modifyList(defaultCacheArgs, extraCacheArgs))))
  } else {
    ## Faster just to pass the NULL and just call it directly inside .runEvent
    expression(get(moduleCall, envir = fnEnv)(sim, cur[["eventTime"]], cur[["eventType"]]))
  }

  if (verbose) {
    objsIsNullBefore <- objsAreNull(sim)
  }

  if (any(cur[["moduleName"]] %in% getOption("spades.debugModule"))) {
    browser()
  }
  if (.pkgEnv[["spades.browserOnError"]]) {
    sim <- .runEventWithBrowser(sim, fnCallAsExpr, moduleCall, fnEnv, cur)
  } else {
    runFnCallAsExpr <- TRUE

    rr <- .Random.seed

    if (cacheChaining) {

      nonObjects <- nonObjectsForCacheChaining(moduleSpecificObjects, fnEnv, classOptions)
      # append(as.list(fnEnv, all.names = TRUE)[extractFns(moduleSpecificObjects)],
      #        classOptions)

      prevCache <- attr(sim, "tags")
      ce <- chainingEnv(cachePath(sim))
      chaining <- cacheChainingSetup(
        cacheIt = cacheIt,
        prevCache = prevCache,
        chainingEnv = ce,
        # The next line is not evaluated it `cacheIt` is FALSE (lazy evaluation);
        #   so can't pre-calculate it
        nonObjects = nonObjects, # append(as.list(fnEnv, all.names = TRUE)[extractFns(moduleSpecificObjects)],
                            # classOptions),
        fnCallAsExpr = fnCallAsExpr,
        module = cur[["moduleName"]],
        event = cur[["eventType"]],
        led = attr(sim, lastEventDetails),
        verbose = verbose)
      fnCallAsExpr <- chaining$fnCallAsExpr
    }
    if (runFnCallAsExpr) {
      sim <- eval(fnCallAsExpr) ## slower than more direct version just above
      # attr(sim, lastEventDetails) <- paste(cur[["moduleName"]], cur[["eventType"]], collapse = "_")
    }
    if (cacheChaining) {
      sim <- cacheChainingPost(sim, cacheIt, prevCache,
                               chaining$cacheIdOfSkip, chaining$df, ce,
                               moduleName = cur[["moduleName"]],
                               eventType = cur[["eventType"]])
    }

    if (identical(rr, .Random.seed) && isTRUE(verbose)) {
      message(cli::bg_yellow(cur[["moduleName"]]))
    }
    # if (allowSequentialCaching) {
    #     sim <- allowSequentialCachingUpdateTags(sim, cacheIt)
    # }
  }

  # if (allowSequentialCaching) {
  #   sim <- allowSequentialCachingFinal(sim)
  # }

  ## put back the current values of params that were not cached on
  if (exists("modParams", inherits = FALSE)) {
    if (sum(paramsDontCacheOnActual)) {
      sim@params[[cur[["moduleName"]]]][paramsDontCacheOnActual] <- modParamsFull[paramsDontCacheOnActual]
    }
  }

  if (verbose) {
    sim <- objectsCreatedPost(sim, objsIsNullBefore, verbose = verbose)
  }
  evalPostEvent() # this is getOption("spades.evalPostEvent")

  ## Test for memory leaks
  if (getOption("spades.testMemoryLeaks", TRUE)) {
    if (!is.null(sim@.xData[[dotObjs]][[cur[["moduleName"]]]])) { # $.objects
      sim$._knownObjects <- testMemoryLeaks(
        simEnv = sim@.xData,
        modEnv = sim@.xData[[dotObjs]][[cur[["moduleName"]]]], # .objects
        modName = cur[["moduleName"]],
        knownObjects = sim@.xData$._knownObjects
      )
    }
  }

  return(sim) # TEMPORARY THIS IS FOR TESTING DEBUGGING IN FUTURE
}

#' @keywords internal
.runEventWithBrowser <- function(sim, fnCallAsExpr, moduleCall, fnEnv, cur) {
  canContinue <- TRUE
  numTries <- 0
  while (canContinue) {
    out <- try(eval(fnCallAsExpr))
    if (isTRUE(inherits(out, "try-error"))) {
      numTries <- numTries + 1
      if (numTries > 1) {
        tmp <- .parseConditional(filename = sim@.xData[[dotMods]][[cur[["moduleName"]]]]$._sourceFilename)
        eval(tmp[["parsedFile"]][!tmp[["defineModuleItem"]]],
             envir = sim@.xData[[dotMods]][[cur[["moduleName"]]]])
        numTries <- 0
      } else {
        message("There was an error in the code in the ", moduleCall, ".\n",
                "Entering browser. You can correct it and press c to continue or Q to quit.")
        debugonce(get(moduleCall, envir = fnEnv))
      }
    } else {
      canContinue <- FALSE
    }
  }
  sim <- out
}

#' @keywords internal
calculateEventTimeInSeconds <- function(sim, eventTime, moduleName) {
  #if (!is.null(sim@depends@dependencies[[1]])) {
  unitAttr <- attr(eventTime, "unit")
  if (is.null(unitAttr)) {
    attributes(eventTime)$unit <- .callingFrameTimeunit(sim)
    eventTime <- as.numeric(convertTimeunit((
      eventTime -
        convertTimeunit(sim@simtimes[["start"]],
                        sim@simtimes[["timeunit"]], sim@.xData,
                        skipChecks = TRUE)
    ),
    "seconds",
    sim@.xData, skipChecks = TRUE) +
      sim@simtimes[["current"]])
  } else {
    #if (!startsWith(unitAttr, "second")) {
    if (unitAttr != "second") { # faster to do 2 sequential tests like this than !startsWith
      if (unitAttr != "seconds") {
        eventTime <- as.numeric(convertTimeunit(eventTime, "seconds", sim@.xData,
                                                skipChecks = TRUE))
      }
    }
  } #else eventTime

  #} else {
  # when eventTime is NA... can't seem to get an example
  #eventTimeInSeconds <-
  #  as.numeric(convertTimeunit(eventTime, "seconds", sim@.xData,
  #                             skipChecks = TRUE))
  #}
  eventTime
}

#' @keywords internal
#' @importFrom stats runif
recoverModePre <- function(sim, rmo = NULL, allObjNames = NULL, recoverMode, thisSpadesCallRandomStr) {
  if (is.null(allObjNames)) {
    allObjNames <- outputObjectNames(sim)
  }

  if (is.null(rmo)) {
    rmo <- list(
      recoverModeTiming = 0,
      recoverableObjs = list(),
      recoverableModObjs = list(),
      addedEvents = list(list()),
      randomSeed = list(list())
    )
  }

  # Remove the tail entry in each of the lists
  if (length(rmo$addedEvents) > (recoverMode - 1))
    rmo$addedEvents <- rmo$addedEvents[seq_len(recoverMode - 1)]
  if (length(rmo$randomSeed) > (recoverMode - 1))
    rmo$randomSeed <- rmo$randomSeed[seq_len(recoverMode - 1)]
  startTime <- Sys.time()
  if (length(rmo$recoverableObjs) > (recoverMode - 1)) {
    # remove the previous rmo files, making way for subsequent Copy below. These files
    #   should be temporary versions and so can be safely deleted
    clearFileBackedObjs(rmo$recoverableObjs, recoverMode)
    rmo$recoverableObjs <- rmo$recoverableObjs[seq_len(recoverMode - 1)]
    rmo$recoverableModObjs <- rmo$recoverableModObjs[seq_len(recoverMode - 1)]
  }

  if (length(sim@events) > 0) {
    curMod <- sim@events[[1]][["moduleName"]]
    objsInSimListAndModule <- ls(sim) %in% allObjNames[[curMod]]
    # This makes a copy of the objects that are needed, and adds them to the list of rmo$recoverableObjs

    mess <- capture.output(type = "message", {
      newList <- list(if (any(objsInSimListAndModule)) {
        # files may disappear for one reason or another; this will fail, silently
        try(Copy(mget(ls(sim)[objsInSimListAndModule], envir = sim@.xData),
             filebackedDir = dotRMOFilepath(thisSpadesCallRandomStr, sim@events)))
      } else {
        list()
      })
      if (inherits(newList, "try-error"))
        stop(newList)

      names(newList) <- curMod
      rmo$recoverableObjs <- append(newList, rmo$recoverableObjs)
    })

    if (exists(curMod, envir = sim[[dotObjs]])) {
      newList <- if (!is.null(sim[[dotObjs]][[curMod]])) {
          modObjEnv <- sim[[dotObjs]][[curMod]]# $.objects
          objsInModObjects <- ls(modObjEnv, all.names = TRUE)
          list(
            if (length(objsInModObjects)) {
              Copy(mget(objsInModObjects, envir = modObjEnv),
                   # filebackedDir = file.path(getOption("spades.scratchPath"), "._rmo"))
                   filebackedDir = dotRMOFilepath(thisSpadesCallRandomStr, sim@events))
            } else {
              list()
            })
      } else {
        list()
      }
      names(newList) <- curMod
      mess2 <- capture.output(type = "message",
                              rmo$recoverableModObjs <- append(newList, rmo$recoverableModObjs)
      )
    }

    mess <- grep("Hardlinked version", mess, invert = TRUE)
    if (length(mess) > 0)
      lapply(mess, message)
  }

  endTime <- Sys.time()
  rmo$preEvents <- sim@events
  if (!exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) tmp <- runif(1)
  rmo$randomSeed <- append(list(get(".Random.seed", envir = .GlobalEnv, inherits = FALSE)),
                           rmo$randomSeed)

  timeElapsedHere <- difftime(endTime, startTime, units = "secs")
  if (timeElapsedHere > 1)
    message(cli::col_magenta(paste0("... spades.recoveryMode used ",
                                   format(timeElapsedHere, units = "auto", digits = 3))))

  rmo$recoverModeTiming <- rmo$recoverModeTiming + timeElapsedHere

  rmo
}

#' @keywords internal
recoverModePost <- function(sim, rmo, recoverMode) {
  rmo$postEvents <- sim@events
  rmo$addedEvents <- append(list(setdiff(rmo$postEvents, rmo$preEvents)), rmo$addedEvents)
  rmo
}

#' @keywords internal
#' @importFrom cli cli_code cli_text col_magenta
recoverModeOnExit <- function(sim, rmo, recoverMode) {
  sim@.xData$.recoverableObjs <- rmo$recoverableObjs
  sim@.xData$.recoverableModObjs <- rmo$recoverableModObjs
  recoverableObjsSize <- sum(unlist(objSize(rmo$recoverableObjs)))
  class(recoverableObjsSize) <- "object_size"
  rmo$postEvents <- sim@events
  rmo$addedEvents <- append(list(setdiff(rmo$postEvents, rmo$preEvents)), rmo$addedEvents)
  sim@.xData$.addedEvents <- rmo$addedEvents
  sim@.xData$._randomSeed <- rmo$randomSeed
  message(cli::col_magenta(paste0("Setting options('spades.recoveryMode' = ",recoverMode,") used ",
                                  format(rmo$recoverModeTiming, units = "auto", digits = 3),
                                  " and ", format(recoverableObjsSize, units = "auto"))))
  recmod <- as.integer(recoverMode)
  message(cli::cli_text(cli::col_magenta(
    paste(
      "The initial state of the last ", recmod,
      singularPlural(c("event", "events"), v = recmod),
      isAre(v = recmod)," cached and saved",
      "in the {.var simList} located at {.code savedSimEnv()$.sim} as",
      "{.code sim$.recoverableObjs} with the most recent event as the first element in the list,",
      "second most recent event as the second element, etc.",
      "The objects contained in each of those are only the objects that may have",
      "changed, according to the metadata for each module.\n",
      "To recover, use: {.code restartSpades()}"
    )
  )))
  return(sim)
}

#' @keywords internal
messageInterrupt1 <- function(recoverMode) {
  message(
    cli::col_magenta(
      "Because of an interrupted spades call, the sim object ",
      c("at the time of interruption ",
        "at the start of the interrupted event ")[(recoverMode > 0) + 1],
      "was saved in"
    ), "\n",
    cli::col_blue("SpaDES.core:::savedSimEnv()$.sim"), "\n",
    cli::col_magenta("It will be deleted on next call to spades().")
  )
}

setupDebugger <- function(debug = getOption("spades.debug")) {
  if (!missing(debug)) {
    if (!isFALSE(debug)) {
      if (is.list(debug)) {
        needInstall("logging",
                    messageStart = "debug cannot be a list unless logging package is installed: ")

        logging::logReset()
        if (is.null(names(debug))) stop("debug must be a named list if it is a list. See ?spades")
        hasConsole <- grepl("console", names(debug))
        if (any(hasConsole)) {
          if (!is.list(debug$console)) stop("debug has an element named 'console', which is not a list.",
                                            "Try 'debug = list(console = list())'")
          consoleLevel <- if (!is.null(debug$console$level)) {
            debug$console$level
          } else {
            "INFO"
          }
          if (!any(grepl("20|INFO", consoleLevel))) {
            if (!"basic.stdout" %in% names(logging::getLogger()[["handlers"]])) {
              #basicConfig()
              logging::addHandler(logging::writeToConsole, level = consoleLevel#,
                                  #formatter = spadesDefaultFormatter
              )
            }
            logging::setLevel(consoleLevel, logging::getHandler(logging::writeToConsole))
            #setLevel(consoleLevel, getHandler('basic.stdout'))
          }

        }
        hasFile <- grepl("file", names(debug))
        if (any(hasFile)) {
          fileLevel <- if (!is.null(debug$file$level)) {
            debug$file$level
          } else {
            "INFO"
          }
          if (!"writeToFile" %in% names(logging::getLogger()[["handlers"]])) {
            if (is.null(debug$file$file))
              debug$file$file <- "log.txt"
            logging::addHandler(logging::writeToFile, file = debug$file$file, level = fileLevel)
          }
          logging::setLevel(fileLevel, logging::getHandler(logging::writeToFile))
          cat(file = debug$file$file, "##################################\n",
              append = !isFALSE(debug$file$append)) # default append it TRUE
        }
        # with(getLogger(), names(handlers))

        hasDebug <- grepl("debug", names(debug))
        if (any(hasDebug)) {
          debug <- debug$debug
        } else {
          debug <- 1
        }


      } else {
        stop("debug cannot be a list unless logging package is installed: ",
             "install.packages('logging')")
      }
    }
  }
  debug
}

spadesDefaultFormatter <- function(record) {
  text <- paste(record$timestamp, paste(record$levelname, record$logger,
                                        gsub("\n$", "", record$msg), sep = ":"), sep = "")
}

#' @importFrom reproducible Filenames
clearFileBackedObjs <- function(recoverableObjs, recoverMode) {
  if (isTRUE(recoverMode > 0)) {
    if (length(recoverableObjs) >= as.numeric(recoverMode)) {
      toClear <- recoverableObjs[[as.numeric(recoverMode)]]
      if (length(toClear)) {
        out <- lapply(toClear, function(x) {
          if (inherits(x, "Raster")) {
            Filenames(x)
          }
        })
        files <- unname(unlist(out))
        files <- files[nzchar(files)]
        if (length(files) != 0 ) {
          unlink(files)
          dirs <- unique(dirname(files))
          filesLeft <- dir(dirs, full.names = TRUE)
          if (length(filesLeft) == 0 || all(grepl("cache", filesLeft))) {
            unlink(dirs, recursive = TRUE)
          }
        }
      }
    }
  }
  return(invisible())
}

resolveFutureNow <- function(sim, cause = "") {
  futureRunning <- sim@events[[1]]
  futureRunning[1:4] <- as.list(strsplit(names(sim$.simFuture)[1], split = "_")[[1]])
  futureRunning[["eventTime"]] <- as.numeric(futureRunning[["eventTime"]])
  futureRunning[["eventPriority"]] <- as.numeric(futureRunning[["eventPriority"]])
  futureRunningSimTU <- futureRunning
  setDT(futureRunningSimTU)
  setDT(futureRunning)
  spacing <- paste(rep(" ", sim[["._spadesDebugWidth"]][1] + 1), collapse = "")

  outMess <- debugMessTRUE(sim, events = futureRunningSimTU)

  # # If it had no outputs, then skip -- wait -- comment out for now ... the "events" stuff; but that may be unnecessary
  #   because of the runScheduleEventsOnly, which "should" have found all the events.
  # if (length(sim$.simFuture[[1]]$thisModOutputs$objects)) {
  tmpSim <- future::value(sim$.simFuture[[1]][[1]])
  tmpSim <- .unwrap(tmpSim)
  simMetadata <- sim$.simFuture[[1]][[2]]

  # objects
  list2env(mget(simMetadata$objects, envir = envir(tmpSim)), envir = envir(sim))
  # }
  message(cli::col_magenta(paste0(" Resolved: ", outMess)))
  message(cli::col_magenta("   ", spacing, "because", cause))
  allCols <- c("eventTime", "moduleName", "eventTime", "eventPriority")
  # events
  evntsFut <- events(tmpSim, unit = "seconds")
  compltd <- completed(sim, unit = "seconds")[, 1:4]
  evntsNormal <- rbindlist(list(compltd, current(sim, unit = "seconds"), events(sim, unit = "seconds")))
  newEvents <- evntsFut[!evntsNormal, on = allCols]

  if (NROW(newEvents)) {
    warning("Seeing this message means that the runScheduleEventsOnly did not find all events; ",
            "please use `switch` and `scheduleEvent` inside the doEvent.", currentModule(tmpSim),
            " function")
    newEvents <- lapply(seq_len(NROW(newEvents)), function(x) as.list(newEvents[x]))
    slot(sim, "events", check = FALSE) <- append(sim@events, newEvents)
    ord <- order(unlist(lapply(sim@events, function(x) x$eventTime)),
                 unlist(lapply(sim@events, function(x) x$eventPriority)))
    slot(sim, "events") <- sim@events[ord]
  }
  sim$.simFuture <- sim$.simFuture[-1]

  sim
}

getFutureNeeds <- function(deps, curModName) {
  #browser(expr = curModName == "fireSpread")
  out <- list()
  mods <- names(deps)
  if (isTRUE(curModName %in% mods)) {
    moduleNamesNotThisOne <- mods[!mods %in% curModName]
    out$thisMod <- curModName
    allOtherModNames <- deps[names(deps) != curModName]
    out$anyModInputs <- na.omit(unique(unlist(lapply(
      deps, # can be a different event, don't exclude self
      function(modu)
        modu@inputObjects$objectName
    ))))
    out$thisModsInputs <- na.omit(unique(unlist(lapply(
      deps[curModName], # can be a different event, don't exclude self
      function(modu)
        modu@inputObjects$objectName
    ))))
    out$thisModOutputs <- na.omit(unique(unlist(lapply(
      deps[curModName],
      function(modu)
        modu@outputObjects$objectName
    ))))
    out$anyModOutputs <- lapply(
      deps,
      function(modu)
        modu@outputObjects$objectName
    )
    out$anyModInputs <- lapply(
      deps,
      function(modu)
        modu@inputObjects$objectName
    )
    out$dontAllowModules <- unlist(lapply(out$anyModInputs, function(x) any(x %in% out$thisModOutputs)))
  }
  out
}

.runEventFuture <- function(sim, cacheIt, debug, moduleCall, fnEnv, cur, notOlderThan,
                            showSimilar = showSimilar, .pkgEnv, envir, futureNeeds) {
  spacing <- paste(rep(" ", sim[["._spadesDebugWidth"]][1]), collapse = "")
  message(cli::col_magenta(spacing, "-- Spawning in a future"))
  sim$.futureEventsSkipped <- sim$.futureEventsSkipped + 1
  modFnEnv <- sim[[dotMods]][[cur[["moduleName"]]]]
  objsToGet <- grep("^\\._", ls(envir = modFnEnv, all.names = TRUE), value = TRUE, invert = TRUE)
  modObjs <- mget(objsToGet, envir = modFnEnv)
  pkgs <- getFromNamespace("extractPkgName", "Require")(unlist(sim@depends@dependencies[[cur[["moduleName"]]]]@reqdPkgs))
  list2env(modObjs, envir = envir)
  objsKepts <- na.omit(inputObjects(sim, module = currentModule(sim))[["objectName"]])
  globs <- list(sim = .wrap(sim[objsKepts]), cacheIt, debug, moduleCall, fnEnv, cur,
                notOlderThan, showSimilar, .pkgEnv)# names(modObjs))
  names(globs) <- c("sim", "cacheIt", "debug", "moduleCall", "fnEnv", "cur", "notOlderThan",
                    "showSimilar", ".pkgEnv") #names(modObjs))

  # When a name begins with a number, touchy to access it. Here reverse 1st 2 so character is first
  futureListLabel <- paste(unlist(cur), collapse = "_")
  sim$.simFuture[[futureListLabel]] <-
    list(sim = future::future(
      getFromNamespace(".runForFutureWrapper", "SpaDES.core")(sim,
                                                              cacheIt = cacheIt,
                                                              debug = debug,
                                                              moduleCall = moduleCall,
                                                              fnEnv = fnEnv,
                                                              cur = cur,
                                                              notOlderThan = notOlderThan,
                                                              showSimilar = showSimilar,
                                                              .pkgEnv = .pkgEnv),
      globals = globs,
      packages = unique(c("SpaDES.core", pkgs)),
      # envir = envir,
      seed = TRUE),
      thisModOutputs = list(
        moduleName = cur[["moduleName"]],
        objects = futureNeeds$thisModOutputs,
        dontAllowModules = names(futureNeeds$dontAllowModules)[futureNeeds$dontAllowModules]
      )
    )
  sim
}

.runForFutureWrapper <- function(sim, ...) {
  sim <- .unwrap(sim)
  sim <- .runEvent(sim, ...)
  .wrap(sim)
}

modNameInFuture <- function(simFuture) {
  gsub("^.+\\_(.+)\\_.+\\_.+", "\\1", names(simFuture))
}

isListedEvent <- function(eventQueue, eventsToDo) {
  foundEventToDo <- FALSE
  i <- 1
  if (!is.null(eventsToDo)) {
    while (isFALSE(foundEventToDo)) {
      if (length(eventQueue) < i) { # check for
        # slot(sim, "current", check = FALSE) <- list() # same as no events left
        foundEventToDo <- NA
      } else {
        eventsToDoThisMod <- if (is.list(eventsToDo))
          eventsToDo[[eventQueue[[i]]$moduleName]]
        else
          eventsToDo
        if (is.null(eventsToDoThisMod)) {
          foundEventToDo <- TRUE
        } else if (eventQueue[[i]]$eventType %in% eventsToDoThisMod) {
          foundEventToDo <- TRUE
        } else {
          i <- i + 1
        }
      }
    }
  } else {
    foundEventToDo <- TRUE
  }
  if (is.na(foundEventToDo)) i <- 0L
  i
}

#' @importFrom cli col_green
debugMessage <- function(debug, sim, cur, fnEnv, curModuleName) {
  if (!inherits(debug, "list") && !is.character(debug)) debug <- list(debug)
  if ( !(any(debug %in% FALSE) || any(debug %in% 0))) {
    if (!any(vapply(debug, function(x) if (is.numeric(x)) x %in% 1:2 else isTRUE(x), FUN.VALUE = logical(1))))
      debug <- append(list(1L), debug)
    for (i in seq_along(debug)) {
      if (isTRUE(debug[[i]]) || identical(debug[[i]], "current") || identical(debug[[i]], "step")) {
        if (length(cur) > 0) {
          if (debug[[i]] == "step") {
            if (interactive())
              readline("Press any key to continue...")
          }
          outMess <- debugMessTRUE(sim)
        }
      } else if (isTRUE(if (is.numeric(debug[[i]])) debug[[i]] %in% 1 else isTRUE(debug[[i]]))) {
        totalDiff <- difftime(Sys.time(), sim@.xData$._startClockTime - sim$._simInitElapsedTime)

        outMess <- paste0("total elpsd: ", format(totalDiff, digits = 2, unit = "auto"),
                          " | ", paste(format(unname(current(sim)), digits = 4), collapse = " "))
      } else if (isTRUE(if (is.numeric(debug[[i]])) debug[[i]] %in% 2 else isTRUE(debug[[i]]))) {
        compareTime <- if (is.null(attr(sim, "completedCounter")) ||
                           attr(sim, "completedCounter") == 1) {
          sim@.xData$._startClockTime
        } else {
          .POSIXct(sim@completed[[as.character(attr(sim, "completedCounter") - 1)]][[._txtClockTime]])
        }
        outMess <- paste0("elpsd: ", format(Sys.time() - compareTime, digits = 2),
                          " | ", paste(format(unname(current(sim)), digits = 4), collapse = " "))
      } else {
        if (is.call(debug[[i]])) {# || is(debug[[i]], "if") || is(debug[[i]], "{")) {
          outMess <- try(eval(debug[[i]]))
        } else if (identical(debug[[i]], "simList")) {
          outMess <- try(capture.output(sim))
        } else if (isTRUE(grepl(debug[[i]], pattern = "\\(")) && !cli::ansi_has_any(debug[i])) {
          outMess <- try(eval(parse(text = debug[[i]])))
        } else if (isTRUE(any(debug[[i]] %in% unlist(cur[c("moduleName", "eventType")])))) {
          outMess <- NULL
          if (is.environment(fnEnv)) {
            if (all(debug[[i]] %in% unlist(cur[c("moduleName", "eventType")]))) {
              debugonce(get(paste0("doEvent.", curModuleName), envir = fnEnv))
              on.exit(get(paste0("doEvent.", curModuleName), envir = fnEnv))
            }
          }
        } else if (!any(debug[[i]] %in% c("browser"))) { # any other
          if (!is.function(debug[[i]])) {
            outMess <- tryCatch(do.call(debug[[i]], list(sim)), silent = TRUE,
                                error = function(e) NULL)
          } else  {
            outMess <- try(debug[[i]](sim))
          }
        } else {
          outMess <- NULL
        }
      }
      if (is.data.frame(outMess)) {
        reproducible::messageDF(outMess, colour = "green", colnames = FALSE)
      } else {
        w <- getOption("width")
        suppress <- lapply(outMess, function(x)
          message(cli::col_green(substring(x, first = 1, last = w - 30))))
      }
    }
  }
}

updateParamSlotInAllModules <- function(paramsList, newParamValues, paramSlot,
                                        needClass, needValuesMess) {
  if (!inherits(newParamValues, needClass) && !is.na(newParamValues)) {
    if (missing(needValuesMess))
      needValuesMess <- ""
    stop(newParamValues, " must be class '", needClass, "'. It must be ", needValuesMess)
  }
  paramsLocal <- paramsList
  whNonHiddenModules <- !grepl(names(paramsList), pattern = "\\.")
  paramsList[whNonHiddenModules] <- lapply(paramsList[whNonHiddenModules], function(x) {
    x[[paramSlot]] <- newParamValues
    x
  })
  paramsList
}

loggingMessagePrefixLength <- 15

loggingMessage <- function(mess, suffix = NULL, prefix = NULL) {
  if (!isTRUE(any(grepl(.message$NoPrefix, mess)))) {
    st <- Sys.time()
    stForm1 <- "%h%d"
    stForm2 <- paste(stForm1, "%H:%M:%S")
    numCharsMax <- max(0, getOption("spades.messagingNumCharsModule", 21) - loggingMessagePrefixLength)
    middleFix <- ""
    noNew <- FALSE
    if (numCharsMax > 0) {
      sim2 <- list() # don't put a `sim` here because .whereInStack will find this one
      while (!inherits(sim2, "simList")) {
        simEnv <- .whereInStack("sim")
        if (is.null(simEnv))
          break
        sim <- get0("sim", envir = simEnv, inherits = FALSE)
        if (inherits(sim, "simList"))
          sim2 <- sim
      }

      if (!inherits(sim, "try-error") && !is.null(sim)) {
        # If this is a nested spades call, will have time already at start
        if (startsWith(mess, strftime(st, format = "%h%d"))) {
          noNew <- TRUE
        } else {
          middleFix <- paste(sim[[._txtSimNesting]], collapse = "/")
        }
      }
    }
    prependTime <- strftime(st, format = stForm2)

    # need to remove final \n, but strsplit on any internal \n
    slashN <- gregexpr("\n", mess)[[1]]
    if (isTRUE(slashN[1] > 0)) {
      # Eliot -- I tried various ways of doing this ... they are similar execution time; this is simplest
      len <- length(slashN)
      mess <- gsub(pattern = "\\n$", replacement = "", mess)
      if (len > 1) {
        mess <- strsplit(mess, "\n")[[1]]
        mess[-len] <- paste0(mess[-len], "\n")
        len2 <- length(mess)
        mess[len2] <- gsub(pattern = "\\n$", replacement = "", mess[len2])
      }
    }

    # Prepend the middle
    if (isTRUE(any(grepl("\b", mess)))) {
      # noNew <- TRUE
      mess <- gsub(" {2,100}", " ", mess) # get rid of multi-space -- but only if \b because could be indent
    } else {
      messPoss <- paste0(middleFix, " ", mess)
      if (!isTRUE(noNew)) {
        # Prepend the time
        mess <- paste0(prependTime, " ", messPoss)

      }
    }
  } else {
    mess <- gsub(.message$NoPrefix, "", mess)
  }

  mess
}

#' Alternative way to define events in SpaDES.core
#'
#' There are two ways to define what occurs during an event: defining a function
#' called `doEvent.moduleName`, where `moduleName` is the actual module name.
#' This approach is the original approach used in SpaDES.core, and it must have an
#' explicit `switch` statement branching on `eventType`.
#' The newer approach (still experimental) uses `defineEvent()`.
#' Instead of creating, `doEvent.moduleName()`, it creates one function
#' for each event, each with the name `doEvent.moduleName.eventName`.
#' This may be a little bit cleaner, but both with still work.
#'
#' @param sim A `simList`
#' @param eventName Character string of the desired event name to define. Default is "init"
#' @param moduleName Character string of the name of the module. If this function is
#'    used within a module, then it will try to find the module name.
#' @param code An expression that defines the code to execute during the event. This will
#'    be captured, and pasted into a new function (`doEvent.moduleName.eventName`),
#'    remaining unevaluated until that new function is called.
#' @param envir An optional environment to specify where to put the resulting function.
#'     The default will place a function called `doEvent.moduleName.eventName` in the
#'     module function location, i.e., `sim[[dotMods]][[moduleName]]`. However, if this
#'     location does not exist, then it will place it in the `parent.frame()`, with a message.
#'     Normally, especially, if used within SpaDES module code, this should be left missing.
#' @export
#' @seealso [defineModule()], [simInit()], [scheduleEvent()]
#' @examples
#' sim <- simInit()
#'
#' # these put the functions in the parent.frame() which is .GlobalEnv for an interactive user
#' defineEvent(sim, "init", moduleName = "thisTestModule", code = {
#'   sim <- Init(sim) # initialize
#'   # Now schedule some different event for "current time", i.e., will
#'   #   be put in the event queue to run *after* this current event is finished
#'   sim <- scheduleEvent(sim, time(sim), "thisTestModule", "grow")
#' }, envir = envir(sim))
#'
#' defineEvent(sim, "grow", moduleName = "thisTestModule", code = {
#'   sim <- grow(sim) # grow
#'   # Now schedule this same event for "current time plus 1", i.e., a "loop"
#'   sim <- scheduleEvent(sim, time(sim) + 1, "thisTestModule", "grow") # for "time plus 1"
#' })
#'
#' Init <- function(sim) {
#'   sim$messageToWorld <- "Now the sim has an object in it that can be accessed"
#'   sim$size <- 1 # initializes the size object --> this can be anything, Raster, list, whatever
#'   message(sim$messageToWorld)
#'   return(sim)   # returns all the things you added to sim as they are in the simList
#' }
#'
#' grow <- function(sim) {
#'   sim$size <- sim$size + 1 # increments the size
#'   message(sim$size)
#'   return(sim)
#' }
#'
#' # schedule that first "init" event
#' sim <- scheduleEvent(sim, 0, "thisTestModule", "init")
#' # Look at event queue
#' events(sim) # shows the "init" we just added
#' \donttest{
#'   # this is skipped when running in automated tests; it is fine in interactive use
#'   out <- spades(sim)
#' }
#'
defineEvent <- function(sim, eventName = "init", code, moduleName = NULL,
                        envir = parent.frame()) {
  code <- substitute(code)
  curMod <- currentModule(sim)
  if (is.null(moduleName))
    moduleName <- currentModule(sim)

  useSimModsEnv <- FALSE
  if (missing(envir)) {
    if (is.null(moduleName)) {
      if (length(curMod) > 0) {
        useSimModsEnv <- TRUE
      }
    } else {
      if (exists(moduleName, sim[[dotMods]], inherits = FALSE))
        useSimModsEnv <- TRUE
    }
    # envir <- if (useSimModsEnv) sim[[dotMods]][[moduleName]] else parent.frame()
  }

  eventFnName <-  makeEventFn(moduleName, eventName)
  fn <- defineEventFnMaker(substitute(code), eventFnName)
  # fn <- paste0("
  #   fn <- function(sim, eventTime, eventType, priority) {
  #   ",
  #        paste(format(substitute(code)), collapse = "\n")
  #   ,"
  #   return(sim)
  #   }
  # ")

  parsedFn <- parse(text = fn)
  if (!useSimModsEnv) {
    if (is.null(sim@.xData[[eventFnElementEnvir()]])) {
      sim@.xData[[eventFnElementEnvir()]] <- new.env(parent = asNamespace("SpaDES.core"))
    }
    sim@.xData[[eventFnElementEnvir()]][[eventFnName]] <- list(envir = envir,
                                                               digest = .robustDigest(parsedFn))
  }

  assign(eventFnName, eval(parsedFn, envir = new.env(parent = asNamespace("SpaDES.core"))),
         envir = envir)
  # assign(eventFnName, eval(parsedFn, envir = new.env(parent = asNamespace("SpaDES.core"))),
  #        envir = envir)
  theEvalEnvir <- environment(get(eventFnName, envir = envir))
  rm(list = ls(theEvalEnvir), envir = theEvalEnvir)
  return(invisible(sim))
}

makeEventFn <- function(curModuleName, eventType) {
  paste("doEvent", curModuleName, eventType, sep = ".")
}

eventFnElement <- function() ".eventFnDigest"
eventFnElementEnvir <- function() ".eventFnEnvir"

moduleNameStripped <- function(modName, numCharsMax) {
  if (!is.null(modName)) {
    nchr <- nchar(modName)
    tooManyVowels <- nchr - numCharsMax
    numConsonnants <- nchar(gsub("[AEIOUaeiou]", "", modName))
    tooFewVowels <- if (numConsonnants >= numCharsMax) 0 else min(tooManyVowels, numCharsMax - numConsonnants)
    modName8Chars <-
      paste0(substr(gsub(paste0("(?<=\\S)[AEIOUaeiou]{",
                                tooFewVowels,",",tooManyVowels,"}"), "",
                         modName, perl = TRUE), 1, numCharsMax))
    nchr <- nchar(modName8Chars)
    if (nchr < numCharsMax) {
      modName8Chars <- paste0(modName8Chars,
                              paste(collapse = "", rep(" ", numCharsMax - nchr)))
    }
    modName <- modName8Chars
  } else {
    modName <- ""
  }
  modName
}

debugMessTRUE <- function(sim, events) {
  if (missing(events))
    events <- current(sim)
  evnts1 <- data.frame(events)
  widths <- unname(unlist(lapply(format(evnts1), nchar)))
  if (is.null(sim[["._spadesDebugWidth"]]))
    sim[["._spadesDebugWidth"]] <- spadesDebugWidthDefault

  sim[["._spadesDebugWidth"]] <- pmax(widths, sim[["._spadesDebugWidth"]], na.rm = TRUE)
  evnts1[1L, ] <- sprintf(paste0("%-", sim[["._spadesDebugWidth"]],"s"), evnts1)
  evnts1[1L, 1L] <- sprintf(paste0("%.4", "g"), as.numeric(evnts1[1L, 1L]))
  evnts1[1L, 1L] <- sprintf(paste0("%-", sim[["._spadesDebugWidth"]][1L], "s"), evnts1[1L, 1L])
  if (isTRUE(.pkgEnv[[".spadesDebugFirst"]])) {
    evnts2 <- evnts1
    evnts2[1L:2L, ] <- rbind(sprintf(paste0("%-",sim[["._spadesDebugWidth"]], "s"), names(evnts2)),
                             sprintf(paste0("%-",sim[["._spadesDebugWidth"]], "s"), evnts2))

    outMess <- paste(unname(evnts2[1, ]), collapse = ' ')
    outMess <- c(outMess, paste(unname(evnts2[2, ]), collapse = ' '))
    # write.table(evnts2, quote = FALSE, row.names = FALSE, col.names = FALSE)
    .pkgEnv[[".spadesDebugFirst"]] <- FALSE
  } else {
    colnames(evnts1) <- NULL
    # write.table(evnts1, quote = FALSE, row.names = FALSE)
    outMess <- paste(unname(evnts1), collapse = ' ')
  }
  outMess
}

runScheduleEventsOnly <- function(sim, fn, env, wh = c("switch", "scheduleEvent"), currnt) {
  if (missing(currnt)) {
    currnt <- unlist(current(sim))
    currnt[["eventTime"]] <- as.numeric(currnt[["eventTime"]])
  }

  if (missing(fn)) {
    fn <- parse(text = deparse(sim[[dotMods]][[currnt[["moduleName"]]]][[paste0("doEvent.", currnt[["moduleName"]])]]))[[1]]
    env <- environment(sim[[dotMods]][[currnt[["moduleName"]]]][[paste0("doEvent.", currnt[["moduleName"]])]])
  }
  num <- grep(wh[1], fn)
  if (wh[1] != "scheduleEvent") {
    if (num == 1) {
      num <- which(names(fn) %in% currnt[["eventType"]])
      wh <- wh[-1]
    }
    sim <- runScheduleEventsOnly(sim = sim, fn = fn[[num]], env = env, wh = wh, currnt = currnt)
  } else {
    env2 <- new.env(parent = env)
    env2$sim <- sim
    for (i in num) {
      sim <- eval(fn[[i]], envir = env2)
    }
  }
  sim
}

## don't change Caching based on .useCache etc. -
## e.g., add "init" to .inputObjects vector shouldn't recalculate
paramsDontCacheOn <- grep(c("useCache"), .knownDotParams, value = TRUE)

#' @importFrom reproducible .cacheMessageObjectToRetrieve extractFromCache loadFromCache
#' @importFrom reproducible messageCache showCache
allowSequentialCaching1 <- function(sim, cacheIt, moduleCall, verbose) {
  .message$IndentUpdate()
  attr(sim, "runFnCallAsExpr") <- NULL
  if (!is.null(sim[["._prevCache"]]) && isTRUE(cacheIt)) {
    sc <- showCache(cacheId = sim[["._prevCache"]], x = cachePath(sim), verbose = -1)
    # sc <- showCache(userTags = sim[["._prevCache"]], verbose = FALSE)[cacheId %in% sim[["._prevCache"]]]
    nextEvent <- unique(extractFromCache(sc, paste0(sequentialCacheText, "NextEventCacheId")))
    cur <- current(sim)
    if (length(nextEvent) > 1) {
      nextEventName <- unique(extractFromCache(sc, paste0(sequentialCacheText, "NextEvent")))
      nextModuleName <- unique(extractFromCache(sc, paste0(sequentialCacheText, "NextModule")))
      keep <- which(nextEventName %in% cur[["eventType"]] & nextModuleName %in% cur[["moduleName"]])
      if (length(keep))
        nextEvent <- nextEvent[keep]
      if (length(keep) == 0)
        nextEvent <- NULL
    }
    if (length(nextEvent != sim[["._prevCache"]]) > 1) browser()
    if (!is.null(nextEvent) && nextEvent != sim[["._prevCache"]]) {
      # The user can't have modified the function being run
      scNe <- showCache(cacheId = nextEvent, x = cachePath(sim), verbose = -1)
      # d <- .robustDigest(Copy(sim, objects = FALSE))

      # need to check for non-object (e.g., function, params, depends) that could have changed
      # checkParams
      sPoss <- .robustDigest(Copy(sim, objects = FALSE))
      # outputs are not necessary in this evaluation; just like in .robustDigest
      sPossNames <- names(sPoss[["depends"]][[cur[["moduleName"]]]])
      sPoss[["depends"]][[cur[["moduleName"]]]] <-
        sPoss[["depends"]][[cur[["moduleName"]]]][outputsRmDontNeedForCache(sPossNames, "outputObjects")]

      scNePreDigests <- scNe$tagValue["preDigest" == scNe$tagKey]

      wh <- c("params", "depends")
      wh2 <- paste0("sim.", wh)
      noChanges <- logical(length(wh) + 1)
      for (iii in seq(wh)) {
        paramCIs <- gsub(".+:(.+)", "\\1", scNePreDigests[startsWith(scNePreDigests, wh2[iii])])
        noChanges[iii] <- all(unlist(sPoss[[wh[iii]]][[cur[["moduleName"]]]]) %in% paramCIs)
      }

      # preModCall <- if (moduleCall == ".inputObjects") "\\.\\" else "\\."
      # grepVal <- paste0("sim\\.\\.list\\.", cur[["moduleName"]], preModCall, moduleCall)
      # Check that function itself (.inputObject or doEvent.XXX) has not changed
      grepVal <- paste0("sim..list.", cur[["moduleName"]], ".", .moduleFunctionsNam, ".", moduleCall)
      scFn <- startsWith(scNePreDigests, grepVal) # grepl(scNePreDigests, pattern = grepVal)
      a <- .robustDigest(sim[[dotMods]][[cur[["moduleName"]]]][[moduleCall]])
      b <- gsub(".+:(.+)", "\\1", scNePreDigests[scFn])
      noChanges[length(noChanges)] <- (a %in% b)
      noChange <- all(noChanges)

      if (isTRUE(noChange)) {
        isMemoised <- reproducible::.isMemoised(cacheId = nextEvent, cachePath = cachePath(sim))
        simSkip <- try(loadFromCache(cachePath(sim), cacheId = nextEvent, verbose = FALSE), silent = TRUE)
        if (!inherits(simSkip, "try-error")) {
          if (all(current(simSkip) == current(sim))) {
            attr(sim, "runFnCallAsExpr") <- FALSE # the trigger to NOT pull the next event
            sim <- .prepareOutput(simSkip, cachePath(sim), sim)
            .cacheMessageObjectToRetrieve(functionName = moduleCall, fullCacheTableForObj = sc,
                                          cachePath = cachePath(sim),
                                          cacheId = sim[["._prevCache"]], verbose = verbose)
            messageCache("Skipped digest of simList because sequential Cache calls of events",
                         verbose = verbose)
            .cacheMessage(sim, functionName = moduleCall, fromMemoise = isMemoised, verbose = verbose)
            attr(sim, "tags") <- paste0("cacheId:", nextEvent)
          }
        }
      }
    }
  }
  sim
}

allowSequentialCachingUpdateTags <- function(sim, cacheIt) {
  if (!isTRUE(cacheIt)) {
    attr(sim, "tags") <- NULL
    attr(sim, ".Cache") <- NULL
    sim[["._prevCache"]] <- NULL
    attr(sim, "runFnCallAsExpr") <- NULL
  }

  sim
}

#' @importFrom utils getFromNamespace
allowSequentialCachingFinal <- function(sim) {
  wasFromCache <- !is.null(attr(sim, "tags"))
  if (wasFromCache) {
    thisCacheId <- gsub("cacheId:", "", attr(sim, "tags"))
    if (!is.null(sim[["._prevCache"]])) {
      sc <- showCache(cacheId = sim[["._prevCache"]], x = cachePath(sim), verbose = -1)
      cp <- cachePath(sim)
      cur <- current(sim)
      seqCache <- sc[startsWith(sc$tagKey, sequentialCacheText)]
      # This is multiple tags for the NextEvent stuff
      if (length(thisCacheId) > 1) browser()
      args <- data.frame(cacheId = sim[["._prevCache"]],
                   tagKey = paste0(sequentialCacheText, "Next", c("EventCacheId", "Module", "Event")),
                   tagValue = c(thisCacheId, cur[["moduleName"]], cur[["eventType"]]),
                   cachePath = cp)
      if (all(c(cur[["moduleName"]], cur[["eventType"]]) %in% seqCache$tagValue) || NROW(seqCache) == 0) {
        fn <- utils::getFromNamespace(".updateTagsRepo", "reproducible")
        args$add = TRUE
      } else {
        fn <- utils::getFromNamespace(".addTagsRepo", "reproducible")
      }

      # put all tags in
      by(args, INDICES = seq_len(NROW(args)), FUN = function(a) do.call(fn, a))
    }
    sim[["._prevCache"]] <- thisCacheId
  }
  sim
}

#' @importFrom reproducible CacheStorageDir
clearNextEventInCache <- function(cachePath = getOption("reproducible.cachePath"),
                                  key = paste0(sequentialCacheText, "Next")) {
  onesWithNextEvent <- character()
  a <- lapply(dir(CacheStorageDir(cachePath), pattern = "dbFile", full.names = TRUE), function(x) {
    y <- readRDS(x)
    if (any(grep(key, y$tagKey))) {
      y <- y[grep(paste0("^", key), tagKey, invert = TRUE)]
      message("resaving ", x)
      onesWithNextEvent <<- c(onesWithNextEvent, x)
      saveRDS(y, file = x)
    }
  })
  return(onesWithNextEvent)
}

sequentialCacheText <- "SequentialCache_"

appendCompleted <- function(sim, cur) {

  cur[[._txtClockTime]] <- Sys.time() # adds between 1 and 3 microseconds, per event b/c R won't let us use .Internal(Sys.time())

  last <- attr(sim, "completedCounter")
  isLastWrong <- length(sim@completed) != last
  if (isTRUE(isLastWrong)) {
    last <- attr(sim, "completedCounter") <- NULL
  }
  if (is.null(last)) {
    prevTime <- cur[[._txtClockTime]]
  } else {
    prevTime <- sim@completed[[as.character(last)]][[._txtClockTime]]
  }
  cur[[._txtPrevEventTimeFinish]] <- prevTime

  if (!is.null(attr(sim, "completedCounter"))) { # use attr(sim, "completedCounter")
    #instead of sim@.xData because collisions with parallel sims from same sim object

    # next section replaces sim@completed <- append(sim@completed, list(cur)),
    # which gets slower with size of sim@completed
    # sim@completed <- append(sim@completed, list(cur))
    #   following does not: it is more or less O(1). Algorithm from: https://stackoverflow.com/questions/17046336/here-we-go-again-append-an-element-to-a-list-in-r?lq=1
    #   it basically increases size of list by *2 every time it fills up

    # increase length of list by doubling as it grows
    # if(attr(sim, "completedCounter")==attr(sim, "completedSize")) {
    #   lenCompl <- length(sim@completed)
    #   if (lenCompl > .pkgEnv[["spades.nCompleted"]]) { # we are above desired
    #     if (attr(sim, "completedCounter") >= lenCompl ) { # We can now cull earlier ones
    #       keepFrom <- lenCompl - .pkgEnv[["spades.nCompleted"]]
    #       sim@completed <- sim@completed[keepFrom:lenCompl] # keep 10000 of them, from lenCompl - nCompleted to current
    #       attr(sim, "completedSize") <- length(sim@completed)
    #       attr(sim, "completedCounter") <- attr(sim, "completedSize")
    #     }
    #   }
    #   attr(sim, "completedSize") <- attr(sim, "completedSize") * 2
    #   #length(sim@completed) <- attr(sim, "completedSize")
    # }

    # faster to use assign
    attr(sim, "completedCounter") <- attr(sim, "completedCounter") + 1
    assign(as.character(attr(sim, "completedCounter")), value = cur, envir = sim@completed)
    #sim@completed[[as.character(attr(sim, "completedCounter"))]] <- cur
  } else {
    # This chunk only occurs during the first event of a `spades` call
    if (!isFALSE(sim@.xData$._ranInitDuringSimInit)) {
      cc <- NROW(sim@completed) + 1
      cs <- cc * 2
    } else {
      cc <- 1
      cs <- 2
    }
    attr(sim, "completedCounter") <- cc
    attr(sim, "completedSize") <- cs
    sim@completed[[as.character(cc)]] <- cur
  }
  sim
}


appendEvents <- function(sim, eventTime, eventType, moduleName, eventPriority) {
  if (!is.na(eventTime)) {
    if (eventTime < 0) {
      stop("You have tried to schedule an event with negative time. You cannot do this. ",
           " Reschedule event (", eventType," event in ", moduleName, " module) with positive time.")
    }
    eventTimeInSeconds <- calculateEventTimeInSeconds(sim, eventTime, moduleName)
    attr(eventTimeInSeconds, "unit") <- "second"

    if (eventTimeInSeconds < sim@simtimes$start)
      stop("You have tried to schedule an event before start(sim). You cannot do this.",
           " Reschedule event (", eventType," event in ", moduleName, " module) at or after start(sim).")

    newEventList <- list(list(
      eventTime = eventTimeInSeconds,
      moduleName = moduleName,
      eventType = eventType,
      eventPriority = eventPriority
    ))
    numEvents <- length(sim@events)

    # put new event into event queue
    if (numEvents == 0L) {
      slot(sim, "events", check = FALSE) <- newEventList
    } else {
      slot(sim, "events", check = FALSE) <- append(sim@events, newEventList)
      needSort <- TRUE
      if (eventTimeInSeconds > sim@events[[numEvents]][[1]]) {
        needSort <- FALSE
      } else if (eventTimeInSeconds == sim@events[[numEvents]][[1]] &&
                 eventPriority >= sim@events[[numEvents]][[4]]) {
        needSort <- FALSE
      }
      if (needSort) {
        ord <- order(unlist(lapply(sim@events, function(x) x$eventTime)),
                     unlist(lapply(sim@events, function(x) x$eventPriority)))
        slot(sim, "events") <- sim@events[ord]
      }
    }
  }
  sim
}

defineEventFnMaker <- function(code, eventFnName) {
  codeAsTxt <- format(code)
  if (identical(codeAsTxt[1], "{"))
    codeAsTxt <- codeAsTxt[-1]
  if (identical(codeAsTxt[length(codeAsTxt)], "}"))
    codeAsTxt <- codeAsTxt[-length(codeAsTxt)]
  fn <- paste0("
", eventFnName, " <- function(sim, eventTime, eventType, priority) {
", paste(codeAsTxt, collapse = "\n") ,"
  return(sim)
}
")
}


saveSimOnExit <- function(recoverMode, sim, rmo) {
  if (!isTRUE(.pkgEnv$.cleanEnd)) {
    if (recoverMode > 0) {
      sim <- recoverModeOnExit(sim, rmo, recoverMode)
    }
    messageInterrupt1(recoverMode)
  } else {
    message(cli::col_magenta("simList saved in"), "\n",
            cli::col_blue("SpaDES.core:::savedSimEnv()$.sim"), "\n",
            cli::col_magenta("It will be deleted at next spades() call."))
  }
  svdSimEnv <- savedSimEnv() # can't assign to a function
  svdSimEnv$.sim <- sim # no copy of objects -- essentially 2 pointers throughout
  .pkgEnv$.cleanEnd <- NULL
  sim
}

recoverModeTypo <- function() {
  recoverModeWrong <- getOption("spades.recoverMode")
  if (!is.null(recoverModeWrong)) {
    warning("Please set options('recoveryMode') with a 'y', not options('recoverMode')")
  }
}



# fixPointers <- function(sim, cachePath = getOption("reproducible.cachePath"),
#                         verbose = getOption("reproducible.verbose")) {
#   lsSim <- ls(sim)
#   a <- Map(x = lsSim, function(x) if (isS4(sim[[x]])) {# This is a fast way to filter out non terra objects
#     if (is(sim[[x]], "SpatRaster") ||
#         is(sim[[x]], "SpatVector") ||
#         is(sim[[x]], "SpatExtent")) {
#       rr <- try(sim[[x]]@pntr$size(), silent = TRUE)
#       !is.null(rr) && is(rr, "try-error")
#     }
#   } else {FALSE})
#
#   a <- a[unlist(a)]
#   if (length(a)) {
#     opt <- options(reproducible.useMemoise = FALSE)
#     on.exit(options(opt))
#
#     failedNams <- names(a)
#     for (nam in failedNams) {
#       cid <- cacheId(sim[[nam]])
#       if (!is.null(cid)) {
#         sim[[nam]] <- loadFromCache(cachePath, cid, verbose = verbose - 1)
#         messageCache("Pointer to ", nam, " was corrupt: fixed from Cached object", verbose = verbose)
#       }
#     }
#   }
#   sim
# }
#



dotRMOFilepath <- function(thisSpadesCallRandomStr, events) {
  sub <- if (missing(events))
    sub <- ""
  else
    paste(events[[1]][["moduleName"]], events[[1]][["eventType"]],
                 sep = "_", round(events[[1]][["eventTime"]]))
  file.path(getOption("spades.scratchPath"), "._rmo", thisSpadesCallRandomStr, sub)
}

evalPostEvent <- function(envir = parent.frame()) {
  if (!is.null(getOption("spades.evalPostEvent"))) {
    # print(getOption("spades.evalPostEvent"))
    eval(getOption("spades.evalPostEvent"), envir = envir)
  }
}

cacheChainingSetup <- function(cacheIt, prevCache, chainingEnv, nonObjects, fnCallAsExpr,
                               module, event, led,
                               verbose = getOption("reproducible.verbose")) {
  df <- cacheIdOfSkip <- NULL
  if (!is.null(prevCache) && isTRUE(cacheIt)) {
    digestNonObjects <- reproducible::CacheDigest(nonObjects)$outputHash

    df <- setDT(list(prevCache = prevCache, digestNonObjects = digestNonObjects,
                     module = module, event = event))
    #df <- data.table(prevCache = prevCache, digestNonObjects = digestNonObjects,
    #                 module = module, event = event)
    set(df, NULL, lastEventDetails, led)
    anyExisting <- chainingEnv[[eventCachingDF]][df, on = colnames(df), nomatch = NULL]
    cacheId <- gsub("cacheId:", "", prevCache)
    sc <- showCacheFast(cacheId = cacheId)
    ccVals <- sc[startsWith(sc$tagKey, "cacheChaining")]
    if (NROW(ccVals)) {
      spli <- strsplit(ccVals$tagKey, "_")
      postCacheIds <- sapply(spli, function(x) x[[3]])
      nams <- sapply(spli, function(x) x[[2]])
      whPCI <- nams %in% "postCacheId"
      vals <- ccVals$tagValue
      prevDF <- setDT(as.data.frame(as.list(vals) |> setNames(nams)))

      # THIS IS THE IMPORTANT LINE; JOIN on ALL COLUMNS especially digestNonObjects
      anyExisting <- prevDF[df, on = colnames(df), nomatch = NULL]


      # hasAPostCacheId <- unique(sc$tagValue[endsWith(sc$tagKey, "postCacheId")])

      # if (length(hasAPostCacheId)) {
      if (NROW(anyExisting)) {
        #basically, can't be .inputObjects as previous event, if this event is not also .inputObjects
        #   can't jump from simInit to spades because a user could have modified the simList
        #if (length(endsWith(anyExisting[[lastEventDetails]], ".inputObjects")) > 1)
        #  browser()
        #if ( !(endsWith(anyExisting[[lastEventDetails]], ".inputObjects") &&
        #       event != ".inputObjects") ) {
        # cacheIdOfSkip <- hasAPostCacheId
        cacheIdOfSkip <- anyExisting$postCacheId
        fnCallAsExpr[[1]]$cacheId = cacheIdOfSkip
        messageCache("Using cacheChaining ... ", verbose = verbose)

        #}
      }
    }
  }
  list(cacheIdOfSkip = cacheIdOfSkip, df = df, fnCallAsExpr = fnCallAsExpr)
}


cacheChainingPost <- function(sim, cacheIt, prevCache,
                              cacheIdOfSkip, df, chainingEnv, moduleName, eventType) {
  attr(sim, lastEventDetails) <- paste(moduleName, eventType, collapse = "_")
  if (!isTRUE(cacheIt)) {
    attr(sim, "tags") <- NULL # Remove the tag from Cache recovery
  } else if (!is.null(prevCache)) {
    if (is.null(cacheIdOfSkip)) {
      # It can already be there, especially when it is .inputObjects to init transition
      postCacheId <- gsub("cacheId:", "", attr(sim, "tags"))
      df <- set(df, NULL, "postCacheId", postCacheId)
      # .addTagsRepo(cacheId = gsub("cacheId:", "", df$prevCache), cachePath = cachePath(sim),
      #              tagKey = cacheChainingPostCacheId, postCacheId)

      .addTagsRepo(cacheId = gsub("cacheId:", "", df$prevCache), cachePath = cachePath(sim),
                   tagKey = paste0("cacheChaining_", colnames(df), "_", postCacheId), tagValue = unname(unlist(df)))
      if (!(df$prevCache %in% chainingEnv[[eventCachingDF]]$prevCache &&
            df$digestNonObjects %in% chainingEnv[[eventCachingDF]]$digestNonObjects)) {
        chainingEnv[[eventCachingDF]] <- rbind(chainingEnv[[eventCachingDF]], df)
      }

    }
  }
  sim
}


lastEventDetails <- "lastEventDetails"
eventCachingDF <- "eventCachingDF"
cacheChainingPostCacheId <- "cacheChaining_postCacheId"

chainingEnv <- function(cachePath, envir = .GlobalEnv) {
  obj <- paste0(".spadesChainingEnv_", cachePath)
  if (!exists(obj, envir = envir))
    assign(obj, new.env(parent = emptyenv()), envir = envir)
  theEnv <- get(obj, envir = envir, inherits = FALSE)
  theEnv
}


extractFns <- function(moduleSpecificObjects) {
  fns2 <- grep(":", moduleSpecificObjects, value = TRUE) |>
    gsub(pattern = "^.+:", replacement = "")
  fns2[nzchar(fns2)]
}


set_console_width <- function(update = TRUE, min_width = 120, check_interval = 20) {
  if (!requireNamespace("cli", quietly = TRUE)) {
    stop("Package 'cli' is required. Install it with install.packages('cli').")
  }

  # Current time
  now <- Sys.time()

  # Check if we have cached width and timestamp
  if (exists("last_width", envir = .pkgEnv) && exists("last_time", envir = .pkgEnv)) {
    elapsed <- as.numeric(difftime(now, .pkgEnv$last_time, units = "secs"))
    if (elapsed < check_interval) {
      # Use cached value
      cols <- .pkgEnv$last_width
      if (update) options(width = cols)
      return(cols)
    }
  }

  # Detect width using cli
  cols <- cli::console_width()

  # Enforce minimum width
  if (cols < min_width) cols <- min_width

  # Cache result
  .pkgEnv$last_width <- cols
  .pkgEnv$last_time <- now

  # Update options if requested
  if (update) options(width = cols)

  return(cols)
}

