Fix handling of keys w multiple-words-like-this.

This commit is contained in:
Jaidyn Ann 2024-06-23 12:16:56 -05:00
parent 373f8a1194
commit 2501e3e0de

View File

@ -129,7 +129,7 @@ This returns a function to create a quoted function that should be called for ea
again and again, by YASON:ENCODE-SLOTS." again and again, by YASON:ENCODE-SLOTS."
(lambda (slot-key-pair) (lambda (slot-key-pair)
`(let ((key ',(car slot-key-pair)) `(let ((key ',(car slot-key-pair))
(value (slot-value obj ',(car slot-key-pair)))) (value (ignore-errors (slot-value obj ',(car slot-key-pair)))))
(cond ((eq key '@context) ; Encoded in YASON:ENCODE-OBJECT using *@context* (cond ((eq key '@context) ; Encoded in YASON:ENCODE-OBJECT using *@context*
(setq *@context* (merge-@contexts *@context* value))) (setq *@context* (merge-@contexts *@context* value)))
((eq key 'type) ; Encode type based on class-name or TYPE slot ((eq key 'type) ; Encode type based on class-name or TYPE slot
@ -244,11 +244,11 @@ again and again, by YASON:ENCODE-SLOTS."
(defun parse-table (table) (defun parse-table (table)
"Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object." "Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object."
(let* ((class (car (find-registered-classes (gethash "type" table)))) (let* ((class (car (find-registered-classes (param-case (gethash "type" table)))))
(obj (make-instance class))) (obj (make-instance class)))
(loop for key being each hash-key of table (loop for key being each hash-key of table
for val being each hash-value of table for val being each hash-value of table
do (let ((slot-sym (car (find-registered-symbols key))) do (let ((slot-sym (car (find-registered-symbols (param-case key))))
(val (parse-value val))) (val (parse-value val)))
(when slot-sym (when slot-sym
(setf (slot-value obj slot-sym) val)))) (setf (slot-value obj slot-sym) val))))
@ -324,15 +324,35 @@ containing both of their elements."
;;; Util ;;; Util
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defun camel-case (string) (defun camel-case (string)
"Convert a STRING to camel-casing. That is, casingLikeThis.
Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric
character at the start of the string gets erroneously (or at least undesireably,
to us) removed."
(keep-nonalphanumeric-prefix string
(str:camel-case string)))
(defun param-case (string)
"Convert a STRING to param-casing. That is, casing-like-this.
Wrapper around STR:PARAM-CASE, working around a bug that a non-alphanumeric
character at the start of the string gets erroneously (or at least undesireably,
to us) removed."
(keep-nonalphanumeric-prefix string
(str:param-case string)))
(defun camel-case (str)
"Convert a STRING to camel-casing. "Convert a STRING to camel-casing.
Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric
character at the start of the string gets erroneously (or at least undesireably, character at the start of the string gets erroneously (or at least undesireably,
to us) removed." to us) removed."
(if (not (alphanumericp (aref string 0))) (keep-nonalphanumeric-prefix str (str:camel-case str)))
(defun keep-nonalphanumeric-prefix (str child-str)
"This ensures that a CHILD-STR derived from STR has the same nonalphanumeric
prefix as STR, as some functions like to remove such prefixes."
(if (not (alphanumericp (aref str 0)))
(concatenate 'string (concatenate 'string
(string (aref string 0)) (string (aref str 0))
(str:camel-case string)) child-str)
(str:camel-case string))) child-str))
(defun class-pretty-name (class) (defun class-pretty-name (class)
"Return a CLASSes name in a “pretty” (sentence-capitalized) string." "Return a CLASSes name in a “pretty” (sentence-capitalized) string."