jadedctrl/activity-servist
jadedctrl/ activity-servist
1
0
Disbranĉigi 0
Fontkodo Issues Tirpetoj Activity

Parse even unknown ActivityStreams classes 

By means of a *default-class* that is a catch-all.
This commit is contained in:
Jaidyn Ann 2024-06-23 22:47:55 -05:00
parent a2aec426ab
commit bb361465c3
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/activity-streams.lisp
View File

@ -23,7 +23,7 @@
:parse :encode :parse :encode
:define-class-encoders :define-class-encoders
;; Globals ;; Globals
:*ap-packages* :*ap-packages* :*default-class*
;; Classes ;; Classes
:object :object
;; Slots ;; Slots
@ -41,6 +41,12 @@ during JSON parsing. The class-name searched for is simply the value of the JSON
object’s “type” key. The package first in the list to export such a symbol object’s “type” key. The package first in the list to export such a symbol
is the winner.") is the winner.")
(defparameter *default-class* 'activity-servist/activity-streams:object
"The class used for ActivityStreams objects found during parsing that don’t
have a corresponding class defined. Notably, all keys and values without
corresponding slots are placed in the MISC slot.
The class you choose should inherit ACTIVITY-SERVIST/ACTIVITY-STREAMS:OBJECT.")
;; Private, internal variable. ;; Private, internal variable.
(defparameter *@context* nil (defparameter *@context* nil
"Used in YASON:ENCODE to ensure that a single top-level @context can be "Used in YASON:ENCODE to ensure that a single top-level @context can be
@ -96,8 +102,9 @@ again and again, by YASON:ENCODE-SLOTS."
(defun parse-table (table) (defun parse-table (table)
"Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object." "Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object."
(let* ((class (car (find-registered-classes (param-case (gethash "type" table))))) (let* ((found-class (car (find-registered-classes (param-case (gethash "type" table)))))
(obj (make-instance class))) (class (or found-class (find-class *default-class*)))
(obj (make-instance class)))
(loop for key being each hash-key of table (loop for key being each hash-key of table
for val being each hash-value of table for val being each hash-value of table
do (let ((slot-sym (car (find-registered-symbols (param-case key)))) do (let ((slot-sym (car (find-registered-symbols (param-case key))))
@ -232,7 +239,11 @@ items in each will be contained in the resultant list."
*ap-packages* list." *ap-packages* list."
(remove-if (remove-if
#'not #'not
(mapcar (lambda (package) (find-symbol (string-upcase str) package)) (mapcar (lambda (package)
(multiple-value-bind (sym context)
(find-symbol (string-upcase str) package)
(unless (eq context :inherited)
sym)))
*ap-packages*))) *ap-packages*)))
(defun find-registered-classes (str) (defun find-registered-classes (str)

2
src/activity-vocabulary.lisp
View File

@ -54,6 +54,8 @@
(in-package #:activity-servist/activity-vocabulary) (in-package #:activity-servist/activity-vocabulary)
(setq activity-servist/activity-streams:*default-class*
'activity-servist/activity-vocabulary:object)
;;; Macros ;;; Macros