branch: externals/llm
commit 2146ba3803a75ecf96ea75bd045a89be127cdcfa
Author: r0man <ro...@burningswell.com>
Commit: GitHub <nore...@github.com>
Change some function names and make most of them private (#42)
* Change some function names and make most of them private
* Add note that plz-media-type and plz-event-source are vendored
* Mention plz-media-type and plz-event-source are part of Emacs
---
plz-event-source.el | 112 ++++++++++++++++++++++++++--------------------------
plz-media-type.el | 77 +++++++++++++++++++++---------------
2 files changed, 100 insertions(+), 89 deletions(-)
diff --git a/plz-event-source.el b/plz-event-source.el
index d9a71a34e1..f54ed85a5c 100644
--- a/plz-event-source.el
+++ b/plz-event-source.el
@@ -11,6 +11,11 @@
;; This file is part of GNU Emacs.
+;; It is temporarily vendored within the llm library. Please DO NOT
+;; depend on it! It is subject to change. Once we think this package
+;; is stable, we will release it to GNU ELPA. If no serious issues
+;; are found, we plan to do this in Q4 of 2024.
+
;;; License:
;; This program is free software; you can redistribute it and/or modify
@@ -109,31 +114,31 @@
:type integer))
"The server sent event stream parser.")
-(defconst plz-event-source--end-of-line-regexp
+(defconst plz-event-source-parser--end-of-line-regexp
(rx (or "\r\n" "\n" "\r"))
"Regular expression matching the end of a line.")
-(defconst plz-event-source--line-regexp
+(defconst plz-event-source-parser--line-regexp
(rx (* not-newline) (or "\r\n" "\n" "\r"))
"Regular expression matching a line of the event source stream.")
-(defun plz-event-source--parse-bom (line)
+(defun plz-event-source-parser--parse-bom (line)
"Parse the Byte Order Mark (BOM) from LINE."
(if (string-prefix-p "\uFEFF" line)
(substring line 1)
line))
-(defun plz-event-source--looking-at-line-p ()
+(defun plz-event-source-parser--looking-at-line-p ()
"Return non-nil if the current line matches the event source line regexp."
- (looking-at plz-event-source--line-regexp))
+ (looking-at plz-event-source-parser--line-regexp))
-(defun plz-event-source--parse-line ()
+(defun plz-event-source-parser--parse-line ()
"Return non-nil if the current line matches the event source line regexp."
- (when (looking-at plz-event-source--line-regexp)
+ (when (looking-at plz-event-source-parser--line-regexp)
(string-trim-right (delete-and-extract-region (match-beginning 0)
(match-end 0))
- plz-event-source--end-of-line-regexp)))
+ plz-event-source-parser--end-of-line-regexp)))
-(defun plz-event-source--dispatch-event (parser)
+(defun plz-event-source-parser--dispatch-event (parser)
"Dispatch an event from PARSER to registered listeners."
(with-slots (data-buffer event-type-buffer events last-event-id
last-event-id-buffer) parser
(setf last-event-id last-event-id-buffer)
@@ -155,46 +160,39 @@
(setf events (cons event events))
event)))))
-(defun plz-event-source--process-event (parser field value)
+(defun plz-event-source-parser--process-event (parser field value)
"Process the FIELD and VALUE from PARSER as a event."
(ignore field)
(with-slots (event-type-buffer) parser
(setf event-type-buffer value)))
-(defun plz-event-source--process-data (parser field value)
+(defun plz-event-source-parser--process-data (parser field value)
"Process the FIELD and VALUE from PARSER as data."
(ignore field)
(with-slots (data-buffer) parser
(setf data-buffer (concat data-buffer value "\n"))))
-(defun plz-event-source--process-id (parser field value)
+(defun plz-event-source-parser--process-id (parser field value)
"Process the FIELD and VALUE from PARSER as event id."
(ignore field)
(unless (string-match "\u0000" value)
(with-slots (last-event-id-buffer) parser
(setf last-event-id-buffer value))))
-(defun plz-event-source--process-retry (parser field value)
- "Process the FIELD and VALUE from PARSER as event id."
- (ignore parser)
- (message "TODO: Process retry for field %s and value %s." field value))
-
(defun plz-event-source--process-field (parser field value)
"Process the FIELD and VALUE from PARSER."
(cond ((equal "event" field)
- (plz-event-source--process-event parser field value))
+ (plz-event-source-parser--process-event parser field value))
((equal "data" field)
- (plz-event-source--process-data parser field value))
+ (plz-event-source-parser--process-data parser field value))
((equal "id" field)
- (plz-event-source--process-id parser field value))
- ((equal "retry" field)
- (plz-event-source--process-retry parser field value))))
+ (plz-event-source-parser--process-id parser field value))))
-(defun plz-event-source--process-line (parser line)
+(defun plz-event-source-parser--process-line (parser line)
"Parse a LINE of the event stream PARSER and dispatch events."
(cond ((string-prefix-p ":" line))
((string-blank-p line)
- (plz-event-source--dispatch-event parser))
+ (plz-event-source-parser--dispatch-event parser))
((string-match ":" line)
(let ((field (substring line 0 (match-beginning 0)))
(value (substring line (match-end 0))))
@@ -204,33 +202,40 @@
value))))
(t (plz-event-source--process-field parser line ""))))
-(defun plz-event-source-parse-line (parser)
+(defun plz-event-source-parser--insert (parser string)
+ "Insert STRING into the buffer of the event PARSER."
+ (with-slots (buffer events position) parser
+ (with-current-buffer (get-buffer buffer)
+ (insert string)
+ (while (plz-event-source-parser-parse-line parser))
+ events)))
+
+(defun plz-event-source-parser--end-of-headers ()
+ "Return the end of headers position in the current buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (re-search-forward plz-http-end-of-headers-regexp nil t)
+ (point)))
+
+(defun plz-event-source-parser-parse-line (parser)
"Parse a line from the event stream in the PARSER buffer."
(with-slots (buffer position) parser
(with-current-buffer buffer
(save-excursion
(goto-char position)
- (when-let (line (plz-event-source--parse-line))
+ (when-let (line (plz-event-source-parser--parse-line))
(setf position (point))
- (plz-event-source--process-line parser line)
+ (plz-event-source-parser--process-line parser line)
line)))))
-(defun plz-event-source-parse-stream (parser)
+(defun plz-event-source-parser-parse (parser)
"Parse the event stream in the the PARSER buffer."
(with-slots (buffer handlers) parser
(with-current-buffer (get-buffer buffer)
(goto-char (point-min))
(while (not (eobp))
- (when-let (line (plz-event-source--parse-line))
- (plz-event-source--process-line parser line))))))
-
-(defun plz-event-source-parser-insert (parser string)
- "Insert STRING into the buffer of the event PARSER."
- (with-slots (buffer events position) parser
- (with-current-buffer (get-buffer buffer)
- (insert string)
- (while (plz-event-source-parse-line parser))
- events)))
+ (when-let (line (plz-event-source-parser--parse-line))
+ (plz-event-source-parser--process-line parser line))))))
;; Event Source
@@ -267,7 +272,7 @@
(cl-defgeneric plz-event-source-close (source)
"Close the event SOURCE.")
-(cl-defgeneric plz-event-source-insert (source data)
+(cl-defgeneric plz-event-source--insert (source data)
"Insert DATA into the event SOURCE buffer, parse and dispatch events.")
(defun plz-event-source-add-listener (source type listener)
@@ -285,7 +290,7 @@
handlers))
source))
-(defun plz-event-source-dispatch-event (source event)
+(defun plz-event-source--dispatch-event (source event)
"Dispatch the EVENT to the listeners of event SOURCE."
(with-slots (handlers) source
(dolist (pair handlers)
@@ -299,10 +304,10 @@
(list (cdr pair) event))
(timer-activate timer))))))
-(defun plz-event-source-dispatch-events (source events)
+(defun plz-event-source--dispatch-events (source events)
"Dispatch the EVENTS to the listeners of event SOURCE."
(dolist (event (reverse events))
- (plz-event-source-dispatch-event source event)))
+ (plz-event-source--dispatch-event source event)))
(defun plz-event-source--response-in-buffer-p ()
"Return non-nil the if point is looking at a HTTP response."
@@ -310,13 +315,6 @@
(goto-char (point-min))
(re-search-forward plz-http-end-of-headers-regexp nil t)))
-(defun plz-event-source-parser--end-of-headers ()
- "Return the end of headers position in the current buffer."
- (save-excursion
- (goto-char (point-min))
- (re-search-forward plz-http-end-of-headers-regexp nil t)
- (point)))
-
;; Buffer event source
(defclass plz-event-source-buffer (plz-event-source)
@@ -330,12 +328,12 @@
:type (or null plz-event-source-parser)))
"A server sent event source using curl for HTTP.")
-(cl-defmethod plz-event-source-insert ((source plz-event-source-buffer) data)
+(cl-defmethod plz-event-source--insert ((source plz-event-source-buffer) data)
"Insert DATA into the event SOURCE buffer, parse and dispatch events."
(with-slots (parser) source
- (plz-event-source-parser-insert parser data)
+ (plz-event-source-parser--insert parser data)
(with-slots (events) parser
- (plz-event-source-dispatch-events source events)
+ (plz-event-source--dispatch-events source events)
(setf events nil))))
(defun plz-event-source--buffer-start-position ()
@@ -355,7 +353,7 @@
:buffer buffer
:position (plz-event-source--buffer-start-position)))
(setf ready-state 'open)
- (plz-event-source-dispatch-event source event)
+ (plz-event-source--dispatch-event source event)
source))))
(cl-defmethod plz-event-source-close ((source plz-event-source-buffer))
@@ -363,7 +361,7 @@
(with-slots (buffer ready-state) source
(let ((event (plz-event-source-event :type 'close)))
(setf ready-state 'closed)
- (plz-event-source-dispatch-event source event)
+ (plz-event-source--dispatch-event source event)
source)))
(defclass plz-event-source-http (plz-event-source)
@@ -436,7 +434,7 @@ ELSE callbacks will always be set to nil.")
(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)
+ (plz-event-source--dispatch-event source event)
error))
(cl-defmethod plz-media-type-process ((media-type
plz-event-source:text/event-stream) process chunk)
@@ -464,8 +462,8 @@ ELSE callbacks will always be set to nil.")
(t pair))))
(oref media-type events))))))
(setq-local plz-event-source--current source)))
- (let ((body (plz-media-type-decode-string media-type (plz-response-body
chunk))))
- (plz-event-source-insert plz-event-source--current body)
+ (let ((body (plz-media-type-decode-coding-string media-type
(plz-response-body chunk))))
+ (plz-event-source--insert plz-event-source--current body)
(set-marker (process-mark process) (point))))
(cl-defmethod plz-media-type-then ((media-type
plz-event-source:text/event-stream) response)
diff --git a/plz-media-type.el b/plz-media-type.el
index 07ce937447..0421cb48cf 100644
--- a/plz-media-type.el
+++ b/plz-media-type.el
@@ -11,6 +11,11 @@
;; This file is part of GNU Emacs.
+;; It is temporarily vendored within the llm library. Please DO NOT
+;; depend on it! It is subject to change. Once we think this package
+;; is stable, we will release it to GNU ELPA. If no serious issues
+;; are found, we plan to do this in Q4 of 2024.
+
;;; License:
;; This program is free software; you can redistribute it and/or modify
@@ -72,6 +77,19 @@ parameter in the content type header, or the coding-sytem of
the
media type. If the coding system of a media type is nil, the
response will not be decoded.")
+(cl-defgeneric plz-media-type-else (media-type error)
+ "Transform and handle the ERROR according to MEDIA-TYPE.")
+
+(cl-defgeneric plz-media-type-then (media-type response)
+ "Transform and handle the RESPONSE according to MEDIA-TYPE.")
+
+(cl-defgeneric plz-media-type-process (media-type process chunk)
+ "Process the CHUNK according to MEDIA-TYPE using PROCESS.")
+
+(cl-defmethod plz-media-type-else ((_ (eql nil)) error)
+ "Transform and handle the ERROR according to MEDIA-TYPE."
+ error)
+
(defun plz-media-type-charset (media-type)
"Return the character set of the MEDIA-TYPE."
(with-slots (parameters) media-type
@@ -83,6 +101,12 @@ response will not be decoded.")
(coding-system-from-name charset)
(oref media-type coding-system)))
+(defun plz-media-type-decode-coding-string (media-type string)
+ "Decode STRING which is encoded in the coding system of MEDIA-TYPE."
+ (if-let (coding-system (plz-media-type-coding-system media-type))
+ (decode-coding-string string coding-system)
+ string))
+
(defun plz-media-type-name (media-type)
"Return the name of the MEDIA-TYPE as a string."
(with-slots (type subtype) media-type
@@ -92,24 +116,14 @@ response will not be decoded.")
"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.")
-
-(cl-defgeneric plz-media-type-then (media-type response)
- "Transform the RESPONSE into a format suitable for MEDIA-TYPE.")
-
-(cl-defgeneric plz-media-type-process (media-type process chunk)
- "Process the CHUNK according to MEDIA-TYPE using PROCESS.")
-
-(cl-defmethod plz-media-type-else ((_ (eql nil)) error)
- "Transform the ERROR into a format suitable for MEDIA-TYPE."
- error)
-
-(defun plz-media-type-parse (header)
- "Parse the Content-Type HEADER.
+(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)))
+ (clone (plz-media-type--find media-types media-type)
+ :parameters (oref media-type parameters))))
-Return a cons cell where the car is the MIME type, and the cdr is
-an alist of parameters."
+(defun plz-media-type--parse (header)
+ "Parse the Content-Type HEADER and return a `plz-media-type' instance."
(unless (or (null header) (string-blank-p header))
(let* ((components (split-string header ";"))
(mime-type (string-trim (car components)))
@@ -130,26 +144,14 @@ an alist of parameters."
"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)))
- (plz-media-type-parse header))))
+ (plz-media-type--parse header))))
-(defun plz-media--type-find (media-types media-type)
+(defun plz-media-type--find (media-types media-type)
"Lookup the MEDIA-TYPE in MEDIA-TYPES."
(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)))
- (clone (plz-media--type-find media-types media-type)
- :parameters (oref media-type parameters))))
-
-(defun plz-media-type-decode-string (media-type string)
- "Decode the STRING according to the MEDIA-TYPE."
- (if-let (coding-system (plz-media-type-coding-system media-type))
- (decode-coding-string string coding-system)
- string))
-
(defvar-local plz-media-type--current nil
"The media type of the process buffer.")
@@ -264,7 +266,7 @@ body. It is used as the default media type processor.")
(ignore media-type)
(save-excursion
(goto-char (process-mark process))
- (insert (plz-media-type-decode-string media-type (plz-response-body
chunk)))
+ (insert (plz-media-type-decode-coding-string media-type (plz-response-body
chunk)))
(set-marker (process-mark process) (point))))
;; Content Type: application/json
@@ -543,6 +545,17 @@ parsing the HTTP response body with the
(then 'sync)
(timeout plz-timeout))
"Request METHOD from URL with curl.
+
+This function works in a similar way as the `plz' function, with
+the additional functionality of handling streaming and
+non-streaming media types with the :as (media-types MEDIA-TYPES)
+option. Setting a process :filter by the user is not supported.
+Instead this function will always install its own process filter
+that will process the response until the HTTP headers arrived.
+Once the headers arrived it will hand over control to a media
+type based on the content type header of the response. The media
+type is responsible for processing the HTTP body.
+
Return the curl process object or, for a synchronous request, the
selected result.
