[elpa] externals/plz fb1c8fdf56 2/7: WIP: Queueing II

[ELPA Syncer]

branch: externals/plz
commit fb1c8fdf56bf1e685e10d6edb98d938f56dab7d2
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    WIP: Queueing II
    
    With thanks to Chris Wellons (@skeeto) for his invaluable feedback.
---
 plz.el            | 224 ++++++++++++++++++++++++++++++++++++------------------
 tests/test-plz.el |   5 +-
 2 files changed, 154 insertions(+), 75 deletions(-)

diff --git a/plz.el b/plz.el
index 51a104d085..fe9605030b 100644
--- a/plz.el
+++ b/plz.el
@@ -5,7 +5,7 @@
 ;; Author: Adam Porter <adam@alphapapa.net>
 ;; URL: https://github.com/alphapapa/plz.el
 ;; Version: 0.1-pre
-;; Package-Requires: ((emacs "26.3") (queue "0.2"))
+;; Package-Requires: ((emacs "26.3"))
 ;; Keywords: comm, network, http
 
 ;;; License:
@@ -51,8 +51,6 @@
 (require 'rx)
 (require 'subr-x)
 
-(require 'queue)
-
 ;;;; Errors
 
 ;; FIXME: `condition-case' can't catch these...?
@@ -67,16 +65,6 @@
 (cl-defstruct plz-error
   curl-error response message)
 
-(cl-defstruct plz-queue
-  "A queue of `plz' requests.
-Use `plz-queue' to enqueue requests, `plz-run' to start making a
-queue's requests, `plz-clear' to empty a queue, and `plz-reset'
-to reset it."
-  (limit 1 :documentation "Number of simultaneous connections to allow." :type 
integer)
-  (active nil :documentation "(internal) List of active requests." :type list)
-  (requests (make-queue) :documentation "A `queue' of lists of `plz' arguments 
(which effectively define a request)."
-            :type queue))
-
 ;;;; Constants
 
 (defconst plz-http-response-status-line-regexp
@@ -416,82 +404,174 @@ NOQUERY is passed to `make-process', which see."
 
 ;; 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.
-QUEUE is a `plz-request' queue.  ARGS are those passed to `plz',
-which see.  Use `plz-run' to start making QUEUE's requests.
+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)
 
-Request is added with `queue-append'; the list of ARGS may
-instead be manually prepended to the `plz-queue' struct's
-`requests' slot with `queue-prepend'.
+(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)
 
-Note that any errors signaled in the processing of a request's
-THEN or ELSE functions may cause the queue to abort processing;
-if this is not desired, the THEN and ELSE functions given should
-handle any errors signaled in their bodies."
-  (declare (indent defun))
-  (let ((then (plist-get (cddr args) :then))
-        (else (plist-get (cddr args) :else)))
-    (plist-put (cddr args) :then
-               ;; Set the THEN function to one that also runs the queue.
-               (lambda (response)
-                 (funcall then response)
-                 ;; Remove request from queue and run rest of queue.
-                 (setf (plz-queue-active queue)
-                       (delete args (plz-queue-active queue)))
-                 (plz-run queue)))
-    (plist-put (cddr args) :else
-               ;; Set the ELSE function to one that also runs the queue.
-               (lambda (arg)
-                 (funcall else arg)
-                 ;; Remove request from queue and run rest of queue.
-                 (setf (plz-queue-active queue)
-                       (delete args (plz-queue-active queue)))
-                 (plz-run queue))))
-  (queue-enqueue (plz-queue-requests queue) args)
+(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.
+  "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."
-  (cond ((queue-empty (plz-queue-requests queue))
-         ;; Queue empty: do nothing.
-         nil)
-        ((>= (length (plz-queue-active queue)) (plz-queue-limit queue))
-         ;; Queue already at limit: do nothing.
-         nil)
-        (t
-         ;; Queue not at limit: process requests.
-         (let ((request (queue-dequeue (plz-queue-requests queue))))
-           (push request (plz-queue-active queue))
-           (apply #'plz request))
-         ;; Keep going until limit is reached.
-         (plz-run queue))))
+  (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.
-Removes any active or pending requests."
-  ;; TODO: Track process associated with each request and kill it.
-  ;; (Otherwise this is likely to cause errors.)
-  (setf (plz-queue-active queue) nil)
-  (queue-clear (plz-queue-requests queue))
-  queue)
-
-(defun plz-reset (queue)
-  "Reset QUEUE and return it.
-Moves any active requests back into the queue."
-  ;; TODO: Track process associated with each request and kill it.
-  (let ((active (plz-queue-active queue)))
-    (setf (plz-queue-active queue) nil)
-    (dolist (request active)
-      (queue-enqueue (plz-queue-requests queue) request)))
+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, their ELSE
+functions being 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))
-     (queue-length (plz-queue-requests queue))))
+     (length (plz-queue-requests queue))))
 
 ;;;;; Private
 
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 81b54f0a6a..43d467ae04 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -449,7 +449,7 @@
         completed-urls)
     (dolist (url urls)
       (plz-queue queue
-        'get url :then (lambda (string)
+        'get url :then (lambda (_)
                          (push url completed-urls))))
     (plz-run queue)
     (cl-loop with waits = 0
@@ -458,8 +458,7 @@
                   (sleep-for 0.1)
                   (cl-incf waits)))
     (and (seq-set-equal-p urls completed-urls)
-         (queue-empty (plz-queue-requests queue))
-         (zerop (length (plz-queue-active queue))))))
+         (zerop (plz-length queue)))))
 
 ;;;; Footer