1.1--- a/lisp/lib/dat/json.lisp Sat Jun 01 19:16:02 2024 -0400
1.2+++ b/lisp/lib/dat/json.lisp Sun Jun 02 02:30:54 2024 -0400
1.3@@ -18,16 +18,12 @@
1.4 :accessor json-object-members))
1.5 (:documentation "An associative list of key/value pairs."))
1.6
1.7-;;; ----------------------------------------------------
1.8-
1.9 (defmethod print-object ((obj json-object) stream)
1.10 "Output a JSON object to a stream in readable form."
1.11 (print-unreadable-object (obj stream :type t)
1.12 (let ((*print-level* 1))
1.13 (json-encode obj stream))))
1.14
1.15-;;; ----------------------------------------------------
1.16-
1.17 (defun json-getf (object key &optional value)
1.18 "Find an member's value in a JSON object."
1.19 (let ((place (assoc key (json-object-members object) :test 'string=)))
1.20@@ -35,8 +31,6 @@
1.21 value
1.22 (values (second place) t))))
1.23
1.24-;;; ----------------------------------------------------
1.25-
1.26 (defun json-setf (object key value)
1.27 "Assign a value to a key in a JSON object."
1.28 (let ((place (assoc key (json-object-members object) :test 'string=)))
1.29@@ -48,12 +42,8 @@
1.30 (push (list k value) (json-object-members object)))
1.31 (rplacd place (list value))))))
1.32
1.33-;;; ----------------------------------------------------
1.34-
1.35 (defsetf json-getf json-setf)
1.36
1.37-;;; ----------------------------------------------------
1.38-
1.39 (defun json-decode (string &key (start 0) end)
1.40 "Convert a JSON string into a Lisp object."
1.41 (with-input-from-string (stream string :start start :end end)
1.42@@ -64,8 +54,6 @@
1.43 (declare (ignore format))
1.44 (json-decode obj :start start :end end))
1.45
1.46-;;; ----------------------------------------------------
1.47-
1.48 (defun json-encode (value &optional stream)
1.49 "Encodes a Lisp value into a stream."
1.50 (json-write value stream))
1.51@@ -78,8 +66,6 @@
1.52 (json-encode obj s)
1.53 s)))
1.54
1.55-;;; ----------------------------------------------------
1.56-
1.57 (defun json-enable-reader-macro ()
1.58 "Set the #{ dispatch macro character for reading JSON objects."
1.59 (flet ((json-object-reader (stream char n)
1.60@@ -112,20 +98,15 @@
1.61 (#\{ (json-read-object stream))
1.62 (#\[ (json-read-list stream))
1.63 (#\" (json-read-string stream))
1.64-
1.65 ;; must be a number
1.66 (otherwise (json-read-number stream)))))
1.67
1.68-;;; ----------------------------------------------------
1.69-
1.70 (defun json-peek-char (stream expected &key skip-ws)
1.71 "Peek at the next character or token and optionally error if unexpected."
1.72 (declare (optimize (speed 3) (debug 0)))
1.73 (when (equal (peek-char skip-ws stream) expected)
1.74 (read-char stream)))
1.75
1.76-;;; ----------------------------------------------------
1.77-
1.78 (defun json-read-char (stream expected &key skip-ws)
1.79 "Read the next, expected character in the stream."
1.80 (declare (optimize (speed 3) (debug 0)))
1.81@@ -133,8 +114,6 @@
1.82 t
1.83 (error "JSON error: unexpected ~s" (read-char stream))))
1.84
1.85-;;; ----------------------------------------------------
1.86-
1.87 (defun json-read-true (stream)
1.88 "Read true from a JSON stream."
1.89 (json-read-char stream #\t :skip-ws t)
1.90@@ -142,8 +121,6 @@
1.91 (json-read-char stream #\u)
1.92 (json-read-char stream #\e))
1.93
1.94-;;; ----------------------------------------------------
1.95-
1.96 (defun json-read-false (stream)
1.97 "Read false from a JSON stream."
1.98 (prog1 nil
1.99@@ -153,8 +130,6 @@
1.100 (json-read-char stream #\s)
1.101 (json-read-char stream #\e)))
1.102
1.103-;;; ----------------------------------------------------
1.104-
1.105 (defun json-read-null (stream)
1.106 "Read null from a JSON stream."
1.107 (prog1 nil
1.108@@ -163,8 +138,6 @@
1.109 (json-read-char stream #\l)
1.110 (json-read-char stream #\l)))
1.111
1.112-;;; ----------------------------------------------------
1.113-
1.114 (defun json-read-number (stream)
1.115 "Read a number from a JSON stream."
1.116 (declare (optimize (speed 3) (debug 0)))
1.117@@ -218,8 +191,6 @@
1.118 (prog1
1.119 (read-from-string s))))
1.120
1.121-;;; ----------------------------------------------------
1.122-
1.123 (defun json-read-string (stream)
1.124 "Read a string from a JSON stream."
1.125 (declare (optimize (speed 3) (debug 0)))
1.126@@ -259,8 +230,6 @@
1.127 (otherwise c))))
1.128 (write-char c s))))))
1.129
1.130-;;; ----------------------------------------------------
1.131-
1.132 (defun json-read-list (stream)
1.133 "Read a list of JSON values."
1.134 (declare (optimize (speed 3) (debug 0)))
1.135@@ -283,8 +252,6 @@
1.136 finally (return (prog1 xs
1.137 (json-read-char stream #\] :skip-ws t))))))
1.138
1.139-;;; ----------------------------------------------------
1.140-
1.141 (defun json-read-object (stream)
1.142 "Read an associative list of key/value pairs into a JSON object."
1.143 (declare (optimize (speed 3) (debug 0)))
1.144@@ -317,33 +284,23 @@
1.145 (declare (ignore value))
1.146 (format stream "~<true~>"))
1.147
1.148-;;; ----------------------------------------------------
1.149-
1.150 (defmethod json-write ((value (eql nil)) &optional stream)
1.151 "Encode the null constant."
1.152 (declare (ignore value))
1.153 (format stream "~<null~>"))
1.154
1.155-;;; ----------------------------------------------------
1.156-
1.157 (defmethod json-write ((value symbol) &optional stream)
1.158 "Encode a symbol to a stream."
1.159 (json-write (symbol-name value) stream))
1.160
1.161-;;; ----------------------------------------------------
1.162-
1.163 (defmethod json-write ((value number) &optional stream)
1.164 "Encode a number to a stream."
1.165 (format stream "~<~a~>" value))
1.166
1.167-;;; ----------------------------------------------------
1.168-
1.169 (defmethod json-write ((value ratio) &optional stream)
1.170 "Encode a ratio to a stream."
1.171 (format stream "~<~a~>" (float value)))
1.172
1.173-;;; ----------------------------------------------------
1.174-
1.175 (defmethod json-write ((value string) &optional stream)
1.176 "Encode a string as a stream."
1.177 (flet ((encode-char (c)
1.178@@ -361,14 +318,10 @@
1.179 (string c)))))
1.180 (format stream "~<\"~{~a~}\"~>" (map 'list #'encode-char value))))
1.181
1.182-;;; ----------------------------------------------------
1.183-
1.184 (defmethod json-write ((value pathname) &optional stream)
1.185 "Encode a pathname as a stream."
1.186 (json-write (namestring value) stream))
1.187
1.188-;;; ----------------------------------------------------
1.189-
1.190 (defmethod json-write ((value vector) &optional stream)
1.191 "Encode an array to a stream."
1.192 (let ((*print-pretty* t)
1.193@@ -386,8 +339,6 @@
1.194 (pprint-indent :block 0)
1.195 (json-write (aref value i) stream))))))
1.196
1.197-;;; ----------------------------------------------------
1.198-
1.199 (defmethod json-write ((value list) &optional stream)
1.200 "Encode a list to a stream."
1.201 (let ((*print-pretty* t)
1.202@@ -403,8 +354,6 @@
1.203 (pprint-newline :fill)
1.204 (pprint-indent :block 0)))))
1.205
1.206-;;; ----------------------------------------------------
1.207-
1.208 (defmethod json-write ((value hash-table) &optional stream)
1.209 "Encode a hash-table to a stream."
1.210 (let ((*print-pretty* t)
1.211@@ -429,8 +378,6 @@
1.212 (pprint-newline :mandatory)
1.213 (pprint-indent :current 0)))))))))
1.214
1.215-;;; ----------------------------------------------------
1.216-
1.217 (defmethod json-write ((value json-object) &optional stream)
1.218 "Encode a JSON object with an associative list of members to a stream."
1.219 (let ((*print-pretty* t)
