PR feedback. Broke tests because of dependency on session, though, so…

… might revert.

R/reactives.R

@@ -1513,16 +1513,14 @@ reactiveTimer <- function(intervalMs=1000, session = getDefaultReactiveDomain())
   # reactId <- nextGlobalReactId()
   # rLog$define(reactId, paste0("timer(", intervalMs, ")"))
 
-  scheduler <- defineScheduler(session)
-
   dependents <- Map$new()
-  timerHandle <- scheduler(intervalMs, function() {
+  timerHandle <- session$.scheduleTask(intervalMs, function() {
     # Quit if the session is closed
     if (!is.null(session) && session$isClosed()) {
       return(invisible())
     }
 
-    timerHandle <<- scheduler(intervalMs, sys.function())
+    timerHandle <<- session$.scheduleTask(intervalMs, sys.function())
 
     doInvalidate <- function() {
       lapply(
@@ -1622,9 +1620,7 @@ invalidateLater <- function(millis, session = getDefaultReactiveDomain()) {
 
   clear_on_ended_callback <- function() {}
 
-  scheduler <- defineScheduler(session)
-
-  timerHandle <- scheduler(millis, function() {
+  timerHandle <- session$.scheduleTask(millis, function() {
     if (is.null(session)) {
       ctx$invalidate()
       return(invisible())
@@ -2375,7 +2371,7 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
     }
 
     # The value (or possibly millis) changed. Start or reset the timer.
-    v$when <- getTime(domain) + millis()/1000
+    v$when <- domain$.now() + millis()/1000
   }, label = "debounce tracker", domain = domain, priority = priority)
 
   # This observer is the timer. It rests until v$when elapses, then touches
@@ -2384,7 +2380,7 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
     if (is.null(v$when))
       return()
 
-    now <- getTime(domain)
+    now <- domain$.now()
     if (now >= v$when) {
       # Mod by 999999999 to get predictable overflow behavior
       v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 1
@@ -2435,12 +2431,12 @@ throttle <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
     if (is.null(v$lastTriggeredAt)) {
       0
     } else {
-      max(0, (v$lastTriggeredAt + millis()/1000) - getTime(domain)) * 1000
+      max(0, (v$lastTriggeredAt + millis()/1000) - domain$.now()) * 1000
     }
   }
 
   trigger <- function() {
-    v$lastTriggeredAt <- getTime(domain)
+    v$lastTriggeredAt <- domain$.now()
     # Mod by 999999999 to get predictable overflow behavior
     v$trigger <- isolate(v$trigger) %% 999999999 + 1
     v$pending <- FALSE

R/shiny.R

@@ -723,9 +723,12 @@ ShinySession <- R6Class(
     requestFlush = function() {
       appsNeedingFlush$set(self$token, self)
     },
-    scheduleTask = function(millis, callback) {
+    .scheduleTask = function(millis, callback) {
       scheduleTask(millis, callback)
     },
+    .now = function() {
+      getNow()
+    },
     rootScope = function() {
       self
     },

R/timer.R

@@ -119,25 +119,3 @@ scheduleTask <- function(millis, callback) {
     invisible(timerCallbacks$unschedule(id))
   }
 }
-
-#' Get a scheduler function for scheduling tasks. Give priority to the
-#' session scheduler, but if it doesn't exist, use the global one.
-#' @noRd
-defineScheduler <- function(session){
-  if (!is.null(session) && !is.null(session$scheduleTask)){
-    return(session$scheduleTask)
-  }
-  scheduleTask
-}
-
-
-#' Get the current time a la `Sys.time()`. Prefer to get it via the
-#' `session$now()` function, but if that's not available, just return the
-#' current system time.
-#' @noRd
-getTime <- function(session){
-  if (!is.null(session) && !is.null(session$now)){
-    return(session$now())
-  }
-  Sys.time()
-}

tests/testthat/test-app.R

@@ -99,7 +99,7 @@ test_that("With ui/server.R, global.R is loaded before R/ helpers and into the r
 })
 
 
-test_that("Loading supporting R fils is opt-out", {
+test_that("Loading supporting R files is opt-out", {
   calls <- list()
   sourceStub <- function(...){
     calls[[length(calls)+1]] <<- list(...)
@@ -128,7 +128,7 @@ test_that("Loading supporting R fils is opt-out", {
 })
 
 
-test_that("Disabling supporting R fils works", {
+test_that("Disabling supporting R files works", {
   calls <- list()
   sourceStub <- function(...){
     calls[[length(calls)+1]] <<- list(...)

tests/testthat/test-timer.R

@@ -47,12 +47,6 @@ test_that("Vectorized unscheduling works", {
   expect_identical(timerCallbacks$unschedule(c(key1, key2, key3)), c(TRUE, FALSE, TRUE))
 })
 
-test_that("defineScheduler works", {
-  expect_identical(defineScheduler(NULL), scheduleTask)
-  expect_identical(defineScheduler(list()), scheduleTask)
-  expect_identical(defineScheduler(list(scheduleTask=123)), 123)
-})
-
 test_that("mockableTimer works", {
   mt <- MockableTimerCallbacks$new()
   called <- FALSE
@@ -70,18 +64,3 @@ test_that("mockableTimer works", {
   expect_true(mt$executeElapsed())
   expect_true(called)
 })
-
-test_that("getTime works", {
-  start <- Sys.time()
-  t1 <- getTime(NULL)
-  t2 <- getTime(list())
-  t3 <- getTime(list(now = function(){456}))
-  end <- Sys.time()
-
-  expect_gte(t1, start)
-  expect_gte(t2, start)
-  expect_lte(t1, end)
-  expect_lte(t2, end)
-
-  expect_equal(t3, 456)
-})