Metaobject utilities

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

kutils » Metaobject utilities