branch: externals/plz
commit 6a21c7e809e3f23a983e1f50346f55008f79415f
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@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
