Circular structures
First of all, in the example you linked, I have an error when I try to make the "Alice" instance, since its :partner slot is nil but the declared type is person. Either you need to allow for person to be nil, with the type (or null person), or you must enforce that all :partner are effectively pointing to instances of person.
But even if person can be nil, there might be cases where Alice and Bob are both partners of each other; this is easy to setup if a person can be nil, but in the case you want to enforce a non-nil person, you will need to instantiate them as follows: first you allocate both instances, and then you initialize them as usual:
(flet ((person () (allocate-instance (find-class 'person))))
(let ((alice (person)) (bob (person)))
(setf *mypartner* (initialize-instance alice
:name "Alice"
:address "Regent Street, London"
:phone "555-99999"
:color "blue"
:partner bob
:employed-by *mycompany*))
(setf *myperson* (initialize-instance bob
:name "Bob"
:address "Broadway, NYC"
:phone "555-123456"
:color "orange"
:partner alice
:employed-by *mycompany*))))
Or, you can let some fields unspecified (they will be unbound), and set them later.
Anyway, if you have circular data-structures, the export will fail with a stack overflow (infinite recursion). If you suspect you may have circular data-structures, you need to hash them to an identifier the first time you visit them and encode a reference to their respective identifier the next time you visit them.
For example, a possible way to encode those cross-references is to add an "id" to all objects that are cross-referenced from elsewhere and allow a { "ref" : <id> } in place of actual values:
[ {"id" : 0,
"name" : "Alice",
"partner" : { "id" : 1,
"name" : "Bob",
"partner" : { "ref" : 0 }},
{ "ref" : 1 } ]
This should however be done at an intermediate layer, not hardcoded for all classes.
Introspection
If you want to use the MOP to automatically associate slot names to json keys, you can define the following auxiliary functions:
(defun decompose-class (class)
(mapcar (lambda (slot)
(let* ((slot-name (closer-mop:slot-definition-name slot)))
(list slot-name
(string-downcase slot-name)
(closer-mop:slot-definition-type slot))))
(closer-mop:class-direct-slots (find-class class))))
(defun decompose-value (value)
(loop
for (name str-name type) in (decompose-class (class-of value))
for boundp = (slot-boundp value name)
collect (list name
str-name
type
boundp
(and boundp (slot-value value name)))))
They depends on closer-mop and extract the interesting information from either a class or a given object. For example, you can extract the names and types for a class, which is useful for knowing how to encode or decode a value of a certain class:
(decompose-class 'person)
=> ((name "name" T)
(address "address" T)
(phone-number "phone-number" T)
(favorite-color "favorite-color" T)
(partner "partner" PERSON)
(employed-by "employed-by" COMPANY))
Likewise, you may want to have the same information for an object, along with the specific values associated with the slot, when the slot is bound:
(decompose-value *myperson*)
=> ((name "name" T T "Bob")
(address "address" T T "Broadway, NYC")
(phone-number "phone- number" T T "555-123456")
(favorite-color "favorite-color" T T "orange")
(partner "partner" PERSON T #<PERSON {100E12CB53}>)
(employed-by "employed-by" COMPANY T #<COMPANY {100D6B3533}>))
You could even define those functions as generic functions to allow different decompositions for special cases.
Decoding
Suppose we want to convert association lists to objects (assuming we can easily parse JSON object as alists). We have to define our own encoding/decoding functions, and one issue we will have to manage is cross-references.
First, an helper function:
(defun aget (alist key)
(if-let (cell (assoc key alist :test #'string=))
(values (cdr cell) t)
(values nil nil)))
A reference is an alist that only has a "ref" field, which is a number:
(defun referencep (value)
(and (consp value)
(not (rest value))
(aget value "ref")))
An object is associated with an index if it has an "id" field:
(defun indexp (alist)
(aget alist "id"))
Here an indexer is just a hash-table, we define retrieve and register:
(defun retrieve (hash ref)
(multiple-value-bind (v e) (gethash ref hash)
(prog1 v
(assert e () "Unknown ref ~s in ~a" ref hash))))
(defun register (hash key object)
(assert (not (nth-value 1 (gethash key hash))) ()
"Key ~s already set in ~s" key hash)
(setf (gethash key hash) object))
Then, we define our visitor function, which translates a tree of alist/values as objects:
(defun decode-as-object (class key/values
&optional (index (make-instance 'indexer)))
(if-let (ref (referencep key/values))
(retrieve index ref)
(if (eql class t)
key/values
(let ((object (allocate-instance (find-class class))))
(when-let (key (indexp key/values))
(register index key object))
(dolist (tuple (decompose-class class) (shared-initialize object ()))
(destructuring-bind (name strname class) tuple
(multiple-value-bind (value foundp) (aget key/values strname)
(when foundp
(setf (slot-value object name)
(decode-as-object class value index))))))))))
This does not handle lists of objects, which are likely to be encoded as vectors.
Example
;; easy-print mixin
(defclass easy-print () ())
(defmethod print-object ((o easy-print) stream)
(let ((*print-circle* t))
(print-unreadable-object (o stream :type t :identity t)
(format stream
"~{~a~^ ~_~}"
(loop
for (name sname class bp val) in (decompose-value o)
when bp collect (list name val))))))
(defclass bar (easy-print)
((num :initarg :num :accessor bar-num)
(foo :initarg :foo :accessor bar-foo)))
(defclass foo (easy-print)
((bar :initarg :bar :type bar :accessor foo-bar)))
Simple decode:
(decode-as-object 'foo '(("bar" . (("num" . 42)))))
=> #<FOO (BAR #<BAR (NUM 42) {10023AC693}>) {10023AC5C3}>
Circular structures:
(setf *print-circle* t)
(decode-as-object 'foo
'(("id" . 0)
("bar" . (("num" . 42)
("foo" . (("ref" . 0)))))))
=> #1=#<FOO (BAR #<BAR (NUM 42) (FOO #1#) {10028113B3}>) {10028112E3}>
