How to convert json-string into "complex" CLOS object using cl-json library?

Question

I'm coming from this question How to convert json-string into CLOS object using cl-json library? in which an answer provides a way to instantiate an object of a told class using an input json.

Sadly the answer misses recursivity, as slots of the class top object (that are typed to another class using :type inside defclass) don't get an instance of that class.

How could the answer be modified to achieve that (I'm not yet comfortable working with mop concepts).
Alternatively, isn't there yet already a library that can do such instantiation of my classes from JSON data in a generic and automatic way ?

I thought that would be a very common usage of JSON.

EDIT : This library https://github.com/gschjetne/json-mop seems to do the job, but it is using a metaclass and specific slot option keywords which makes the defclass non-standard to 3rd party classes.

Answer 1

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}>

Answer 2

The sanity-clause library allows to take a json with nested objects (I didn't try more levels than the readme examples) and turns them into objects. Besides, it does data validation.

Its example is a bit different than yours. You created objects, encoded them to json and tried to decode them again.

The sanity-clause example starts from a json:

{
  "title": "Swagger Sample App",
  "description": "This is a sample server Petstore server.",
  "termsOfService": "http://swagger.io/terms/",
  "contact": {
    "name": "API Support",
    "url": "http://www.swagger.io/support",
    "email": "support@swagger.io"
  },
  "license": {
    "name": "Apache 2.0",
    "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
  },
  "version": "1.0.1"
}

It has the three corresponding classes contact, licence and info (top level). In the end, we get an info object where its contact and licence slots are of the corresponding types:

(describe #<INFO-OBJECT {1006003ED3}>)
#<INFO-OBJECT {1006003ED3}>
  [standard-object]

Slots with :INSTANCE allocation:
  TITLE                          = "Swagger Sample App"
  DESCRIPTION                    = "This is a sample server Petstore server."
  TERMS-OF-SERVICE               = "http://swagger.io/terms/"
  CONTACT                        = #<CONTACT-OBJECT {1005FFDB43}>
  LICENSE                        = #<LICENSE-OBJECT {10060021F3}>
  VERSION                        = "1.0.1"

After the class declarations, this object was loaded with

(let ((v2-info (alexandria:read-file-into-string "v2-info.json")))
  (sanity-clause:load (find-class 'info-object) (jojo:parse v2-info :as :alist)))