add httr_progress to use with the httr package #103

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: waiter
 Title: Loading Screen for 'Shiny'
-Version: 0.2.3
+Version: 0.2.4.9000
 Date: 2021-07-21
 Authors@R: c(
     person(given = "John",
@@ -28,6 +28,7 @@ Imports:
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.1
 Suggests: 
+    httr,
     knitr,
     packer,
     rmarkdown

NEWS.md

@@ -1,3 +1,8 @@
+# waiter 0.2.4.9000
+
+- Added `httr_progress` function to use instead of 
+`httr::progress`.
+
 # waiter 0.2.3
 
 - Fix [#95](https://github.com/JohnCoene/waiter/issues/95) with different CSS for full screen (`position: fixed`).

R/httr.R

@@ -0,0 +1,79 @@
+#' Waitress with httr
+#' 
+#' Use a waitress progress bar with httr requests.
+#' Simply use `httr_progress` where you would use
+#' [httr::progress].
+#' 
+#' @param waitress The waitress object.
+#' @param type Type of progress to display: either number of 
+#' bytes uploaded or downloaded. Passed to [httr::progress].
+#' @param pre,post Pre and callback functions to run before
+#' the progress starts or once it is done.
+#' 
+#' @examples 
+#' \dontrun{
+#' cap_speed <- httr::config(max_recv_speed_large = 10000)
+#' 
+#' httr::GET(
+#'   "http://httpbin.org/bytes/102400", 
+#'   httr_progress(w), 
+#'   cap_speed
+#' )
+#' }
+httr_progress <- function(
+	waitress, 
+	type = c("down", "up"), 
+	pre = NULL, 
+	post = NULL
+){
+	type <- match.arg(type)
+
+	if(missing(waitress))
+		stop("Missing `waitress` object", call. = FALSE)
+
+	httr_request <- utils::getFromNamespace("request", "httr")
+
+  httr_request(
+		options = list(
+    	noprogress = FALSE,
+    	progressfunction = progress_bar(waitress, type, pre, post)
+  	)
+	)
+}
+
+progress_bar <- function(w, type, pre = NULL, post = NULL) {
+
+  show_progress <- function(down, up) {
+    if (type == "down") {
+      total <- down[[1]]
+      now <- down[[2]]
+    } else {
+      total <- up[[1]]
+      now <- up[[2]]
+    }	
+
+    if (total == 0 && now == 0) {
+			if(!is.null(pre))
+				pre()
+      # Reset progress bar when seeing first byte
+			w$start()
+      w$set(0)
+    }  else {
+			w$max <- total
+
+			# increment
+			w$set(now)
+			# close
+      if(now == total) {
+				w$close()
+
+				if(!is.null(post))	
+					post()
+			}
+    }
+
+    TRUE
+  }
+
+  show_progress
+}

R/waitress.R

@@ -333,6 +333,15 @@ Waitress <- R6::R6Class(
 				cat("A waitress notification\n")
 		}
 	),
+	active = list(
+#' @field max Maximum value of the bar.
+		max = function(value) {
+			if(missing(value))
+				return(private$.max)
+
+			private$.max <- value
+		}
+	),
 	private = list(
 		.name = NULL,
 		.theme = NULL,

docs/changelog.md

@@ -2,6 +2,11 @@
 
 List of changes made to waiter.
 
+# waiter 0.2.4.9000
+
+- Added `httr_progress` function to use instead of 
+`httr::progress`.
+
 ## waiter 0.2.3
 
 - Fix [#95](https://github.com/JohnCoene/waiter/issues/95) with different CSS for full screen (`position: fixed`).

docs/waitress.md

@@ -273,4 +273,44 @@ server <- function(input, output){
 shinyApp(ui, server)
 ```
 
-![](_assets/img/waitress-hide-on-render.gif)
+![](_assets/img/waitress-hide-on-render.gif)
+
+## httr
+
+Use instead of `httr::progress`, replace it with `httr_progress`.
+
+```r
+library(httr)
+library(shiny)
+library(waiter)
+
+cap_speed <- config(max_recv_speed_large = 10000)
+
+ui <- fluidPage(
+  useWaitress(),
+  actionButton(
+    "dl",
+    "Download"
+  ),
+  plotOutput("plot")
+)
+
+server <- function(input, output){
+  w <- Waitress$new("#plot")
+
+  dataset <- eventReactive(input$dl, {
+    x <- GET(
+      "http://httpbin.org/bytes/102400", 
+      httr_progress(w), 
+      cap_speed
+    )
+
+    runif(100)
+  })
+
+  output$plot <- renderPlot(plot(dataset()))
+}
+
+shinyApp(ui, server)
+
+```