Define a base-bones YASON encoder for every type

Using macros and MOP… talk about overkill! But I
was too lazy to do it otherwise. =w=
This commit is contained in:
Jaidyn Ann 2024-06-16 20:51:57 -05:00
parent 963c03db89
commit 41c09bd7e7

View File

@ -73,6 +73,16 @@ of NAME."
`(defclass ,a (,name) ())) `(defclass ,a (,name) ()))
direct-children))) direct-children)))
(defmacro define-yason-encode-slots-to-camel-cased-keys (class)
"Define a YASON:ENCODE-SLOTS method for a CLASS, which simply encodes all of
CLASSes slots with JSON keys based on the camel-cased slot name."
(append
`(defmethod yason:encode-slots progn ((obj ,class)))
(mapcar (lambda (slot-key-pair)
`(yason:encode-object-element ,(cdr slot-key-pair)
(slot-value obj ',(car slot-key-pair))))
(class-slots-to-camel-cased-strings-alist class))))
;;; Core types ;;; Core types
@ -85,6 +95,13 @@ of NAME."
media-type name preview published replies start-time summary media-type name preview published replies start-time summary
tag to updated url)) tag to updated url))
(defgeneric json-ld-context (obj)
(:documentation "Return an objects appropriate JSON-LD @context contents, in list-form.
For use in serialization to JSON."))
(defmethod json-ld-context ((object object))
"https://www.w3.org/ns/activitystreams")
;; https://www.w3.org/ns/activitystreams#Link ;; https://www.w3.org/ns/activitystreams#Link
(defclass-w-accessors link () (defclass-w-accessors link ()
(height href hreflang media-type name preview rel width)) (height href hreflang media-type name preview rel width))
@ -113,6 +130,7 @@ of NAME."
(start-index)) (start-index))
;;; Extended Activity types ;;; Extended Activity types
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
@ -166,3 +184,24 @@ of NAME."
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defclass-empty-children link (defclass-empty-children link
(mention)) (mention))
;;; JSON serialization
;;; ————————————————————————————————————————
(defun class-slots-to-camel-cased-strings-alist (class)
"Return an associative list of a CLASSes direct slots (by symbol) matched with
their names in camel-case format."
(mapcar
(lambda (slot)
(let ((name (closer-mop:slot-definition-name slot)))
(cons name (str:camel-case (symbol-name name)))))
(closer-mop:class-direct-slots class)))
;; Ensure all classes have their slots encodings defined with YASON.
(mapcar (lambda (class)
(closer-mop:finalize-inheritance class)
(eval `(define-yason-encode-slots-to-camel-cased-keys ,class)))
(mapcar #'find-class
'(object link activity collection collection-page
ordered-collection-page place profile relationship tombstone)))