emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/llm 2a0651adc2 22/71: Merge pull request #29 from r0man


From: ELPA Syncer
Subject: [elpa] externals/llm 2a0651adc2 22/71: Merge pull request #29 from r0man/plz
Date: Fri, 17 May 2024 00:58:44 -0400 (EDT)

branch: externals/llm
commit 2a0651adc27bfd36bfd24a63a042d9ef1fc518a3
Merge: f41c55a44e 62495de57f
Author: Andrew Hyatt <ahyatt@gmail.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #29 from r0man/plz
    
    Strip plz changes and add JSON array stream media type
---
 llm-openai.el       |   6 +-
 llm-request-plz.el  |  28 ++++-
 plz-event-source.el |  78 ++++++------
 plz-media-type.el   | 347 +++++++++++++++++++++++++++++++++++-----------------
 plz.el              |  13 +-
 5 files changed, 309 insertions(+), 163 deletions(-)

diff --git a/llm-openai.el b/llm-openai.el
index 71280cacd2..17eb3ce448 100644
--- a/llm-openai.el
+++ b/llm-openai.el
@@ -258,7 +258,9 @@ PROMPT is the prompt that needs to be updated with the 
response."
   "Return the text in the partial chat response from RESPONSE.
 RESPONSE can be nil if the response is complete."
   (when response
-    (let* ((delta (assoc-default 'delta (aref (assoc-default 'choices 
response) 0)))
+    (let* ((choices (assoc-default 'choices response))
+           (delta (when (> (length choices) 0)
+                    (assoc-default 'delta (aref choices 0))))
            (content-or-call (or (assoc-default 'content delta)
                                 (assoc-default 'tool_calls delta))))
       (when content-or-call
@@ -312,7 +314,7 @@ RESPONSE can be nil if the response is complete."
                       buf error-callback 'error data))))
      :on-error (lambda (_ data)
                  (let ((errdata
-                        (cdr (assoc 'error (json-read-from-string data)))))
+                        (cdr (assoc 'error data))))
                    (llm-request-plz-callback-in-buffer
                     buf error-callback 'error
                     (format "Problem calling Open AI: %s message: %s"
diff --git a/llm-request-plz.el b/llm-request-plz.el
index 22b8d63aac..40b92c4518 100644
--- a/llm-request-plz.el
+++ b/llm-request-plz.el
@@ -93,7 +93,27 @@ TIMEOUT is the number of seconds to wait for a response."
                                    :data data
                                    :timeout timeout))
 
-(cl-defun llm-request-plz-async (url &key headers data on-success 
on-success-raw on-error 
+(defun llm-request-plz--handle-error (error on-error)
+  "Handle the ERROR with the ON-ERROR callback.
+
+For HTTP errors, ON-ERROR will be called with the HTTP status
+code and the HTTP body of the error response.
+
+For Curl errors, ON-ERROR will be called with the exit code of
+the curl process and an error message."
+  (cond ((plz-error-response error)
+         (let ((response (plz-error-response error)))
+           (funcall on-error
+                    (plz-response-status response)
+                    (plz-response-body response))))
+        ((plz-error-curl-error error)
+         (let ((curl-error (plz-error-curl-error error)))
+           (funcall on-error
+                    (car curl-error)
+                    (cdr curl-error))))
+        (t (user-error "Unexpected error: %s" error))))
+
+(cl-defun llm-request-plz-async (url &key headers data on-success 
on-success-raw on-error
                                      on-partial timeout)
   "Make a request to URL.
 Nothing will be returned.
@@ -133,7 +153,7 @@ the buffer is turned into JSON and passed to ON-SUCCESS."
               (funcall on-success (json-read-from-string response))))
     :else (lambda (error)
             (when on-error
-              (funcall on-error error)))
+              (llm-request-plz--handle-error error on-error)))
     :timeout (or timeout llm-request-plz-timeout)))
 
 (cl-defun llm-request-plz-event-stream (url &key headers data on-error 
on-success
@@ -162,7 +182,7 @@ This is required.
     'post url
     :as `(media-types
           ,(cons
-            (cons "text/event-stream"
+            (cons 'text/event-stream
                   (plz-media-type:text/event-stream
                    ;; Convert so that each event handler gets the body, not the
                    ;; `plz-response' itself.
@@ -182,7 +202,7 @@ This is required.
               (funcall on-success (plz-response-body response))))
     :else (lambda (error)
             (when on-error
-              (funcall on-error error)))
+              (llm-request-plz--handle-error error on-error)))
     :timeout (or timeout llm-request-plz-timeout)))
 
 ;; This is a useful method for getting out of the request buffer when it's time
diff --git a/plz-event-source.el b/plz-event-source.el
index c72e7bb7fa..0bdb7ebf5e 100644
--- a/plz-event-source.el
+++ b/plz-event-source.el
@@ -371,7 +371,7 @@
   "Return the media types of the event SOURCE."
   (with-slots (handlers) source
     (let ((media-type (plz-media-type:text/event-stream :events handlers)))
-      (cons (cons "text/event-stream" media-type) plz-media-types))))
+      (cons (cons 'text/event-stream media-type) plz-media-types))))
 
 (cl-defmethod plz-event-source-open ((source plz-http-event-source))
   "Open a connection to the URL of the event SOURCE."
@@ -401,18 +401,19 @@
 ;; Content Type: text/event-stream
 
 (defclass plz-media-type:text/event-stream 
(plz-media-type:application/octet-stream)
-  ((name :initform "text/event-stream")
+  ((type :initform 'text)
+   (subtype :initform 'event-stream)
    (events :documentation "Association list from event type to handler."
-           :initarg :events)))
+           :initarg :events
+           :initform nil
+           :type list)))
 
-(defun plz-media-type:text/event-stream--event-source (response)
-  "Return the event source of the RESPONSE."
-  (process-get (plz-response-process response) :plz-event-source))
+(defvar-local plz-event-source--current nil
+  "The event source of the current buffer.")
 
 (cl-defmethod plz-media-type-else ((_ plz-media-type:text/event-stream) error)
   "Transform the ERROR into a format suitable for MEDIA-TYPE."
-  (let* ((response (plz-error-response error))
-         (source (plz-media-type:text/event-stream--event-source response))
+  (let* ((source plz-event-source--current)
          (event (plz-event-source-event :type "error" :data error)))
     (plz-event-source-close source)
     (plz-event-source-dispatch-event source event)
@@ -420,39 +421,36 @@
 
 (cl-defmethod plz-media-type-process ((media-type 
plz-media-type:text/event-stream) process chunk)
   "Process the CHUNK according to MEDIA-TYPE using PROCESS."
-  (when (buffer-live-p (process-buffer process))
-    (with-current-buffer (process-buffer process)
-      (unless (process-get process :plz-event-source)
-        (let* ((response (make-plz-response
-                          :status (plz-response-status chunk)
-                          :headers (plz-response-headers chunk)))
-               (source (plz-event-source-open
-                        (plz-buffer-event-source
-                         :buffer (buffer-name (process-buffer process))
-                         :handlers (seq-map
-                                    (lambda (pair)
-                                      (let ((type (car pair))
-                                            (handler (cdr pair)))
-                                        (cond
-                                         ((equal "open" type)
-                                          (cons type (lambda (source event)
-                                                       (setf (oref event data) 
response)
-                                                       (funcall handler source 
event))))
-                                         ((equal "close" type)
-                                          (cons type (lambda (source event)
-                                                       (setf (oref event data) 
response)
-                                                       (funcall handler source 
event))))
-                                         (t pair))))
-                                    (oref media-type events))))))
-          (process-put process :plz-event-source source)))
-      (plz-event-source-insert (process-get process :plz-event-source)
-                               (plz-response-body chunk)))))
-
-(cl-defmethod plz-media-type-then ((_ plz-media-type:text/event-stream) 
response)
+  (unless plz-event-source--current
+    (let* ((response (make-plz-response
+                      :status (plz-response-status chunk)
+                      :headers (plz-response-headers chunk)))
+           (source (plz-event-source-open
+                    (plz-buffer-event-source
+                     :buffer (buffer-name (process-buffer process))
+                     :handlers (seq-map
+                                (lambda (pair)
+                                  (let ((type (car pair))
+                                        (handler (cdr pair)))
+                                    (cond
+                                     ((equal "open" type)
+                                      (cons type (lambda (source event)
+                                                   (setf (oref event data) 
response)
+                                                   (funcall handler source 
event))))
+                                     ((equal "close" type)
+                                      (cons type (lambda (source event)
+                                                   (setf (oref event data) 
response)
+                                                   (funcall handler source 
event))))
+                                     (t pair))))
+                                (oref media-type events))))))
+      (setq-local plz-event-source--current source)))
+  (plz-event-source-insert plz-event-source--current (plz-response-body chunk))
+  (set-marker (process-mark process) (point)))
+
+(cl-defmethod plz-media-type-then ((media-type 
plz-media-type:text/event-stream) response)
   "Transform the RESPONSE into a format suitable for MEDIA-TYPE."
-  (let ((source (plz-media-type:text/event-stream--event-source response)))
-    (plz-event-source-close source)
-    response))
+  (plz-event-source-close plz-event-source--current)
+  (cl-call-next-method media-type response))
 
 (provide 'plz-event-source)
 ;;; plz-event-source.el ends here
diff --git a/plz-media-type.el b/plz-media-type.el
index 156bb75fd5..e7f13f8a87 100644
--- a/plz-media-type.el
+++ b/plz-media-type.el
@@ -34,12 +34,38 @@
 (require 'eieio)
 (require 'plz)
 
-(defclass plz:media-type ()
-  ((name
-    :documentation "The MIME Type of the handler."
-    :initarg :name
-    :initform "application/octet-stream"
-    :type string)))
+(defclass plz-media-type ()
+  ((type
+    :documentation "The media type."
+    :initarg :type
+    :type symbol)
+   (subtype
+    :documentation "The media subtype."
+    :initarg :subtype
+    :subtype symbol)
+   (parameters
+    :documentation "The parameters of the media type."
+    :initarg :parameters
+    :initform nil
+    :subtype list)))
+
+(defun plz-media-type-charset (media-type)
+  "Return the character set of the MEDIA-TYPE."
+  (with-slots (parameters) media-type
+    (alist-get "charset" parameters nil nil #'equal)))
+
+(defun plz-media-type-coding-system (media-type)
+  "Return the coding system of the MEDIA-TYPE."
+  (coding-system-from-name (or (plz-media-type-charset media-type) "UTF-8")))
+
+(defun plz-media-type-name (media-type)
+  "Return the name of the MEDIA-TYPE as a string."
+  (with-slots (type subtype) media-type
+    (format "%s/%s" type subtype)))
+
+(defun plz-media-type-symbol (media-type)
+  "Return the name of the MEDIA-TYPE as a symbol."
+  (intern (plz-media-type-name media-type)))
 
 (cl-defgeneric plz-media-type-else (media-type error)
   "Transform the ERROR into a format suitable for MEDIA-TYPE.")
@@ -50,22 +76,52 @@
 (cl-defgeneric plz-media-type-process (media-type process chunk)
   "Process the CHUNK according to MEDIA-TYPE using PROCESS.")
 
+(defun plz-media-type-parse (header)
+  "Parse the Content-Type HEADER.
+
+Return a cons cell where the car is the MIME type, and the cdr is
+an alist of parameters."
+  (unless (or (null header) (string-blank-p header))
+    (let* ((components (split-string header ";"))
+           (mime-type (string-trim (car components)))
+           (parameters-list (cdr components))
+           (parameters-alist '()))
+      (dolist (param parameters-list parameters-alist)
+        (let* ((key-value (split-string param "="))
+               (key (string-trim (car key-value)))
+               (value (string-trim (cadr key-value) "\"")))
+          (setq parameters-alist (cons (cons key value) parameters-alist))))
+      (let ((parts (split-string mime-type "/")))
+        (plz-media-type
+         :type (intern (car parts))
+         :subtype (intern (cadr parts))
+         :parameters (nreverse parameters-alist))))))
+
 (defun plz-media-type--content-type (response)
   "Return the content type header of RESPONSE, or nil if it's not set."
   (let ((headers (plz-response-headers response)))
     (when-let (header (cdr (assoc 'content-type headers)))
-      (replace-regexp-in-string "\s*\\(;.*\\)?" "" header))))
+      (plz-media-type-parse header))))
 
 (defun plz-media--type-find (media-types media-type)
   "Lookup the MEDIA-TYPE in MEDIA-TYPES."
-  (or (alist-get media-type media-types nil nil #'equal)
+  (or (alist-get (plz-media-type-symbol media-type) media-types)
       (alist-get t media-types)
       (plz-media-type:application/octet-stream)))
 
 (defun plz-media-type--of-response (media-types response)
   "Lookup the content type of RESPONSE in MEDIA-TYPES."
   (let ((media-type (plz-media-type--content-type response)))
-    (plz-media--type-find media-types media-type)))
+    (clone (plz-media--type-find media-types media-type))))
+
+(defvar-local plz-media-type--current nil
+  "The media type of the process buffer.")
+
+(defvar-local plz-media-type--position nil
+  "The position in the process buffer.")
+
+(defvar-local plz-media-type--response nil
+  "The response of the process buffer.")
 
 (defun plz-media-type-process-filter (process media-types chunk)
   "The process filter that handles different content types.
@@ -79,9 +135,11 @@ CHUNK is a part of the HTTP body."
   (when (buffer-live-p (process-buffer process))
     (with-current-buffer (process-buffer process)
       (let ((moving (= (point) (process-mark process))))
-        (if-let (media-type (process-get process :plz-media-type))
-            (let ((response (process-get process :plz-media-type-response)))
-              (setf (plz-response-body response) chunk)
+        (if-let (media-type plz-media-type--current)
+            (let ((coding-system (plz-media-type-coding-system media-type))
+                  (response plz-media-type--response))
+              (setf (plz-response-body response)
+                    (decode-coding-string chunk coding-system))
               (plz-media-type-process media-type process response))
           (progn
             (save-excursion
@@ -93,22 +151,26 @@ CHUNK is a part of the HTTP body."
               (let ((body-start (point)))
                 (goto-char (point-min))
                 (let* ((response (prog1 (plz--response) (widen)))
-                       (media-type (plz-media-type--of-response media-types 
response)))
-                  (process-put process :plz-media-type media-type)
+                       (media-type (plz-media-type--of-response media-types 
response))
+                       (coding-system (plz-media-type-coding-system 
media-type)))
+                  (setq-local plz-media-type--current media-type)
                   (when-let (body (plz-response-body response))
                     (when (> (length body) 0)
+                      (setf (plz-response-body response)
+                            (decode-coding-string body coding-system))
                       (delete-region body-start (point-max))
                       (set-marker (process-mark process) (point))
                       (plz-media-type-process media-type process response)))
                   (setf (plz-response-body response) nil)
-                  (process-put process :plz-media-type-response response))))))
+                  (setq-local plz-media-type--response response))))))
         (when moving
           (goto-char (process-mark process)))))))
 
 ;; Content Type: application/octet-stream
 
-(defclass plz-media-type:application/octet-stream (plz:media-type)
-  ((name :initform "application/octet-stream")))
+(defclass plz-media-type:application/octet-stream (plz-media-type)
+  ((type :initform 'application)
+   (subtype :initform 'octet-stream)))
 
 (cl-defmethod plz-media-type-else ((media-type 
plz-media-type:application/octet-stream) error)
   "Transform the ERROR into a format suitable for MEDIA-TYPE."
@@ -119,49 +181,114 @@ CHUNK is a part of the HTTP body."
 (cl-defmethod plz-media-type-then ((media-type 
plz-media-type:application/octet-stream) response)
   "Transform the RESPONSE into a format suitable for MEDIA-TYPE."
   (ignore media-type)
+  (setf (plz-response-body response) (buffer-string))
   response)
 
 (cl-defmethod plz-media-type-process ((media-type 
plz-media-type:application/octet-stream) process chunk)
   "Process the CHUNK according to MEDIA-TYPE using PROCESS."
   (ignore media-type)
-  (when (buffer-live-p (process-buffer process))
-    (with-current-buffer (process-buffer process)
-      (let ((moving (= (point) (process-mark process))))
-        (save-excursion
-          (goto-char (process-mark process))
-          (insert (plz-response-body chunk))
-          (set-marker (process-mark process) (point)))
-        (when moving
-          (goto-char (process-mark process)))))))
+  (save-excursion
+    (goto-char (process-mark process))
+    (insert (plz-response-body chunk))
+    (set-marker (process-mark process) (point))))
 
 ;; Content Type: application/json
 
 (defclass plz-media-type:application/json 
(plz-media-type:application/octet-stream)
-  ((name :initform "application/json")
-   (array-type :initform 'array)
-   (false-object :initform :json-false)
-   (null-object :initform nil)
-   (object-type :initform 'alist)))
+  ((subtype :initform 'json)
+   (array-type
+    :documentation "Specifies which Lisp type is used to represent arrays.  It 
can be
+`array' (the default) or `list'."
+    :initarg :array-type
+    :initform 'array
+    :type symbol)
+   (false-object
+    :documentation "Specifies which object to use to represent a JSON false 
value. It
+defaults to `:json-false'."
+    :initarg :false-object
+    :initform :json-false)
+   (null-object
+    :documentation "Specifies which object to use to represent a JSON null 
value.  It
+defaults to `nil`."
+    :initarg :null-object
+    :initform nil)
+   (object-type
+    :documentation "Specifies which Lisp type is used to represent objects.  
It can
+be `hash-table', `alist' (the default) or `plist'."
+    :initarg :object-type
+    :initform 'alist
+    :type symbol)))
+
+(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)) )
 
 (cl-defmethod plz-media-type-then ((media-type 
plz-media-type:application/json) response)
   "Transform the RESPONSE into a format suitable for MEDIA-TYPE."
-  (with-slots (array-type false-object null-object object-type) media-type
-    (setf (plz-response-body response)
-          (with-temp-buffer
-            (insert (plz-response-body response))
-            (goto-char (point-min))
-            (json-parse-buffer :array-type array-type
-                               :false-object false-object
-                               :null-object null-object
-                               :object-type object-type)))
-    response))
+  (setf (plz-response-body response) (plz-media-type--parse-json-object 
media-type))
+  response)
+
+;; Content Type: application/json (array of objects)
+
+(defclass plz-media-type:application/json-array 
(plz-media-type:application/json)
+  ((handler
+    :documentation "A function that will be called for each object in the JSON 
array."
+    :initarg :handler
+    :type (or function symbol))))
+
+(defun plz-media-type:application/json-array--parse-next (media-type)
+  "Parse a single line of the newline delimited JSON MEDIA-TYPE."
+  (cond ((looking-at "\\[")
+         (delete-char 1))
+        ((looking-at "[ ,\n\r]")
+         (delete-char 1))
+        ((looking-at "\\]")
+         (delete-char 1))
+        ((not (eobp))
+         (ignore-errors
+           (let ((begin (point)))
+             (prog1 (plz-media-type--parse-json-object media-type)
+               (delete-region begin (point))))))))
+
+(defun plz-media-type:application/json-array--parse-stream (media-type)
+  "Parse all lines of the newline delimited JSON MEDIA-TYPE in the PROCESS 
buffer."
+  (with-slots (handler) media-type
+    (unless plz-media-type--position
+      (setq-local plz-media-type--position (point)))
+    (goto-char plz-media-type--position)
+    (let ((object (plz-media-type:application/json-array--parse-next 
media-type)))
+      (setq-local plz-media-type--position (point))
+      (while object
+        (setq-local plz-media-type--position (point))
+        (when (functionp handler)
+          (funcall handler object))
+        (setq object (plz-media-type:application/json-array--parse-next 
media-type))))))
+
+(cl-defmethod plz-media-type-process ((media-type 
plz-media-type:application/json-array) process chunk)
+  "Process the CHUNK according to MEDIA-TYPE using PROCESS."
+  (ignore media-type)
+  (cl-call-next-method media-type process chunk)
+  (plz-media-type:application/json-array--parse-stream media-type))
+
+(cl-defmethod plz-media-type-then ((media-type 
plz-media-type:application/json-array) response)
+  "Transform the RESPONSE into a format suitable for MEDIA-TYPE."
+  (ignore media-type)
+  (plz-media-type:application/json-array--parse-stream media-type)
+  response)
 
 ;; Content Type: application/x-ndjson
 
 (defclass plz-media-type:application/x-ndjson (plz-media-type:application/json)
-  ((name :initform "application/x-ndjson")
-   (handler :documentation "The handler that will be called for each JSON 
object in the response."
-            :initarg :handler)))
+  ((subtype :initform 'x-ndjson)
+   (handler
+    :documentation "A function that will be called for each line that contains 
a JSON object."
+    :initarg :handler
+    :initform nil
+    :type (or function null symbol))))
 
 (defconst plz-media-type:application/x-ndjson--line-regexp
   (rx (* not-newline) (or "\r\n" "\n" "\r"))
@@ -170,66 +297,71 @@ CHUNK is a part of the HTTP body."
 (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)
-    (when-let (line (delete-and-extract-region (match-beginning 0) (match-end 
0)))
-      (with-slots (array-type false-object null-object object-type) media-type
-        (json-parse-string line
-                           :array-type array-type
-                           :false-object false-object
-                           :null-object null-object
-                           :object-type object-type)))))
-
-(defun plz-media-type:application/x-ndjson--parse-stream (media-type process)
+    (prog1 (plz-media-type--parse-json-object media-type)
+      (delete-region (match-beginning 0) (match-end 0)))))
+
+(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."
   (with-slots (handler) media-type
-    (goto-char (process-get process 
:plz-media-type:application/x-ndjson-position))
+    (unless plz-media-type--position
+      (setq-local plz-media-type--position (point)))
+    (goto-char plz-media-type--position)
     (when-let (object (plz-media-type:application/x-ndjson--parse-line 
media-type))
       (while object
-        (process-put process :plz-media-type:application/x-ndjson-position 
(point))
+        (setq-local plz-media-type--position (point))
         (when (functionp handler)
           (funcall handler object))
         (setq object (plz-media-type:application/x-ndjson--parse-line 
media-type))))))
 
 (cl-defmethod plz-media-type-process ((media-type 
plz-media-type:application/x-ndjson) process chunk)
   "Process the CHUNK according to MEDIA-TYPE using PROCESS."
-  (when (buffer-live-p (process-buffer process))
-    (with-current-buffer (process-buffer process)
-      (unless (process-get process 
:plz-media-type:application/x-ndjson-position)
-        (process-put process :plz-media-type:application/x-ndjson-position 
(point)))
-      (cl-call-next-method media-type process chunk)
-      (plz-media-type:application/x-ndjson--parse-stream media-type process))))
+  (cl-call-next-method media-type process chunk)
+  (plz-media-type:application/x-ndjson--parse-stream media-type))
 
 (cl-defmethod plz-media-type-then ((media-type 
plz-media-type:application/x-ndjson) response)
   "Transform the RESPONSE into a format suitable for MEDIA-TYPE."
-  (plz-media-type:application/x-ndjson--parse-stream media-type 
(plz-response-process response))
+  (plz-media-type:application/x-ndjson--parse-stream media-type)
   response)
 
 ;; Content Type: application/xml
 
 (defclass plz-media-type:application/xml 
(plz-media-type:application/octet-stream)
-  ((name :initform "application/xml")))
+  ((subtype :initform 'xml)))
 
 (cl-defmethod plz-media-type-then ((media-type plz-media-type:application/xml) 
response)
   "Transform the RESPONSE into a format suitable for MEDIA-TYPE."
   (with-slots (array-type false-object null-object object-type) media-type
-    (setf (plz-response-body response)
-          (with-temp-buffer
-            (insert (plz-response-body response))
-            (libxml-parse-html-region)))
+    (setf (plz-response-body response) (libxml-parse-html-region))
     response))
 
 ;; Content Type: text/html
 
 (defclass plz-media-type:text/html (plz-media-type:application/xml)
-  ((name :initform "text/html")))
+  ((type :initform 'text)
+   (subtype :initform 'xml)))
 
 (defvar plz-media-types
-  `(("application/json" . ,(plz-media-type:application/json))
-    ("application/octet-stream" . ,(plz-media-type:application/json))
-    ("application/xml" . ,(plz-media-type:application/xml))
-    ("text/html" . ,(plz-media-type:text/html))
+  `((application/json . ,(plz-media-type:application/json))
+    (application/octet-stream . ,(plz-media-type:application/octet-stream))
+    (application/xml . ,(plz-media-type:application/xml))
+    (text/html . ,(plz-media-type:text/html))
     (t . ,(plz-media-type:application/octet-stream)))
   "Alist from media type to content type.")
 
+(defun plz-media-type--handle-sync-error (media-types error)
+  "Handle the synchronous ERROR of type `plz-http-error' with MEDIA-TYPES."
+  (let* ((msg (cadr error))
+         (plzerror (caddr error)))
+    (signal (car error)
+            (let ((response (plz-error-response plzerror)))
+              (if-let (media-type (plz-media-type--of-response media-types 
response))
+                  (list msg (with-temp-buffer
+                              (when-let (body (plz-response-body response))
+                                (insert body)
+                                (goto-char (point-min)))
+                              (plz-media-type-else media-type plzerror)))
+                (cdr error))))))
+
 (cl-defun plz-media-type-request
     (method
      url
@@ -333,43 +465,40 @@ not.
   (if-let (media-types (pcase as
                          (`(media-types ,media-types)
                           media-types)))
-      (let* ((plz-curl-default-args (cons "--no-buffer" plz-curl-default-args))
-             (result (plz method url
-                       :as 'response
-                       :body body
-                       :body-type body-type
-                       :connect-timeout connect-timeout
-                       :decode decode
-                       :else (when (functionp else)
-                               (lambda (object)
-                                 (let* ((media-type 
(plz-media-type--of-response media-types (plz-error-response object)))
-                                        (object (plz-media-type-else 
media-type object)))
-                                   (funcall else object))))
-                       :finally (when (functionp finally)
-                                  (lambda () (funcall finally)))
-                       :headers headers
-                       :noquery noquery
-                       :process-filter (lambda (process chunk)
-                                         (plz-media-type-process-filter 
process media-types chunk))
-                       :timeout timeout
-                       :then (cond
-                              ((symbolp then) then)
-                              ((functionp then)
-                               (lambda (object)
-                                 (let* ((media-type 
(plz-media-type--of-response media-types object))
-                                        (object (plz-media-type-then 
media-type object)))
-                                   (funcall then object))))))))
-        ;; TODO: Handle sync event stream
-        (cond
-         ((processp result)
-          result)
-         ((plz-response-p result)
-          (let ((media-type (plz-media-type--of-response media-types result)))
-            (plz-media-type-then media-type result)))
-         ((plz-error-p result)
-          (let ((media-type (plz-media-type--of-response media-types 
(plz-error-response result))))
-            (plz-media-type-else media-type result)))
-         (t result)))
+      (condition-case error
+          (let* ((plz-curl-default-args (cons "--no-buffer" 
plz-curl-default-args))
+                 (result (plz method url
+                           :as 'buffer
+                           :body body
+                           :body-type body-type
+                           :connect-timeout connect-timeout
+                           :decode decode
+                           :else (when (functionp else)
+                                   (lambda (error)
+                                     (funcall else (plz-media-type-else
+                                                    plz-media-type--current
+                                                    error))))
+                           :finally (when (functionp finally)
+                                      (lambda () (funcall finally)))
+                           :headers headers
+                           :noquery noquery
+                           :process-filter (lambda (process chunk)
+                                             (plz-media-type-process-filter 
process media-types chunk))
+                           :timeout timeout
+                           :then (cond
+                                  ((symbolp then) then)
+                                  ((functionp then)
+                                   (lambda (_)
+                                     (funcall then (plz-media-type-then
+                                                    plz-media-type--current
+                                                    
plz-media-type--response))))))))
+            (cond ((bufferp result)
+                   (with-current-buffer result
+                     (plz-media-type-then plz-media-type--current 
plz-media-type--response)))
+                  ((processp result)
+                   result)
+                  (t (user-error "Unexpected response: %s" result))))
+        (plz-error (plz-media-type--handle-sync-error media-types error)))
     (apply #'plz (append (list method url) rest))))
 
 ;;;; Footer
diff --git a/plz.el b/plz.el
index 0739a20b04..69072063c7 100644
--- a/plz.el
+++ b/plz.el
@@ -110,7 +110,7 @@
 ;;;; Structs
 
 (cl-defstruct plz-response
-  version status headers body process)
+  version status headers body)
 
 (cl-defstruct plz-error
   curl-error response message)
@@ -439,7 +439,7 @@ NOQUERY is passed to `make-process', which see.
                         (decode-coding-region (point) (point-max) 
coding-system)))
                     (funcall then (current-buffer)))))
        ('response (lambda ()
-                    (funcall then (or (plz--response :decode-p decode :process 
process)
+                    (funcall then (or (plz--response :decode-p decode)
                                       (make-plz-error :message (format 
"response is nil for buffer:%S  buffer-string:%S"
                                                                        
process-buffer (buffer-string)))))))
        ('file (lambda ()
@@ -771,7 +771,7 @@ argument passed to `plz--sentinel', which see."
 
               ;; Any other status code is considered unsuccessful
               ;; (for now, anyway).
-              (let ((err (make-plz-error :response (plz--response :process 
process))))
+              (let ((err (make-plz-error :response (plz--response))))
                 (pcase-exhaustive (process-get process :plz-else)
                   (`nil (process-put process :plz-result err))
                   ((and (pred functionp) fn) (funcall fn err)))))))
@@ -837,13 +837,11 @@ Arguments are PROCESS and STATUS (ok, checkdoc?)."
     (or (re-search-forward "\r\n\r\n" nil t)
         (signal 'plz-http-error '("plz--response: End of redirect headers not 
found")))))
 
-(cl-defun plz--response (&key (decode-p t) process)
+(cl-defun plz--response (&key (decode-p t))
   "Return response structure for HTTP response in current buffer.
 When DECODE-P is non-nil, decode the response body automatically
 according to the apparent coding system.
 
-PROCESS is the curl process object that made the request.
-
 Assumes that point is at beginning of HTTP response."
   (save-excursion
     ;; Parse HTTP version and status code.
@@ -862,8 +860,7 @@ Assumes that point is at beginning of HTTP response."
        :version http-version
        :status status-code
        :headers headers
-       :body (buffer-string)
-       :process process))))
+       :body (buffer-string)))))
 
 (defun plz--coding-system (&optional headers)
   "Return coding system for HTTP response in current buffer.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]