Begin parsing of ActivityPub JSON objects
It is naïve and error-prone, but it works somewhat well! What remains, primarily, is error-handling.
This commit is contained in:
parent
780951faaa
commit
75e3a964a8
|
@ -22,6 +22,10 @@
|
||||||
;; One should never USE this package, since some class-names shadow
|
;; One should never USE this package, since some class-names shadow
|
||||||
;; core Common Lisp symbols! Beware! :P
|
;; core Common Lisp symbols! Beware! :P
|
||||||
(:export
|
(:export
|
||||||
|
;; Functions
|
||||||
|
:parse
|
||||||
|
;; Globals
|
||||||
|
:*ap-packages*
|
||||||
;; Classes
|
;; Classes
|
||||||
:accept :activity :add :announce :application :arrive :article :audio
|
:accept :activity :add :announce :application :arrive :article :audio
|
||||||
:collection :collection-page :create :delete :dislike :document :event :flag
|
:collection :collection-page :create :delete :dislike :document :event :flag
|
||||||
|
@ -59,11 +63,18 @@
|
||||||
|
|
||||||
;;; Globals
|
;;; Globals
|
||||||
;;; ————————————————————————————————————————
|
;;; ————————————————————————————————————————
|
||||||
;; Used in YASON:ENCODE to ensure that a single top-level @context can be
|
(defparameter *ap-packages* (list *package*)
|
||||||
;; created where AP objects contain other AP objects in their slots.
|
"A list of packages in which we should search for AP classes and slot-symbols
|
||||||
;; This variable is overridden locally (LET), and should never be
|
during JSON parsing. The class-name searched for is simply the value of the JSON
|
||||||
;; modified globally (as we expect it to be nil in top-level objects).
|
object’s “type” key. The package first in the list to export such a symbol
|
||||||
(defparameter *@context* nil)
|
is the winner.")
|
||||||
|
|
||||||
|
;; Private, internal variable.
|
||||||
|
(defparameter *@context* nil
|
||||||
|
"Used in YASON:ENCODE to ensure that a single top-level @context can be
|
||||||
|
created where AP objects contain other AP objects in their slots.
|
||||||
|
This variable is overridden locally during encoding (LET), and should never be
|
||||||
|
modified globally (as we expect it to be nil in top-level objects.")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -244,16 +255,67 @@ to us) removed."
|
||||||
items in each will be contained in the resultant list."
|
items in each will be contained in the resultant list."
|
||||||
(append a (remove-if (lambda (item) (find item a :test #'equal)) b)))
|
(append a (remove-if (lambda (item) (find item a :test #'equal)) b)))
|
||||||
|
|
||||||
|
(defun find-registered-symbols (str)
|
||||||
|
"Find all symbols identified by string STR within packages in the
|
||||||
|
*ap-packages* list."
|
||||||
|
(mapcar (lambda (package) (find-symbol (string-upcase str) package))
|
||||||
|
*ap-packages*))
|
||||||
|
|
||||||
|
(defun find-registered-classes (str)
|
||||||
|
"Find all classes identified by string STR within pacakges in the
|
||||||
|
*ap-packages* list."
|
||||||
|
(mapcar (lambda (sym) (find-class sym))
|
||||||
|
(find-registered-symbols str)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;;; JSON parsing
|
||||||
|
;;; ————————————————————————————————————————
|
||||||
|
(defun parse (string)
|
||||||
|
"Parse a string containing JSON into an ActivityPub object."
|
||||||
|
(parse-table (yason:parse string)))
|
||||||
|
|
||||||
|
(defun parse-table (table)
|
||||||
|
"Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object."
|
||||||
|
(let* ((class (car (find-registered-classes (gethash "type" table))))
|
||||||
|
(obj (make-instance class)))
|
||||||
|
(loop for key being each hash-key of table
|
||||||
|
for val being each hash-value of table
|
||||||
|
do (let ((slot-sym (car (find-registered-symbols key)))
|
||||||
|
(val (parse-value val)))
|
||||||
|
(when slot-sym
|
||||||
|
(setf (slot-value obj slot-sym) val))))
|
||||||
|
obj))
|
||||||
|
|
||||||
|
(defun parse-value (val)
|
||||||
|
"Parse the value of a key found in YASON-parsed JSON.
|
||||||
|
All ActivityPub objects (hash-tables containing “type”) will be parsed into
|
||||||
|
ActivityPub objects; all others will parsed into associative lists."
|
||||||
|
(typecase val
|
||||||
|
(hash-table (maybe-parse-table val))
|
||||||
|
(list (mapcar (lambda (a)
|
||||||
|
(if (hash-table-p a)
|
||||||
|
(maybe-parse-table a)
|
||||||
|
a))
|
||||||
|
val))
|
||||||
|
(t val)))
|
||||||
|
|
||||||
|
(defun maybe-parse-table (table)
|
||||||
|
"If a hash-table seems to be a valid ActivityPub object, attempt parsing it
|
||||||
|
into one. Otherwise, parse it into an associative list."
|
||||||
|
(if (gethash "type" table)
|
||||||
|
(parse-table table)
|
||||||
|
(alexandria:hash-table-alist table)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; JSON serialization
|
;;; JSON serialization
|
||||||
;;; ————————————————————————————————————————
|
;;; ————————————————————————————————————————
|
||||||
(defmethod yason:encode ((obj object) &optional (stream *standard-output*))
|
(defmethod yason:encode ((obj object) &optional (stream *standard-output*))
|
||||||
(yason:with-output (stream)
|
|
||||||
(yason:with-object ()
|
(yason:with-object ()
|
||||||
(if *@context*
|
(if *@context* ; If this object is nested in another, use old context.
|
||||||
(yason:encode-object obj)
|
(yason:encode-object obj)
|
||||||
(let ((*@context* (slot-value obj '@context)))
|
(let ((*@context* (slot-value obj '@context))) ; Unnested, so create context.
|
||||||
(yason:encode-object obj)
|
(yason:encode-object obj)
|
||||||
(yason:encode-object-element
|
(yason:encode-object-element
|
||||||
"@context"
|
"@context"
|
||||||
|
@ -261,7 +323,7 @@ items in each will be contained in the resultant list."
|
||||||
(yason:encode-object-element
|
(yason:encode-object-element
|
||||||
"type"
|
"type"
|
||||||
(or (object-type obj)
|
(or (object-type obj)
|
||||||
(class-pretty-name (class-of obj)))))))
|
(class-pretty-name (class-of obj))))))
|
||||||
|
|
||||||
(defun class-slots-to-camel-cased-strings-alist (class)
|
(defun class-slots-to-camel-cased-strings-alist (class)
|
||||||
"Return an associative list of a CLASS’es direct slots (by symbol) matched with
|
"Return an associative list of a CLASS’es direct slots (by symbol) matched with
|
||||||
|
|
Ŝarĝante…
Reference in New Issue