weeb struct: Implement JSON serialization

2 files changed, 65 insertions, 3 deletions

diff --git a/tests/struct.scm b/tests/struct.scm
index 01c984d..4eef204 100644
--- a/tests/struct.scm
+++ b/tests/struct.scm
@@ -48,11 +48,52 @@
   (define-struct <animal> species)
   (define-struct <dog> breed)
   (let ((my-dog (make-struct <dog> "Labrador")))
-    (test-assert (instance-of? <dog> my-dog))
-    (test-assert (not (instance-of? <animal> my-dog)))))
+    (test-assert (instance-of? my-dog <dog>))
+    (test-assert (not (instance-of? my-dog <animal>)))))
 
 (test-group "error-handling"
   (define-struct <empty>)
   (test-error #t (make-struct <empty> 1)))
 
+(test-group "json-serialization"
+  (define-struct <point> x y)
+  (define-struct <user> name age active)
+  (define-struct <empty>)
+
+  (let ((p (make-struct <point> 10 20)))
+    (test-equal (struct->json-string p) "{\"x\":10,\"y\":20}"))
+
+  (let ((p (make-struct <point> 10 20)))
+    (test-equal p (json-string->struct (record-type-descriptor p) (struct->json-string p))))
+
+  (let ((u (make-struct <user> "Bob" 42 #t)))
+    (test-equal (struct->json-string u) "{\"name\":\"Bob\",\"age\":42,\"active\":true}"))
+
+  (let ((u (make-struct <user> "Bob" 42 #t)))
+    (test-equal u (json-string->struct (record-type-descriptor u) (struct->json-string u))))
+
+  (let ((e (make-struct <empty>)))
+    (test-equal (struct->json-string e) "{}"))
+
+  (let ((e (make-struct <empty>)))
+    (test-equal (json-string->struct (record-type-descriptor e) "{}") e))
+
+  (let ((u (make-struct <user> "Alice" 30 #f)))
+    (let* ((json (struct->json-string u))
+           (u2 (json-string->struct (record-type-descriptor u) json)))
+      (test-equal u u2)))
+
+  (let ((p (make-struct <point> 1.5 2.5)))
+    (test-equal (json-string->struct (record-type-descriptor p) (struct->json-string p)) p))
+
+  (let ((u (make-struct <user> "" 0 #f)))
+    (test-equal (json-string->struct (record-type-descriptor u) (struct->json-string u)) u))
+
+  (let* ((p1 (make-struct <point> 1 2))
+         (p2 (make-struct <point> 3 4))
+         (json1 (struct->json-string p1))
+         (json2 (struct->json-string p2)))
+    (test-equal (json-string->struct (record-type-descriptor p1) json1) p1)
+    (test-equal (json-string->struct (record-type-descriptor p2) json2) p2)))
+
 (test-end "weeb-struct")
diff --git a/weeb/struct.scm b/weeb/struct.scm
index c3632f4..545c109 100644
--- a/weeb/struct.scm
+++ b/weeb/struct.scm
@@ -19,12 +19,15 @@
 (define-module (weeb struct)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (json)
   #:export (define-struct
             make-struct
             instance-of?
             with-accessors
             call-with-slots
-            ref))
+            ref
+            struct->json-string
+            json-string->struct))
 
 ;; Define a new record type with the given NAME and FIELDS.
 (define-syntax define-struct
@@ -88,3 +91,21 @@ instantiate the record's fields."
               (fields (cdr symbols)))
           (let ((quoted-fields (map (lambda (f) `',f) fields)))
             `(ref ,base-obj ,@quoted-fields)))))))
+
+(define (struct->json-string x)
+  (let ((descriptor (record-type-descriptor x)))
+    (scm->json-string
+     (map (lambda (field-name)
+            (cons
+             (symbol->string field-name)
+             ((record-accessor descriptor field-name) x)))
+          (record-type-fields descriptor)))))
+
+(define (json-string->struct type-descriptor x)
+  (let ((json-object (json-string->scm x)))
+    (apply
+     make-struct
+     type-descriptor
+     (map (lambda (field-name)
+            (assoc-ref json-object (symbol->string field-name)))
+          (record-type-fields type-descriptor)))))