Compare commits

..

No commits in common. "fdbda3672fd7530d347575618ec4c349b9f81401" and "ddc3add769abf78ce5c8a781caf34d18f99fe77b" have entirely different histories.

View File

@ -128,7 +128,7 @@ CLASSes slots with JSON keys based on the camel-cased slot name."
This returns a function to create a quoted function that should be called for each slot,
again and again, by YASON:ENCODE-SLOTS."
(lambda (slot-key-pair)
`(let ((key ',(car slot-key-pair))
`(let ((key ',(car slot-key-pair))
(value (slot-value obj ',(car slot-key-pair))))
(cond ((eq key '@context) ; Encoded in YASON:ENCODE-OBJECT using *@context*
(setq *@context* (merge-@contexts *@context* value)))
@ -280,20 +280,19 @@ into one. Otherwise, parse it into an associative list."
;;; ————————————————————————————————————————
;; Note-worthy: See the above-defined DEFINE-YASON-ENCODE-SLOTS.
(defmethod yason:encode ((obj object) &optional (stream *standard-output*))
(yason:with-output (stream)
(yason:encode-object obj)))
(yason:encode-object obj))
(defmethod yason:encode-object ((obj object))
(typecase *@context*
(null ; If this is the top-level (non-nested) object, establish a @context.
(null ; If this is the top-level (non-nested) object, establish a @context.
(let ((*@context* 'top-level))
(yason:encode-object obj)))
(symbol ; In the top-level, encode slots and then @context.
(setq *@context* (slot-value obj '@context))
(yason:with-object ()
(yason:encode-slots obj)
(yason:encode-object-element "@context" *@context*)))
(T ; In nested objects, only encode slots — not *@context*.
(yason:encode-slots obj)
(yason:encode-object-element "@context" *@context*)))
(T ; In nested objects, only encode slots — not *@context*.
(yason:with-object ()
(yason:encode-slots obj)))))
@ -302,8 +301,10 @@ into one. Otherwise, parse it into an associative list."
their sanitized string keys appropriate for ActivityVocabular custom.
A class with slots MAP-AWAY and COLLECTION-AGAIN would return
((MAP-AWAY . mapAway)(COLLECTION-AGAIN . collectionAgain))"
(alist-mapcdr #'camel-case
(class-slots-alist class)))
;; (alist-remove-keys
;; 'type
(alist-mapcdr #'camel-case
(class-slots-alist class)))
(defun merge-@contexts (a b)
"Given two @context lists, A and B, merge them into one JSON-LD @context list
@ -355,6 +356,12 @@ items in each will be contained in the resultant list."
(mapcar (lambda (sym) (find-class sym))
(find-registered-symbols str)))
(defun alist-remove-keys (item alist &optional (test #'equal))
"Remove cells from an associative list whose key TESTs as ITEM."
(cl:remove item alist
:test (lambda (a cell)
(funcall test a (car cell)))))
(defun alist-mapcdr (function alist)
"Apply a FUNCTION to all values (cdrs) of an ALISTs pairs. Returns a new ALIST
of the same keys, whose values are the results of FUNCTION."