diff options
| -rw-r--r-- | tests/struct.scm | 45 | ||||
| -rw-r--r-- | 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 <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))))) |