如何使用 cl-json 库将 json 字符串转换为"complex" CLOS 对象？

Question

我来自这个问题 如何使用 cl-json 库将 json 字符串转换为 CLOS 对象？ 其中答案提供了一种使用输入 JSON 实例化告诉类的对象的方法。

可悲的是，答案错过了递归性，因为类顶对象的插槽(在defclass中使用：type键入到另一个类(没有得到该类的实例。

如何修改答案以实现这一目标(我还不习惯使用拖把概念(。
或者，是否已经有一个库可以以通用和自动的方式从 JSON 数据对我的类进行此类实例化？

我认为这将是 JSON 的一种非常常见的用法。

编辑：这个库似乎 https://github.com/gschjetne/json-mop 完成这项工作，但它使用元类和特定的插槽选项关键字，这使得defclass对第三方类非标准。

Answer 1

sanity-clause 库允许使用嵌套对象的 json(我没有尝试比自述文件示例更多的级别(并将它们转换为对象。此外，它还进行数据验证。

它的例子和你的例子有点不同。您创建了对象，将它们编码为 json，然后尝试再次解码它们。

健全性子句示例从 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": "[e-mail]"
},
"license": {
"name": "Apache 2.0",
"url": "http://www.apache.org/licenses/LICENSE-2.0.html"
},
"version": "1.0.1"
}

它具有三个相应的类别联系人，许可证和信息(顶级(。最后，我们得到一个信息对象，其中它的联系人和许可证插槽是相应的类型：

(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"

在类声明之后，此对象加载了

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

Answer 2

圆形结构

首先，在您链接的示例中，当我尝试创建"Alice"实例时出现错误，因为它:partner槽是nil但声明的类型是person。要么需要允许person为 nil，类型为(or null person)，要么必须强制所有:partner都有效地指向person的实例。

但即使person可以nil，也可能存在爱丽丝和鲍勃都是彼此的伴侣的情况;如果一个人可以nil，这很容易设置，但是如果你想强制一个非零的人，你需要按如下方式实例化它们：首先分配两个实例， 然后像往常一样初始化它们：

(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*))))

或者，您可以允许某些字段未指定(它们将被取消绑定(，并在以后设置它们。

无论如何，如果您有循环数据结构，导出将失败并导致堆栈溢出(无限递归(。如果您怀疑您可能具有循环数据结构，则需要在第一次访问它们时将它们散列为标识符，并在下次访问它们时对它们各自标识符的引用进行编码。

例如，对这些交叉引用进行编码的一种可能方法是向从其他地方交叉引用的所有对象添加一个"id"，并允许使用{ "ref" : <id> }代替实际值：

[ {"id" : 0,
"name" : "Alice",
"partner" : { "id" : 1,
"name" : "Bob",
"partner" : { "ref" : 0 }},
{ "ref" : 1 } ]

但是，这应该在中间层完成，而不是对所有类进行硬编码。

内省

如果要使用 MOP 自动将插槽名称关联到 json 密钥，可以定义以下辅助函数：

(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)))))

它们依赖于closer-mop并从类或给定对象中提取有趣的信息。例如，您可以提取类的名称和类型，这对于了解如何编码或解码某个类的值非常有用：

(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))

同样，当绑定槽时，您可能希望具有相同的对象信息以及与插槽关联的特定值：

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

您甚至可以将这些函数定义为泛型函数，以允许对特殊情况进行不同的分解。

译码

假设我们想将关联列表转换为对象(假设我们可以轻松地将 JSON 对象解析为 alists(。我们必须定义自己的编码/解码函数，我们必须管理的一个问题是交叉引用。

首先，一个帮助程序函数：

(defun aget (alist key)
(if-let (cell (assoc key alist :test #'string=))
(values (cdr cell) t)
(values nil nil)))

引用是只有一个"ref"字段的 alist，该字段是一个数字：

(defun referencep (value)
(and (consp value)
(not (rest value))
(aget value "ref")))

如果对象具有"id"字段，则该对象与索引相关联：

(defun indexp (alist)
(aget alist "id"))

这里的indexer只是一个哈希表，我们定义retrieve和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))

然后，我们定义我们的访问者函数，它将alist/values树转换为对象：

(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))))))))))

这不会处理对象列表，这些对象列表可能被编码为矢量。

例

;; 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)))

简单解码：

(decode-as-object 'foo '(("bar" . (("num" . 42)))))
=> #<FOO (BAR #<BAR (NUM 42) {10023AC693}>) {10023AC5C3}>

圆形结构：

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