From 2d377f5b9b5c949d9bb17ffca406a9afd6571f16 Mon Sep 17 00:00:00 2001
From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com>
Date: Mon, 21 Oct 2024 03:54:52 -0500
Subject: [PATCH] Only encode LitePub context for LP classes/slots
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Why add a context if we don’t need it? ^^
---
 src/litepub.lisp | 36 ++++++++++++++++++++++++++++--------
 1 file changed, 28 insertions(+), 8 deletions(-)

diff --git a/src/litepub.lisp b/src/litepub.lisp
index dbd8b65..660aad5 100644
--- a/src/litepub.lisp
+++ b/src/litepub.lisp
@@ -39,6 +39,24 @@ canonical URL for it. This URI will be used in encoded LITEPUB:OBJECTs in the
 @CONTEXT.
 Defaults to a copy at jam.xwx.moe — because why not? ¯\_(ツ)_/¯")
 
+(unless +new-classes+
+  (defconstant +new-classes+ '(chat-message emoji emoji-react hashtag property-value)
+    "Simple list of classes/JSON types defined in this package.
+Used by our overloaded JSON-LD:@CONTEXT to help choose the appropriate JSON-LD context."))
+
+;; This isn’t pretty… but it helps us avoid bringing in another dependency! :^)
+;; (closer-mop, that is.)
+(unless +new-slots+
+  (defconstant +new-slots+
+    '(atom-uri sensitivep non-anonymous direct-message-p former-representations
+      public-key discoverablep manually-approves-followers-p also-known-as
+      capabilities            ; Object ←↑
+      invisiblep list-message ; Activity
+      conversation            ; Update
+      quote-url quote-uri)    ; Note
+    "List of slots added to subclasses corresponding AS/VOCAB/ACTIVITY classes.
+For example, slots in our OBJECT that aren’t in AS/V/A:OBJECT.
+Used by our overloaded JSON-LD:@CONTEXT to help choose the appropriate JSON-LD context."))
 
 
 ;;; Core types
@@ -87,14 +105,16 @@ One known capabilitity-name is Pleroma’s “acceptsChatMessages”.")))
 
 
 (defmethod json-ld:@context ((obj litepub:object))
-  (let ((class (class-name (class-of obj))))
-    (case class
-      ;; Only use LitePub context for newly-defined classes.
-      (('property-value 'emoji-react 'chat-message 'hashtag 'emoji)
-       *litepub-uri*)
-      ;; TODO: Also use LitePub context for old classes when new slots are used.
-      (otherwise
-       (call-next-method)))))
+  (let ((lp-context (list "https://www.w3.org/ns/activitystreams" *litepub-uri*)))
+    ;; Only use LitePub context for newly-defined classes.
+    (if (member obj +new-classes+ :test #'typep)
+        lp-context
+        ;; … or for derivative classes with new slots.
+        (or (dolist (slot +new-slots+)
+              (when (and (slot-exists-p obj slot)
+                         (slot-boundp obj slot))
+                (return lp-context)))
+            (call-next-method)))))
 
 
 (json-ld:define-json-type (activity "Activity") (as/v/a:activity object) *litepub-uri*