From 54a5b1f434dde8e3e12d474e5e20494f34c3e34c Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Fri, 28 Jun 2024 00:08:07 -0500 Subject: [PATCH] Add new @id & @type slots, make @context a method --- ...pub-servist.lisp => activity-servist.lisp} | 0 src/activity-streams.lisp | 41 +++++++++++++++---- 2 files changed, 32 insertions(+), 9 deletions(-) rename src/{activitypub-servist.lisp => activity-servist.lisp} (100%) diff --git a/src/activitypub-servist.lisp b/src/activity-servist.lisp similarity index 100% rename from src/activitypub-servist.lisp rename to src/activity-servist.lisp diff --git a/src/activity-streams.lisp b/src/activity-streams.lisp index bb41813..25731d1 100644 --- a/src/activity-streams.lisp +++ b/src/activity-streams.lisp @@ -26,8 +26,10 @@ :*ap-packages* :*default-class* ;; Classes :object + ;; Accessors + :object-@context :object-unsupported ;; Slots - :@context :type :unsupported)) + :@context :@type :type :@id :id :unsupported)) (in-package #:activity-servist/activity-streams) @@ -75,8 +77,8 @@ again and again, by YASON:ENCODE-SLOTS." (lambda (slot-key-pair) `(let ((key ',(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* - (setq *@context* (merge-@contexts *@context* value))) + (cond ((eq key '@context) ; Actually in YASON:ENCODE-OBJECT using *@context* + (setq *@context* (merge-@contexts *@context* (object-@context obj)))) ((eq key 'unsupported) ;; Keys/values without a slot are stored in this UNSUPPORTED alist. (mapcar (lambda (cell) @@ -96,9 +98,30 @@ again and again, by YASON:ENCODE-SLOTS." ;;; Core class ;;; ———————————————————————————————————————— (defclass object () - ((@context :initform "https://www.w3.org/ns/activitystreams") - (unsupported) - (type))) + ((@context :initform nil) + (as/as:@type :initform nil) + (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,10 +196,10 @@ inherited class). Each slot’s name is converted to camel-case, as per conventi (let ((*@context* 'top-level)) (yason:encode-object obj))) (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:encode-slots obj) - (yason:encode-object-element "@context" *@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)))))