[elpa] externals/plz 78f12d15db 6/7: Merge: Queueing

[ELPA Syncer]

branch: externals/plz
commit 78f12d15db028e6487c2cb03ace848890e3b681b
Merge: 9a9c7bb919 a6cb9bd0e2
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Merge: Queueing
---
 README.org        |  32 +++++++++-
 plz.el            | 173 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 tests/test-plz.el |  22 +++++++
 3 files changed, 226 insertions(+), 1 deletion(-)

diff --git a/README.org b/README.org
index 23e0fda74e..ce1beb51ff 100644
--- a/README.org
+++ b/README.org
@@ -19,6 +19,7 @@
 - [[#usage][Usage]]
   - [[#examples][Examples]]
   - [[#functions][Functions]]
+  - [[#queueing][Queueing]]
 - [[#changelog][Changelog]]
 - [[#credits][Credits]]
 - [[#development][Development]]
@@ -43,7 +44,7 @@
 :TOC:      :depth 1
 :END:
 
-The only public function is ~plz~, which sends an HTTP request and returns 
either the result of the specified type (for a synchronous request), or the 
~curl~ process object (for asynchronous requests).  For asynchronous requests, 
callback, error-handling, and finalizer functions may be specified, as well as 
various other options.
+The main public function is ~plz~, which sends an HTTP request and returns 
either the result of the specified type (for a synchronous request), or the 
~curl~ process object (for asynchronous requests).  For asynchronous requests, 
callback, error-handling, and finalizer functions may be specified, as well as 
various other options.
 
 ** Examples
 
@@ -131,6 +132,35 @@ Synchronously download a JPEG file, then create an Emacs 
image object from the d
 
    ~NOQUERY~ is passed to ~make-process~, which see.
 
+** Queueing
+
+~plz~ provides a simple system for queueing HTTP requests.  First, make a 
~plz-queue~ struct by calling ~make-plz-queue~.  Then call ~plz-queue~ with the 
struct as the first argument, and the rest of the arguments being the same as 
those passed to ~plz~.  Then call ~plz-run~ to run the queued requests.
+
+All of the queue-related functions return the queue as their value, making 
them easy to use.  For example:
+
+#+begin_src elisp
+  (defvar my-queue (make-plz-queue :limit 2))
+
+  (plz-run
+   (plz-queue my-queue
+     'get "https://httpbin.org/get?foo=0";
+     :then (lambda (body) (message "%s" body))))
+#+end_src
+
+Or:
+
+#+begin_src elisp
+  (let ((queue (make-plz-queue :limit 2))
+        (urls '("https://httpbin.org/get?foo=0";
+                "https://httpbin.org/get?foo=1";)))
+    (plz-run
+     (dolist (url urls queue)
+       (plz-queue queue 'get url
+         :then (lambda (body) (message "%s" body))))))
+#+end_src
+
+You may also clear a queue with ~plz-clear~, which cancels any active or 
queued requests and calls their ~:else~ functions.  And ~plz-length~ returns 
the number of a queue's active and queued requests.
+
 ** Tips
 :PROPERTIES:
 :TOC:      :ignore (this)
diff --git a/plz.el b/plz.el
index b6d60a9c74..dda33382b0 100644
--- a/plz.el
+++ b/plz.el
@@ -442,6 +442,179 @@ NOQUERY is passed to `make-process', which see."
                   (kill-buffer))))
           process)))))
 
+;;;;; Queue
+
+;; A simple queue system.
+
+(cl-defstruct plz-queued-request
+  "Struct representing a queued `plz' HTTP request.
+For more details on these slots, see arguments to the function
+`plz'."
+  method url headers body else finally noquery
+  as then body-type decode
+  connect-timeout timeout
+  next previous process)
+
+(cl-defstruct plz-queue
+  "Struct forming a queue for `plz' requests.
+The queue may be appended to (the default) and prepended to, and
+items may be removed from the front of the queue (i.e. by
+default, it's FIFO).  Use functions `plz-queue', `plz-run', and
+`plz-clear' to queue, run, and clear requests, respectively."
+  (limit 1
+         :documentation "Number of simultaneous requests.")
+  (active nil
+          :documentation "Active requests.")
+  (requests nil
+            :documentation "Queued requests.")
+  (canceled-p nil
+              :documentation "Non-nil when queue has been canceled.")
+  first-active last-active
+  first-request last-request)
+
+(defun plz-queue (queue &rest args)
+  "Enqueue request for ARGS on QUEUE and return QUEUE.
+To prepend to QUEUE rather than append, it may be a list of the
+form (`prepend' QUEUE).  QUEUE is a `plz-request' queue.  ARGS
+are those passed to `plz', which see.  Use `plz-run' to start
+making QUEUE's requests."
+  (declare (indent defun))
+  (cl-assert (not (equal 'sync (plist-get (cddr args) :then))) nil
+             "Only async requests may be queued")
+  (pcase-let* ((`(,method ,url . ,rest) args)
+               (args `(:method ,method :url ,url ,@rest))
+               (request (apply #'make-plz-queued-request args)))
+    (pcase queue
+      (`(prepend ,queue) (plz--queue-prepend request queue))
+      (_ (plz--queue-append request queue))))
+  queue)
+
+(defun plz--queue-append (request queue)
+  "Append REQUEST to QUEUE and return QUEUE."
+  (cl-check-type request plz-queued-request
+                 "REQUEST must be a `plz-queued-request' struct.")
+  (cl-check-type queue plz-queue
+                 "QUEUE must be a `plz-queue' struct.")
+  (when (plz-queue-last-request queue)
+    (setf (plz-queued-request-next (plz-queue-last-request queue)) request))
+  (setf (plz-queued-request-previous request) (plz-queue-last-request queue)
+        (plz-queue-last-request queue) request)
+  (unless (plz-queue-first-request queue)
+    (setf (plz-queue-first-request queue) request))
+  (unless (plz-queue-last-request queue)
+    (setf (plz-queue-last-request queue) request))
+  (push request (plz-queue-requests queue))
+  queue)
+
+(defun plz--queue-prepend (request queue)
+  "Prepend REQUEST to QUEUE and return QUEUE."
+  (cl-check-type request plz-queued-request
+                 "REQUEST must be a `plz-queued-request' struct.")
+  (cl-check-type queue plz-queue
+                 "QUEUE must be a `plz-queue' struct.")
+  (when (plz-queue-requests queue)
+    (setf (plz-queued-request-next request) (car (plz-queue-requests queue))
+          (plz-queued-request-previous (plz-queued-request-next request)) 
request))
+  (setf (plz-queue-first-request queue) request)
+  (unless (plz-queue-first-request queue)
+    (setf (plz-queue-first-request queue) request))
+  (unless (plz-queue-last-request queue)
+    (setf (plz-queue-last-request queue) request))
+  (push request (plz-queue-requests queue))
+  queue)
+
+(defun plz--queue-pop (queue)
+  "Return the first queued request on QUEUE and remove it from QUEUE."
+  (let* ((request (plz-queue-first-request queue))
+         (next (plz-queued-request-next request)))
+    (when next
+      (setf (plz-queued-request-previous next) nil))
+    (setf (plz-queue-first-request queue) next
+          (plz-queue-requests queue) (delq request (plz-queue-requests queue)))
+    (when (eq request (plz-queue-last-request queue))
+      (setf (plz-queue-last-request queue) nil))
+    request))
+
+(defun plz-run (queue)
+  "Process requests in QUEUE and return QUEUE.
+Return when QUEUE is at limit or has no more queued requests.
+
+QUEUE should be a `plz-queue' struct."
+  (cl-labels ((readyp
+               (queue) (and (not (plz-queue-canceled-p queue))
+                            (plz-queue-requests queue)
+                            ;; With apologies to skeeto...
+                            (< (length (plz-queue-active queue)) 
(plz-queue-limit queue)))))
+    (while (readyp queue)
+      (pcase-let* ((request (plz--queue-pop queue))
+                   ((cl-struct plz-queued-request method url
+                               headers body finally noquery as body-type 
decode connect-timeout timeout
+                               (else orig-else) (then orig-then))
+                    request)
+                   (then (lambda (response)
+                           (unwind-protect
+                               ;; Ensure any errors in the THEN function don't 
abort the queue.
+                               (funcall orig-then response)
+                             (setf (plz-queue-active queue) (delq request 
(plz-queue-active queue)))
+                             (plz-run queue))))
+                   (else (lambda (arg)
+                           (unwind-protect
+                               ;; Ensure any errors in the THEN function don't 
abort the queue.
+                               (when orig-else
+                                 (funcall orig-else arg))
+                             (setf (plz-queue-active queue) (delq request 
(plz-queue-active queue)))
+                             (plz-run queue))))
+                   (args (list method url
+                               ;; Omit arguments for which `plz' has defaults 
so as not to nil them.
+                               :headers headers :body body :finally finally 
:noquery noquery
+                               :connect-timeout connect-timeout :timeout 
timeout)))
+        ;; Add arguments which override defaults.
+        (when as
+          (setf args (plist-put args :as as)))
+        (when else
+          (setf args (plist-put args :else else)))
+        (when then
+          (setf args (plist-put args :then then)))
+        (when decode
+          (setf args (plist-put args :decode decode)))
+        (when body-type
+          (setf args (plist-put args :body-type body-type)))
+        (when connect-timeout
+          (setf args (plist-put args :connect-timeout connect-timeout)))
+        (when timeout
+          (setf args (plist-put args :timeout timeout)))
+        (setf (plz-queued-request-process request) (apply #'plz args))
+        (push request (plz-queue-active queue))))
+    queue))
+
+(defun plz-clear (queue)
+  "Clear QUEUE and return it.
+Cancels any active or pending requests.  For pending requests,
+their ELSE functions will be called with a `plz-error' struct
+with the message, \"`plz' queue cleared; request canceled.\";
+active requests will have their curl processes killed and their
+ELSE functions called with the corresponding data."
+  (setf (plz-queue-canceled-p queue) t)
+  (dolist (request (plz-queue-active queue))
+    (kill-process (plz-queued-request-process request))
+    (setf (plz-queue-active queue) (delq request (plz-queue-active queue))))
+  (dolist (request (plz-queue-requests queue))
+    (funcall (plz-queued-request-else request)
+             (make-plz-error :message "`plz' queue cleared; request 
canceled."))
+    (setf (plz-queue-requests queue) (delq request (plz-queue-requests 
queue))))
+  (setf (plz-queue-first-active queue) nil
+        (plz-queue-last-active queue) nil
+        (plz-queue-first-request queue) nil
+        (plz-queue-last-request queue) nil
+        (plz-queue-canceled-p queue) nil)
+  queue)
+
+(defun plz-length (queue)
+  "Return number of of QUEUE's outstanding requests.
+Includes active and queued requests."
+  (+ (length (plz-queue-active queue))
+     (length (plz-queue-requests queue))))
+
 ;;;;; Private
 
 (defun plz--sentinel (process-or-buffer status)
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 44d48de284..9b4140efaf 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -442,6 +442,28 @@
       (when (file-exists-p filename)
         (delete-file filename)))))
 
+;;;;; Queue
+
+;; TODO: Test that limit is enforced (though it seems to work fine).
+
+(ert-deftest plz-queue ()
+  (let ((queue (make-plz-queue :limit 2))
+        (urls '("https://httpbin.org/get?foo=0";
+                "https://httpbin.org/get?foo=1";))
+        completed-urls)
+    (dolist (url urls)
+      (plz-queue queue
+        'get url :then (lambda (_)
+                         (push url completed-urls))))
+    (plz-run queue)
+    (cl-loop with waits = 0
+             while (and (plz-queue-active queue) (< waits 20))
+             do (progn
+                  (sleep-for 0.1)
+                  (cl-incf waits)))
+    (and (seq-set-equal-p urls completed-urls)
+         (zerop (plz-length queue)))))
+
 ;;;; Footer
 
 (provide 'test-plz)