branch: externals/plz-media-type
commit ab4dc6d6bdd40f951a714785984f7ff33550a762
Author: Roman Scherer <ro...@burningswell.com>
Commit: r0man <ro...@burningswell.com>
Raise an error if the response could not be processed completly
---
plz-media-type.el | 31 ++++++++++++++++++++-----------
tests/test-plz-media-type.el | 9 +++++++--
2 files changed, 27 insertions(+), 13 deletions(-)
diff --git a/plz-media-type.el b/plz-media-type.el
index bcf330e54c..291dacd7d6 100644
--- a/plz-media-type.el
+++ b/plz-media-type.el
@@ -308,6 +308,7 @@ body. It is used as the default media type processor.")
"Transform the RESPONSE into a format suitable for MEDIA-TYPE."
(ignore media-type)
(setf (plz-response-body response) (buffer-string))
+ (delete-region (point) (point-max))
response)
(cl-defmethod plz-media-type-process
@@ -358,10 +359,12 @@ accordingly.")
(defun plz-media-type--parse-json-object (media-type)
"Parse the JSON object in the current buffer according to MEDIA-TYPE."
(with-slots (array-type false-object null-object object-type) media-type
- (json-parse-buffer :array-type array-type
- :false-object false-object
- :null-object null-object
- :object-type object-type)) )
+ (let ((start (point)))
+ (prog1 (json-parse-buffer :array-type array-type
+ :false-object false-object
+ :null-object null-object
+ :object-type object-type)
+ (delete-region start (point))))))
(cl-defmethod plz-media-type-then
((media-type plz-media-type:application/json) response)
@@ -469,9 +472,7 @@ will always be set to nil.")
(defun plz-media-type:application/x-ndjson--parse-line (media-type)
"Parse a single line of the newline delimited JSON MEDIA-TYPE."
(when (looking-at plz-media-type:application/x-ndjson--line-regexp)
- (prog1 (plz-media-type--parse-json-object media-type)
- (when (< (match-beginning 0) (match-end 0))
- (delete-region (match-beginning 0) (match-end 0))))))
+ (plz-media-type--parse-json-object media-type)))
(defun plz-media-type:application/x-ndjson--parse-stream (media-type)
"Parse all lines of the newline delimited JSON MEDIA-TYPE in the PROCESS
buffer."
@@ -523,6 +524,7 @@ function.")
(with-slots (array-type false-object null-object object-type) media-type
(setf (plz-response-body response)
(libxml-parse-html-region (point-min) (point-max) nil))
+ (delete-region (point) (point-max))
response))
;; Content Type: text/html
@@ -745,10 +747,17 @@ not.
:then (if (symbolp then)
then
(lambda (_)
- (when (or (functionp then) (symbolp
then))
- (funcall then (plz-media-type-then
- plz-media-type--current
-
plz-media-type--response)))))))
+ (let ((response (plz-media-type-then
plz-media-type--current plz-media-type--response))
+ (content (string-trim
(buffer-substring (point) (point-max)))))
+ (if (zerop (length content))
+ (when (and (or (functionp then)
(symbolp then)))
+ (funcall then response))
+ (when (functionp else)
+ (setf (plz-response-body
response) content)
+ (funcall else (make-plz-error
+ :message (format
"Failed to parse response, %s byte%s unprocessed"
+
(length content) (if (= 1 (length content)) "" "s"))
+ :response
response)))))))))
(buffer (if (processp result) (process-buffer result)
result)))
(cond ((bufferp result)
(plz-media-type--handle-sync-response result))
diff --git a/tests/test-plz-media-type.el b/tests/test-plz-media-type.el
index 374f77e695..231112dbf5 100644
--- a/tests/test-plz-media-type.el
+++ b/tests/test-plz-media-type.el
@@ -274,9 +274,14 @@
:finally (lambda () (push t finally))
:then (lambda (object) (push object then)))))
(plz-media-type-test-wait process)
- (should (null else))
+ (should (equal 1 (length else)))
+ (let ((error (car else)))
+ (should (equal "Failed to parse response, 31 bytes unprocessed"
(plz-error-message error)))
+ (let ((response (plz-error-response error)))
+ (should (equal 200 (plz-response-status response)))
+ (should (equal "{\"model\":\"llama2\",\"created_at\":"
(plz-response-body response)))))
(should (equal '(t) finally))
- (should (equal 1 (length then)))
+ (should (null then))
(seq-doseq (response then)
(should (plz-response-p response))
(should (equal 200 (plz-response-status response)))
