Add new @id & @type slots, make @context a method
This commit is contained in:
parent
71f0c6442c
commit
54a5b1f434
|
@ -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 object’s associated JSON-LD @context.
|
||||||
|
As @context can sometimes vary on an object’s 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 slot’s 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*)))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue