From 5a6fcf57ed956fc98c48f672559809f0cdf66c6b Mon Sep 17 00:00:00 2001 From: Jakob L. Kreuze Date: Fri, 17 Jul 2026 12:05:44 -0400 Subject: weeb struct: Implement JSON serialization --- tests/struct.scm | 45 +++++++++++++++++++++++++++++++++++++++++++-- weeb/struct.scm | 23 ++++++++++++++++++++++- 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 species) (define-struct breed) (let ((my-dog (make-struct "Labrador"))) - (test-assert (instance-of? my-dog)) - (test-assert (not (instance-of? my-dog))))) + (test-assert (instance-of? my-dog )) + (test-assert (not (instance-of? my-dog ))))) (test-group "error-handling" (define-struct ) (test-error #t (make-struct 1))) +(test-group "json-serialization" + (define-struct x y) + (define-struct name age active) + (define-struct ) + + (let ((p (make-struct 10 20))) + (test-equal (struct->json-string p) "{\"x\":10,\"y\":20}")) + + (let ((p (make-struct 10 20))) + (test-equal p (json-string->struct (record-type-descriptor p) (struct->json-string p)))) + + (let ((u (make-struct "Bob" 42 #t))) + (test-equal (struct->json-string u) "{\"name\":\"Bob\",\"age\":42,\"active\":true}")) + + (let ((u (make-struct "Bob" 42 #t))) + (test-equal u (json-string->struct (record-type-descriptor u) (struct->json-string u)))) + + (let ((e (make-struct ))) + (test-equal (struct->json-string e) "{}")) + + (let ((e (make-struct ))) + (test-equal (json-string->struct (record-type-descriptor e) "{}") e)) + + (let ((u (make-struct "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 1.5 2.5))) + (test-equal (json-string->struct (record-type-descriptor p) (struct->json-string p)) p)) + + (let ((u (make-struct "" 0 #f))) + (test-equal (json-string->struct (record-type-descriptor u) (struct->json-string u)) u)) + + (let* ((p1 (make-struct 1 2)) + (p2 (make-struct 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))))) -- cgit v1.3