Formatting tweaks, no functional change

It is naïve and error-prone, but it works somewhat well!
What remains, primarily, is error-handling.

src/activity-vocabulary.lisp

@@ -22,6 +22,10 @@
   ;; One should never USE this package, since some class-names shadow
   ;; core Common Lisp symbols! Beware! :P
   (:export
+   ;; Functions
+   :parse
+   ;; Globals
+   :*ap-packages*
    ;; Classes
    :accept :activity :add :announce :application :arrive :article :audio
    :collection :collection-page :create :delete :dislike :document :event :flag
@@ -59,11 +63,18 @@
 
 ;;; 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.")
 
 
 
@@ -73,18 +84,13 @@
   "Identical to DEFCLASS, but with one convenience: A slot definition, if being
 simply a symbol, will default to a slot with an accessor and init-arg named after the
 symbol. The init-arg will be “:symbol”, and the accessor will be “classname-symbol”.
-For instance,
+For example, the following two forms are equivalent:
-
     (defclass-w-accessors PERSON () (AGE
                                      HEIGHT
                                      (NAME :INIT-FORM “Unknown”)))
-```
-is equivalent to
-```
     (defclass PERSON () ((AGE    :INIT-ARG :AGE    :ACCESSOR PERSON-AGE)
                          (HEIGHT :INIT-ARG :HEIGHT :ACCESSOR PERSON-HEIGHT)
-                         (NAME   :INIT-FORM “Unknown”)))
+                         (NAME   :INIT-FORM “Unknown”)))"
-```"
   `(defclass ,name ,direct-superclasses
      ,(mapcar
        (lambda (slot)
@@ -222,46 +228,61 @@ again and again, by YASON:ENCODE-SLOTS."
 
 
 
-;;; Util
+;;; JSON parsing
 ;;; ————————————————————————————————————————
-(defun camel-case (string)
+(defun parse (string)
-  "Convert a STRING to camel-casing.
+  "Parse a string containing JSON into an ActivityPub object."
-Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric
+  (parse-table (yason:parse string)))
-character at the start of the string gets erroneously (or at least undesireably,
-to us) removed."
-  (if (not (alphanumericp (aref string 0)))
-      (concatenate 'string
-                   (string (aref string 0))
-                   (str:camel-case string))
-      (str:camel-case string)))
 
-(defun class-pretty-name (class)
+(defun parse-table (table)
-  "Return a CLASS’es name in a “pretty” (sentence-capitalized) string."
+  "Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object."
-  (string-capitalize (symbol-name (class-name class))))
+  (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 merge-lists (a b)
+(defun parse-value (val)
-  "Given lists A and B, merge them into one list non-redundantly — all unique
+  "Parse the value of a key found in YASON-parsed JSON.
-items in each will be contained in the resultant list."
+All ActivityPub objects (hash-tables containing “type”) will be parsed into
-  (append a (remove-if (lambda (item) (find item a :test #'equal)) b)))
+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
 ;;; ————————————————————————————————————————
 (defmethod yason:encode ((obj object) &optional (stream *standard-output*))
-  (yason:with-output (stream)
+  (yason:with-object ()
-    (yason:with-object ()
+    (if *@context* ; If this object is nested in another, use old context.
-      (if *@context*
+        (yason:encode-object obj)
+        (let ((*@context* (slot-value obj '@context))) ; Unnested, so create context.
           (yason:encode-object obj)
-          (let ((*@context* (slot-value obj '@context)))
+          (yason:encode-object-element
-            (yason:encode-object obj)
+           "@context"
-            (yason:encode-object-element
+           *@context*)))
-             "@context"
+    (yason:encode-object-element
-             *@context*)))
+     "type"
-      (yason:encode-object-element
+     (or (object-type obj)
-       "type"
+         (class-pretty-name (class-of obj))))))
-       (or (object-type obj)
-           (class-pretty-name (class-of obj)))))))
 
 (defun class-slots-to-camel-cased-strings-alist (class)
   "Return an associative list of a CLASS’es direct slots (by symbol) matched with
@@ -286,7 +307,47 @@ containing both of their elements."
           (if (listp a) a (list a))
           (if (listp b) b (list b))))))
 
-;; Ensure all classes have their slots’ encodings defined with YASON.
+
+
+;;; Util
+;;; ————————————————————————————————————————
+(defun camel-case (string)
+  "Convert a STRING to camel-casing.
+Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric
+character at the start of the string gets erroneously (or at least undesireably,
+to us) removed."
+  (if (not (alphanumericp (aref string 0)))
+      (concatenate 'string
+                   (string (aref string 0))
+                   (str:camel-case string))
+      (str:camel-case string)))
+
+(defun class-pretty-name (class)
+  "Return a CLASS’es name in a “pretty” (sentence-capitalized) string."
+  (string-capitalize (symbol-name (class-name class))))
+
+(defun merge-lists (a b)
+  "Given lists A and B, merge them into one list non-redundantly — all unique
+items in each will be contained in the resultant list."
+  (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)))
+
+
+
+;;; Defining YASON:ENCODE-SLOTS
+;;; ————————————————————————————————————————
+;; On-the-fly define YASON:ENCODE for each of our distinct AP classes.
 (mapcar (lambda (class)
           (closer-mop:finalize-inheritance class)
           (eval `(define-yason-encode-slots ,class)))