[elpa] externals/plz 6a21c7e809 12/81: Significant changes

[ELPA Syncer]

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

    Significant changes
    
    Thanks to Chris Wellons for his invaluable feedback.
---
 notes.org         |  72 ++++++++++++++++
 plz.el            | 246 +++++++++++++++++++++++++++++++++---------------------
 tests/test-plz.el |  83 +++++++++++++++---
 3 files changed, 293 insertions(+), 108 deletions(-)

diff --git a/notes.org b/notes.org
new file mode 100644
index 0000000000..8944270d80
--- /dev/null
+++ b/notes.org
@@ -0,0 +1,72 @@
+#+TITLE: plz Notes
+
+* API Design
+
+** Async
+
+Some sample cases that the API should make easy.
+
+*** Body as string
+
+#+BEGIN_SRC elisp
+  (plz-get url
+    :with 'body-string
+    :then (lambda (body-string)
+            (setf something body-string)))
+#+END_SRC
+
+*** Body as buffer
+
+#+BEGIN_SRC elisp
+  ;; Decodes body and narrows buffer to it.
+  (plz-get url
+    :with 'buffer
+    :then (lambda (buffer)
+            (with-current-buffer buffer
+              (setf text (buffer-substring (point-min) (point-max))))))
+#+END_SRC
+
+#+BEGIN_SRC elisp
+  ;; Narrows buffer to undecoded body, e.g. for binary files.
+  (plz-get url
+    :with 'buffer-undecoded  ; `buffer-binary'?
+    :then (lambda (buffer)
+            (with-current-buffer buffer
+              (setf binary-content (buffer-substring (point-min) 
(point-max))))))
+#+END_SRC
+
+**** Callback with point at body start
+:PROPERTIES:
+:ID:       1795462e-01bc-4f0b-97ab-3c1b2e75485c
+:END:
+
+Assuming that =plz= has already called =decode-coding-region=, this is 
straightforward, but the caller shouldn't have to do this extra work.
+
+#+BEGIN_SRC elisp
+  (plz-get url
+    :then (lambda (buffer)
+            (buffer-substring (point) (point-max))))
+#+END_SRC
+
+*** Body parsed with function
+
+#+BEGIN_SRC elisp
+  ;; Narrows buffer to body, decodes it, calls callback with result of 
`json-read'.
+  (plz-get url
+    :with #'json-read
+    :then (lambda (json)
+            (setf something (alist-get 'key json))))
+#+END_SRC
+
+#+BEGIN_SRC elisp
+  ;; Narrows buffer to body, decodes it, parses with
+  ;; `libxml-parse-html-region', calls callback with DOM.
+  (plz-get url
+    :with (lambda ()
+            (libxml-parse-html-region (point-min) (point-max) url))
+    :then (lambda (dom)
+            (with-current-buffer (generate-new-buffer "*plz-browse*")
+              (shr-insert-document dom))))
+#+END_SRC
+
+*** HTTP response with headers
diff --git a/plz.el b/plz.el
index 1af1de35de..d744e1b76b 100644
--- a/plz.el
+++ b/plz.el
@@ -141,10 +141,10 @@
 
 ;;;; Variables
 
