The package kutils-mop
contains utilities taking advantage of the
metaobject protocol.
The list-all-slots
function will return a list of all slots in an
object.
list-all-slots
(class-sym &optional (package *package*))
Given a class symbol (and optionally a package to search in),
return a list of all the slots in an instance of that class.
The make-instance-from-hash-table
function will attempt to create
an instance of an object from a hash table.
make-instance-from-hash-table
(class-type table &optional (package *package*) snake-case)
Given a class symbol and a hash table, attempt to build an instance
from it. The instance initargs are derived from the slot definitions,
and an attempt is made to pair the slot with a string derivation. It
is expected that the hash table keys will be downcase. If
snake-case
is t, the keys should use hyphens; otherwise, they
should use underscores. The slot type is used to determine whether
to attempt to parse another object as a hash table entry.This is motivated by the fact that Yason parses JSON as hash tables; this function is used to facilitate rapidly parsing CLOS objects from JSON.
For example, with the following example.json
{
"name": "something",
"ref": {
"link": "https://common-lisp.net/",
"title": "Common Lisp"
},
"value": "just a thing"
}
the following code will produce an instance of the class-d
class.
(defpackage #:kutils-example
(:use #:cl #:kutils #:kutils-mop))
(in-package :kutils-example)
KUTILS-EXAMPLE> (defclass class-a ()
((name :initarg :name
:accessor name-of)
(value :initarg :value
:accessor value-of)))
#<STANDARD-CLASS KUTILS-EXAMPLE::CLASS-A>
KUTILS-EXAMPLE> (defun new-class-a (n v)
(make-instance 'class-a :name n :value v))
NEW-CLASS-A
KUTILS-EXAMPLE> (defclass reference ()
((link :initarg :link
:accessor link-of)
(title :initarg :title
:accessor title-of)))
#<STANDARD-CLASS KUTILS-EXAMPLE::REFERENCE>
KUTILS-EXAMPLE> (defun new-reference (l title)
(make-instance 'reference :link l :title title))
NEW-REFERENCE
KUTILS-EXAMPLE> (defclass class-b (class-a)
((tag :initarg :tag
:accessor tag-of)))
#<STANDARD-CLASS KUTILS-EXAMPLE::CLASS-B>
KUTILS-EXAMPLE> (defun new-class-b (n v tag)
(make-instance 'class-b :name n :value v :tag tag))
NEW-CLASS-B
KUTILS-EXAMPLE> (defclass class-c (class-a)
((initialised :initform nil)))
#<STANDARD-CLASS KUTILS-EXAMPLE::CLASS-C>
KUTILS-EXAMPLE> (defun new-class-c (n v)
(make-instance 'class-c :name n :value v))
NEW-CLASS-C
KUTILS-EXAMPLE> (defclass class-d (class-a)
((reference :initarg ref
:type reference
:accessor reference-of)))
#<STANDARD-CLASS KUTILS-EXAMPLE::CLASS-D>
KUTILS-EXAMPLE> (defun new-class-d (n v ref)
(make-instance 'class-a :name n :value v :ref ref))
NEW-CLASS-D
KUTILS-EXAMPLE> (defvar *class-d-table*
(yason:parse
;; there is an example.json in the docs directory
;; of kutils.
(read-file-as-string #P"/tmp/example.json")))
*CLASS-D-TABLE*
KUTILS-EXAMPLE> (let ((obj
(make-instance-from-hash-table
'class-d *class-d-table*)))
(describe obj)
(describe (reference-of obj)))
#<CLASS-D {1007F0B013}>
[standard-object]
Slots with :INSTANCE allocation:
NAME = "something"
VALUE = "just a thing"
REFERENCE = #<REFERENCE {1007F0A853}>
#<REFERENCE {1007F0A853}>
[standard-object]
Slots with :INSTANCE allocation:
LINK = "https://common-lisp.net/"
TITLE = "Common Lisp"
; No value