Add new @id & @type slots, make @context a method

This commit is contained in:
Jaidyn Ann 2024-06-28 00:08:07 -05:00
parent 71f0c6442c
commit 54a5b1f434
2 changed files with 32 additions and 9 deletions

View File

@ -26,8 +26,10 @@
:*ap-packages* :*default-class* :*ap-packages* :*default-class*
;; Classes ;; Classes
:object :object
;; Accessors
:object-@context :object-unsupported
;; Slots ;; Slots
:@context :type :unsupported)) :@context :@type :type :@id :id :unsupported))
(in-package #:activity-servist/activity-streams) (in-package #:activity-servist/activity-streams)
@ -75,8 +77,8 @@ 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 (ignore-errors (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) ; Actually in YASON:ENCODE-OBJECT using *@context*
(setq *@context* (merge-@contexts *@context* value))) (setq *@context* (merge-@contexts *@context* (object-@context obj))))
((eq key 'unsupported) ((eq key 'unsupported)
;; Keys/values without a slot are stored in this UNSUPPORTED alist. ;; Keys/values without a slot are stored in this UNSUPPORTED alist.
(mapcar (lambda (cell) (mapcar (lambda (cell)
@ -96,9 +98,30 @@ again and again, by YASON:ENCODE-SLOTS."
;;; Core class ;;; Core class
;;; ———————————————————————————————————————— ;;; ————————————————————————————————————————
(defclass object () (defclass object ()
((@context :initform "https://www.w3.org/ns/activitystreams") ((@context :initform nil)
(unsupported) (as/as:@type :initform nil)
(type))) (as/as:type :initform nil)
(as/as:@id :initform nil)
(as/as:id :initform nil)
(as/as:unsupported :initform nil :accessor object-unsupported)))
;;; Accessors
;;; ————————————————————————————————————————
(defgeneric object-@context (obj)
(:documentation "Accessor for an objects associated JSON-LD @context.
As @context can sometimes vary on an objects contents, on-the-fly, this
method is invoked during JSON encoding of an object. The @CONTEXT
slot-value should be prioritized over the @CONTEXT value is calculated
by this method."))
(defmethod object-@context ((obj object))
(or (slot-value obj '@context)
"https://www.w3.org/ns/activitystreams"))
(defmethod (setf object-@context) (context (obj object))
(setf (slot-value obj '@context) context))
@ -173,7 +196,7 @@ inherited class). Each slots name is converted to camel-case, as per conventi
(let ((*@context* 'top-level)) (let ((*@context* 'top-level))
(yason:encode-object obj))) (yason:encode-object obj)))
(symbol ; In the top-level, encode slots and then @context. (symbol ; In the top-level, encode slots and then @context.
(setq *@context* (slot-value obj '@context)) (setq *@context* (object-@context obj))
(yason:with-object () (yason:with-object ()
(yason:encode-slots obj) (yason:encode-slots obj)
(yason:encode-object-element "@context" *@context*))) (yason:encode-object-element "@context" *@context*)))