-(defvar-local plz-error nil
+(defvar-local plz-else nil
   "Callback function for errored completion of request in current curl process 
buffer.")
 
-(defvar-local plz-success nil
+(defvar-local plz-then nil
   "Callback function for successful completion of request in current curl 
process buffer.")
 
 ;;;; Customization
@@ -172,39 +172,49 @@
 
 ;;;; Functions
 
-(cl-defun plz-get (url &key headers sync success error
-                       (connect-timeout plz-connect-timeout))
+(cl-defun plz-get (url &key headers as then
+                       (connect-timeout plz-connect-timeout)
+                       (decode t))
   "Get HTTP URL with curl.
-If SYNC is non-nil, return the response object; otherwise, return
-the curl process object.
+
+FIXME: Docstring.
 
 HEADERS may be an alist of extra headers to send with the
 request.  CONNECT-TIMEOUT may be a number of seconds to timeout
-the initial connection attempt.
-
-For asynchronous requests, SUCCESS and ERROR should be callback
-functions, called when the curl process finishes with a single
-argument: the `plz-response' object."
+the initial connection attempt."
+  (declare (indent defun))
   (plz--request 'get url
-                :sync sync
                 :headers headers
                 :connect-timeout connect-timeout
-                :success success
-                :error error))
+                :decode decode
+                :as as :then then))
+
+(cl-defun plz-get-sync (url &key headers as
+                            (connect-timeout plz-connect-timeout)
+                            (decode t))
+  "Get HTTP URL with curl synchronously.
 
-(cl-defun plz--request (_method url &key headers connect-timeout sync
-                                success error)
-  "Return process or response for HTTP request to URL.
-If SYNC is non-nil, return the response object; otherwise, return
-the curl process object.
+FIXME: Docstring.
 
 HEADERS may be an alist of extra headers to send with the
 request.  CONNECT-TIMEOUT may be a number of seconds to timeout
-the initial connection attempt.
+the initial connection attempt."
+  (declare (indent defun))
+  (plz--request-sync 'get url
+                     :headers headers
+                     :connect-timeout connect-timeout
+                     :decode decode
+                     :as as))
+
+(cl-defun plz--request (_method url &key headers connect-timeout
+                                decode as then)
+  "Return curl process for HTTP request to URL.
+
+FIXME: Docstring.
 
-For asynchronous requests, SUCCESS and ERROR should be callback
-functions, called when the curl process finishes with a single
-argument: the `plz-response' object."
+HEADERS may be an alist of extra headers to send with the
+request.  CONNECT-TIMEOUT may be a number of seconds to timeout
+the initial connection attempt."
   ;; Inspired by and copied from `elfeed-curl-retrieve'.
   (let* ((coding-system-for-read 'binary)
          (process-connection-type nil)
@@ -214,35 +224,74 @@ argument: the `plz-response' object."
                             (when connect-timeout
                               (list "--connect-timeout" (number-to-string 
connect-timeout)))
                             (list url))))
-    (pcase sync
-      (`nil (plz-request--async curl-args :success success :error error))
-      (_ (plz-request--sync curl-args :success success :error error)))))
-
-(cl-defun plz-request--async (curl-args &key success error)
-  "Return process object for curl called with CURL-ARGS.
-SUCCESS and ERROR should be callback functions, called when the
-curl process finishes with a single argument: the `plz-response'
-object.  Uses `make-process' to call curl asynchronously."
-  (with-current-buffer (generate-new-buffer " *plz-request-curl*")
-    (let ((process (make-process :name "plz-request-curl"
-                                 :buffer (current-buffer)
-                                 :command (append (list plz-curl-program) 
curl-args)
-                                 :connection-type 'pipe
-                                 :sentinel #'plz--sentinel
-                                 :stderr (current-buffer))))
-      (setf plz-success success
-            plz-error error)
-      process)))
-
-(cl-defun plz-request--sync (curl-args &key success error)
-  "Return HTTP response object for curl called with CURL-ARGS.
+    (with-current-buffer (generate-new-buffer " *plz-request-curl*")
+      (let ((process (make-process :name "plz-request-curl"
+                                   :buffer (current-buffer)
+                                   :command (append (list plz-curl-program) 
curl-args)
+                                   :connection-type 'pipe
+                                   :sentinel #'plz--sentinel
+                                   :stderr (current-buffer)))
+            ;; The THEN function is called in the response buffer.
+            (then (pcase-exhaustive as
+                    ('string (lambda ()
+                               (let ((coding-system (or (plz--coding-system) 
'utf-8)))
+                                 (plz--narrow-to-body)
+                                 (when decode
+                                   (decode-coding-region (point) (point-max) 
coding-system))
+                                 (funcall then (buffer-string)))))
+                    ('buffer (lambda ()
+                               (funcall then (current-buffer))))
+                    ('response (lambda ()
+                                 (funcall then (plz--response))))
+                    ((pred functionp) (lambda ()
+                                        (let ((coding-system (or 
(plz--coding-system) 'utf-8)))
+                                          (plz--narrow-to-body)
+                                          (when decode
+                                            (decode-coding-region (point) 
(point-max) coding-system))
+                                          (funcall then (funcall as))))))))
+        (setf plz-then then)
+        process))))
+
+(cl-defun plz--request-sync (_method url &key headers connect-timeout
+                                     decode as)
+  "Return HTTP response for curl called with CURL-ARGS.
+FIXME: Docstring.
 Uses `call-process' to call curl synchronously."
   (with-current-buffer (generate-new-buffer " *plz-request-curl*")
-    (let ((status (apply #'call-process plz-curl-program nil t nil
-                         curl-args))
-          (plz-success #'identity))
+    (let* ((coding-system-for-read 'binary)
+           (process-connection-type nil)
+           (header-args (cl-loop for (key . value) in headers
+                                 collect (format "--header %s: %s" key value)))
+           (curl-args (append plz-curl-default-args header-args
+                              (when connect-timeout
+                                (list "--connect-timeout" (number-to-string 
connect-timeout)))
+                              (list url)))
+           (status (apply #'call-process plz-curl-program nil t nil
+                          curl-args))
+           ;; THEn form copied from `plz--request'.
+           ;; TODO: DRY this.  Maybe we could use a thread and a condition 
variable, but...
+           (plz-then (pcase-exhaustive as
+                       ('string (lambda ()
+                                  (let ((coding-system (or 
(plz--coding-system) 'utf-8)))
+                                    (plz--narrow-to-body)
+                                    (when decode
+                                      (decode-coding-region (point) 
(point-max) coding-system))
+                                    (buffer-string))))
+                       ('response #'plz--response)
+                       ((pred functionp) (lambda ()
+                                           (let ((coding-system (or 
(plz--coding-system) 'utf-8)))
+                                             (plz--narrow-to-body)
+                                             (when decode
+                                               (decode-coding-region (point) 
(point-max) coding-system))
+                                             (funcall as)))))))
       (plz--sentinel (current-buffer) status))))
 
+(defun plz--narrow-to-body ()
+  "Narrow to body of HTTP response in current buffer."
+  (goto-char (point-min))
+  (re-search-forward "^\r\n" nil)
+  (narrow-to-region (point) (point-max)))
+
 (defun plz--sentinel (process-or-buffer status)
   "Process buffer of curl output in PROCESS-OR-BUFFER.
 If PROCESS-OR-BUFFER if a process, uses its buffer; if a buffer,
@@ -256,13 +305,12 @@ node `(elisp) Sentinels').  Kills the buffer before 
returning."
         (with-current-buffer buffer
           (pcase status
             ((or 0 "finished\n")
-             ;; Request completed successfully: call success callback with 
parsed response.
-             (let ((response (plz--response buffer)))
-               (funcall plz-success response)))
+             ;; Request completed successfully: call THEN.
+             (funcall plz-then))
 
+            ;; FIXME: Implement error callback handling.
             ((rx "exited abnormally with code " (group (1+ digit)))
              ;; Error: call error callback.
-             ;; FIXME: Call with an error struct.
              (warn "plz--sentinel: ERROR: %s" (buffer-string))
              ;; (let* ((code (string-to-number (match-string 1 status)))
              ;;        (message (alist-get code plz-curl-errors)))
@@ -270,50 +318,56 @@ node `(elisp) Sentinels').  Kills the buffer before 
returning."
              )))
       (kill-buffer buffer))))
 
-(defun plz--response (buffer)
-  "Return response struct for HTTP response in BUFFER."
-  (with-current-buffer buffer
-    (save-excursion
-      (goto-char (point-min))
-      ;; Parse HTTP version and status code.
-      (looking-at (rx "HTTP/" (group (1+ (or digit "."))) (1+ blank)
-                      (group (1+ digit))))
-      (let* ((http-version (string-to-number (match-string 1)))
-             (status-code (string-to-number (match-string 2)))
-             (headers (plz--headers buffer))
-             (coding-system (or (when-let* ((it (alist-get "Content-Type" 
headers nil nil #'string=)))
-                                  (coding-system-from-name it))
-                                'utf-8))
-             (body (plz--decode-body buffer coding-system)))
-        (make-plz-response
-         :version http-version
-         :status status-code
-         :headers headers
-         :body body)))))
-
-(defun plz--headers (buffer)
-  "Return headers alist for HTTP response in BUFFER."
-  (with-current-buffer buffer
-    (save-excursion
-      (goto-char (point-min))
-      (forward-line 1)
-      (let ((limit (save-excursion
-                     (re-search-forward "^\r\n" nil)
-                     (point))))
-        (cl-loop while (re-search-forward (rx bol (group (1+ (not (in ":")))) 
":" (1+ blank)
-                                              (group (1+ (not (in "\r\n")))))
-                                          limit t)
-                 collect (cons (match-string 1) (match-string 2)))))))
-
-(defun plz--decode-body (buffer coding-system)
-  "Return decoded body for HTTP response in BUFFER.
-Decodes with `decode-coding-region' according to CODING-SYSTEM."
-  (with-current-buffer buffer
-    (save-excursion
-      (goto-char (point-min))
-      ;; Skip headers.
-      (re-search-forward "^\r\n" nil)
-      (decode-coding-region (point) (point-max) coding-system t))))
+(defun plz--response ()
+  "Return response struct for HTTP response in current buffer."
+  (save-excursion
+    (goto-char (point-min))
+    ;; Parse HTTP version and status code.
+    (looking-at (rx "HTTP/" (group (1+ (or digit "."))) (1+ blank)
+                    (group (1+ digit))))
+    (let* ((http-version (string-to-number (match-string 1)))
+           (status-code (string-to-number (match-string 2)))
+           (headers (plz--headers))
+           (coding-system (or (plz--coding-system headers) 'utf-8)))
+      (plz--narrow-to-body)
+      (decode-coding-region (point) (point-max) coding-system)
+      (make-plz-response
+       :version http-version
+       :status status-code
+       :headers headers
+       :body (buffer-string)))))
+
+(defun plz--coding-system (&optional headers)
+  "Return coding system for HTTP response in current buffer.
+HEADERS may optionally be an alist of parsed HTTP headers to
+refer to rather than the current buffer's unparsed headers."
+  (let* ((headers (or headers (plz--headers)))
+         (content-type (alist-get "Content-Type" headers nil nil #'string=)))
+    (when content-type
+      (coding-system-from-name content-type))))
+
+(defun plz--headers ()
+  "Return headers alist for HTTP response in current buffer"
+  (save-excursion
+    (goto-char (point-min))
+    (forward-line 1)
+    (let ((limit (save-excursion
+                   (re-search-forward "^\r\n" nil)
+                   (point))))
+      (cl-loop while (re-search-forward (rx bol (group (1+ (not (in ":")))) 
":" (1+ blank)
+                                            (group (1+ (not (in "\r\n")))))
+                                        limit t)
+               collect (cons (match-string 1) (match-string 2))))))
+
+(defun plz--decode-body (coding-system)
+  "Decode body for HTTP response in current buffer.
+Return length of decoded text.  Decodes with
+`decode-coding-region' according to CODING-SYSTEM."
+  (save-excursion
+    (goto-char (point-min))
+    ;; Skip headers.
+    (re-search-forward "^\r\n" nil)
+    (decode-coding-region (point) (point-max) coding-system)))
 
 ;;;; Footer
 
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 7551a91e41..74f400fa30 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -55,18 +55,77 @@
 
 ;;;; Tests
 
-(ert-deftest plz-get-async nil
-  (let* ((test-response)
-         (process (plz-get "https://httpbin.org/get";
-                           :success (lambda (response)
-                                      (setf test-response response)))))
-    (cl-loop for i upto 100 ;; 10 seconds
-             while (equal 'run (process-status process))
-             do (sleep-for 0.1))
-    (plz-test-get-response test-response)))
-
-(ert-deftest plz-get-sync nil
-  (plz-test-get-response (plz-get "https://httpbin.org/get"; :sync t)))
+;;;;; Async
+
+(ert-deftest plz-get-string nil
+  (should (let* ((test-string)
+                 (process (plz-get "https://httpbin.org/get";
+                            :as 'string
+                            :then (lambda (string)
+                                    (setf test-string string)))))
+            (cl-loop for i upto 100 ;; 10 seconds
+                     while (equal 'run (process-status process))
+                     do (sleep-for 0.1))
+            (string-match "curl" test-string))))
+
+(ert-deftest plz-get-buffer nil
+  ;; The sentinel kills the buffer, so we get the buffer as a string.
+  (should (let* ((test-buffer-string)
+                 (process (plz-get "https://httpbin.org/get";
+                            :as 'buffer
+                            :then (lambda (buffer)
+                                    (with-current-buffer buffer
+                                      (setf test-buffer-string 
(buffer-string)))))))
+            (cl-loop for i upto 100 ;; 10 seconds
+                     while (equal 'run (process-status process))
+                     do (sleep-for 0.1))
+            (string-match "curl" test-buffer-string))))
+
+(ert-deftest plz-get-response nil
+  (should (let* ((test-response)
+                 (process (plz-get "https://httpbin.org/get";
+                            :as 'response
+                            :then (lambda (response)
+                                    (setf test-response response)))))
+            (cl-loop for i upto 100 ;; 10 seconds
+                     while (equal 'run (process-status process))
+                     do (sleep-for 0.1))
+            (plz-test-get-response test-response))))
+
+(ert-deftest plz-get-json nil
+  (should (let* ((test-json)
+                 (process (plz-get "https://httpbin.org/get";
+                            :as #'json-read
+                            :then (lambda (json)
+                                    (setf test-json json)))))
+            (cl-loop for i upto 100 ;; 10 seconds
+                     while (equal 'run (process-status process))
+                     do (sleep-for 0.1))
+            (let* ((headers (alist-get 'headers test-json))
+                   (user-agent (alist-get 'User-Agent headers nil nil 
#'equal)))
+              (string-match "curl" user-agent)))))
+
+;;;;; Sync
+
+(ert-deftest plz-get-sync-string nil
+  (should (string-match "curl" (plz-get-sync "https://httpbin.org/get";
+                                 :as 'string))))
+
+(ert-deftest plz-get-sync-response nil
+  (should (plz-test-get-response (plz-get-sync "https://httpbin.org/get";
+                                   :as 'response))))
+
+(ert-deftest plz-get-sync-json nil
+  (should (let* ((test-json (plz-get-sync "https://httpbin.org/get";
+                              :as #'json-read))
+                 (headers (alist-get 'headers test-json))
+                 (user-agent (alist-get 'User-Agent headers nil nil #'equal)))
+            (string-match "curl" user-agent))))
+
+(ert-deftest plz-get-sync-buffer nil
+  ;; `buffer' is not a valid type for `plz-get-sync'.
+  (should-error (plz-get-sync "https://httpbin.org/get";
+                  :as 'buffer)))
 
 ;;;; Footer