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:
parent
963c03db89
commit
41c09bd7e7
|
@ -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
|
||||||
|
CLASS’es 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 object’s 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 CLASS’es 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)))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue