[elpa] externals/plz 897c5bbfb2 13/81: Improvements, error handling

[ELPA Syncer]

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

    Improvements, error handling
---
 plz.el            | 69 +++++++++++++++++++++++++++++++++++++++----------------
 tests/test-plz.el | 22 +++++++++++++++++-
 2 files changed, 70 insertions(+), 21 deletions(-)

diff --git a/plz.el b/plz.el
index d744e1b76b..0b189d07b9 100644
--- a/plz.el
+++ b/plz.el
@@ -51,13 +51,27 @@
 (require 'rx)
 (require 'subr-x)
 
+;;;; Errors
+
+;; FIXME: `condition-case' can't catch these...?
+(define-error 'plz-curl-error "Curl error")
+(define-error 'plz-http-error "HTTP error")
+
 ;;;; Structs
 
 (cl-defstruct plz-response
   version status headers body)
 
+(cl-defstruct plz-error
+  curl-error response)
+
 ;;;; Constants
 
+(defconst plz-http-response-status-line-regexp
+  (rx "HTTP/" (group (1+ (or digit "."))) (1+ blank)
+      (group (1+ digit)))
+  "Regular expression matching HTTP response status line.")
+
 (defconst plz-curl-errors
   ;; Copied from elfeed-curl.el.
   '((1 . "Unsupported protocol.")
@@ -172,7 +186,7 @@
 
 ;;;; Functions
 
-(cl-defun plz-get (url &key headers as then
+(cl-defun plz-get (url &key headers as then else
                        (connect-timeout plz-connect-timeout)
                        (decode t))
   "Get HTTP URL with curl.
@@ -187,7 +201,7 @@ the initial connection attempt."
                 :headers headers
                 :connect-timeout connect-timeout
                 :decode decode
-                :as as :then then))
+                :as as :then then :else else))
 
 (cl-defun plz-get-sync (url &key headers as
                             (connect-timeout plz-connect-timeout)
@@ -207,7 +221,7 @@ the initial connection attempt."
                      :as as))
 
 (cl-defun plz--request (_method url &key headers connect-timeout
-                                decode as then)
+                                decode as then else)
   "Return curl process for HTTP request to URL.
 
 FIXME: Docstring.
@@ -216,9 +230,7 @@ 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)
-         (header-args (cl-loop for (key . value) in headers
+  (let* ((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
@@ -227,6 +239,7 @@ the initial connection attempt."
     (with-current-buffer (generate-new-buffer " *plz-request-curl*")
       (let ((process (make-process :name "plz-request-curl"
                                    :buffer (current-buffer)
+                                   :coding 'binary
                                    :command (append (list plz-curl-program) 
curl-args)
                                    :connection-type 'pipe
                                    :sentinel #'plz--sentinel
@@ -249,7 +262,8 @@ the initial connection attempt."
                                           (when decode
                                             (decode-coding-region (point) 
(point-max) coding-system))
                                           (funcall then (funcall as))))))))
-        (setf plz-then then)
+        (setf plz-then then
+              plz-else else)
         process))))
 
 (cl-defun plz--request-sync (_method url &key headers connect-timeout
@@ -305,26 +319,41 @@ node `(elisp) Sentinels').  Kills the buffer before 
returning."
         (with-current-buffer buffer
           (pcase status
             ((or 0 "finished\n")
-             ;; 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.
-             (warn "plz--sentinel: ERROR: %s" (buffer-string))
-             ;; (let* ((code (string-to-number (match-string 1 status)))
-             ;;        (message (alist-get code plz-curl-errors)))
-             ;;   (funcall plz-error (plz--response buffer)))
-             )))
+             ;; Curl exited normally: check HTTP status code.
+             (pcase (plz--http-status)
+               (200 (funcall plz-then))
+               (_ (let ((err (make-plz-error :response (plz--response))))
+                    (pcase-exhaustive plz-else
+                      (`nil (signal 'plz-http-error err))
+                      ((pred functionp) (funcall plz-else err)))))))
+
+            ((or (and (pred numberp) code)
+                 (rx "exited abnormally with code " (let code (group (1+ 
digit)))))
+             ;; Curl error.
+             (let* ((curl-exit-code (cl-typecase code
+                                      (string (string-to-number code))
+                                      (number code)))
+                    (curl-error-message (alist-get curl-exit-code 
plz-curl-errors))
+                    (err (make-plz-error :curl-error (cons curl-exit-code 
curl-error-message))))
+               (pcase-exhaustive plz-else
+                 (`nil (signal 'plz-curl-error err))
+                 ((pred functionp) (funcall plz-else err)))))))
       (kill-buffer buffer))))
 
+(defun plz--http-status ()
+  "Return HTTP status code for HTTP response in current buffer.
+Assumes point is at beginning of buffer."
+  (save-excursion
+    (goto-char (point-min))
+    (when (looking-at plz-http-response-status-line-regexp)
+      (string-to-number (match-string 2)))))
+
 (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))))
+    (looking-at plz-http-response-status-line-regexp)
     (let* ((http-version (string-to-number (match-string 1)))
            (status-code (string-to-number (match-string 2)))
            (headers (plz--headers))
diff --git a/tests/test-plz.el b/tests/test-plz.el
index 74f400fa30..a5d468a399 100644
--- a/tests/test-plz.el
+++ b/tests/test-plz.el
@@ -109,7 +109,8 @@
 
 (ert-deftest plz-get-sync-string nil
   (should (string-match "curl" (plz-get-sync "https://httpbin.org/get";
-                                 :as 'string))))
+                                 :as 'string)))
+  (should (string-match "curl" (plz-get-sync "https://httpbin.org/get";))))
 
 (ert-deftest plz-get-sync-response nil
   (should (plz-test-get-response (plz-get-sync "https://httpbin.org/get";
@@ -127,6 +128,25 @@
   (should-error (plz-get-sync "https://httpbin.org/get";
                   :as 'buffer)))
 
+;;;;; Errors
+
+(ert-deftest plz-get-curl-error nil
+  (let ((err (should-error (plz-get-sync 
"https://httpbinnnnnn.org/get/status/404";
+                             :as 'string)
+                           :type 'plz-curl-error)))
+    (should (and (eq 'plz-curl-error (car err))
+                 (plz-error-p (cdr err))
+                 (equal '(6 . "Couldn't resolve host. The given remote host 
was not resolved.") (plz-error-curl-error (cdr err)))))))
+
+(ert-deftest plz-get-404-error nil
+  (let ((err (should-error (plz-get-sync "https://httpbin.org/get/status/404";
+                             :as 'string)
+                           :type 'plz-http-error)))
+    (should (and (eq 'plz-http-error (car err))
+                 (plz-error-p (cdr err))
+                 (plz-response-p (plz-error-response (cdr err)))
+                 (eq 404 (plz-response-status (plz-error-response (cdr 
err))))))))
+
 ;;;; Footer
 
 (provide 'test-plz)