Support json-type (:hash-table object)

.gitignore

@@ -0,0 +1,19 @@
+*.FASL
+*.abcl
+*.d64fsl
+*.dfsl
+*.dx32fsl
+*.dx64fsl
+*.fasl
+*.fx32fsl
+*.fx64fsl
+*.lisp-temp
+*.lx32fsl
+*.lx64fsl
+*.p64fsl
+*.pfsl
+*.sx32fsl
+*.sx64fsl
+*.wx32fsl
+*.wx64fsl
+*~

README.md

@@ -33,11 +33,11 @@ Type          | Remarks
 `:bool`       | Maps `T` and `NIL` with `true` and `false`
 `<symbol>`    | Uses a `(:metaclass json-serializable-class)` class definition to direct the transformation of the value
 
-### Homogeneous sequences
+### Homogeneous sequences and objects
 
 In addition, the type specifier may be a list of two elements, first
-element is one of `:list`, `:vector`; the second is any JSON type
-specifier that is to be applied to the elements of the list.
+element is one of `:list`, `:vector`, `:hash-table`; the second is any JSON type
+specifier that is to be applied to the elements of the list or the values of the hash-table.
 
 ### NIL and null semantics
 

src/to-json.lisp

@@ -67,6 +67,20 @@
   "Return the boolean false"
   'false)
 
+(defclass homogeneous-hash-table-intermediate-class ()
+  ((values :initarg :values)
+   (hash-table-json-type :initarg :hash-table-json-type)
+   (element-json-type :initarg :element-json-type)))
+
+(defmethod to-json-value ((value hash-table) (json-type cons))
+  "Return the homogeneous hash-table VALUE"
+  (ecase (first json-type)
+    (:hash-table (check-type value hash-table)))
+  (make-instance 'homogeneous-hash-table-intermediate-class
+                 :values value
+                 :hash-table-json-type (first json-type)
+                 :element-json-type (second json-type)))
+
 (defmethod to-json-value ((value sequence) (json-type cons))
   "Return the homogeneous sequence VALUE"
   (ecase (first json-type)
@@ -107,6 +121,19 @@
              values))))
   sequence)
 
+(defmethod encode ((hash-table homogeneous-hash-table-intermediate-class)
+                   &optional (stream *standard-output*))
+  (with-output (stream)
+    (with-object ()
+      (with-slots (values hash-table-json-type element-json-type)
+	  hash-table
+        (maphash (lambda (key value)
+                       (encode-object-element
+			(to-json-value key :string)
+			(to-json-value value element-json-type)))
+		 values))))
+  hash-table)
+
 (defmethod encode ((object json-serializable)
                    &optional (stream *standard-output*))
   (with-output (stream)

src/to-lisp.lisp

@@ -51,6 +51,18 @@
   "Return the hash-table VALUE"
   value)
 
+(defmethod to-lisp-value ((value hash-table) (json-type cons))
+  "Return the homogeneous hash-table VALUE"
+  (destructuring-bind (hash-keyword out-type)
+                      json-type
+    (ecase hash-keyword
+      (:hash-table
+       (let ((out (make-hash-table :test 'equal :size (hash-table-size value))))
+         (maphash (lambda (k v)
+                    (setf (gethash k out) (to-lisp-value v out-type)))
+                  value)
+         out)))))
+
 (defmethod to-lisp-value ((value vector) (json-type (eql :vector)))
   "Return the vector VALUE"
   value)

tests/encode-decode.lisp

@@ -73,6 +73,11 @@
     (is (equalp (get-any-hash-table obj)
                 (get-any-hash-table (obj-rt obj))))))
 
+(test obj-hash-table
+  (for-all ((obj (gen-object)))
+    (is (equalp (get-obj-hash-table obj)
+		(get-obj-hash-table (obj-rt obj))))))
+
 (test inheritance-encode
   (let ((child (make-instance 'child))
         (parent-only (make-instance 'parent)))

tests/tests.lisp

@@ -39,6 +39,10 @@
              :reader get-any-hash-table
              :json-type :any
              :json-key "anyHash")
+   (obj-hash :initarg :obj-hash-table
+             :reader get-obj-hash-table
+             :json-type (:hash-table (:vector :string))
+             :json-key "objHash")
    (vector :initarg :vector
            :reader get-vector
            :json-type :vector
@@ -116,6 +120,9 @@
                      (string (gen-string))
                      (number (gen-float))
                      (hash-table (gen-hash-table))
+		     (obj-hash-table
+		      (gen-hash-table
+		       :elements (gen-vector :elements (gen-string))))
                      (vector (gen-vector))
                      (list (gen-list))
                      (bool (gen-bool))
@@ -129,6 +136,7 @@
                    :number (funcall number)
                    :hash-table (funcall hash-table)
                    :any-hash-table (funcall hash-table)
+                   :obj-hash-table (funcall obj-hash-table)
                    :vector (funcall vector)
                    :list (funcall list)
                    :bool (funcall bool)