json: Add support for record-to-json conversion.

* jupyter/json.scm (define-json-writer): New macro.
(define-json-mapping): Add support for defining writers.

jupyter/json.scm

@@ -46,15 +46,44 @@ following SPEC, a series of field specifications."
                                                 (symbol->string 'field))))))
         (ctor (extract-field table spec) ...)))))
 
-(define-syntax-rule (define-json-mapping rtd ctor pred json->record
-                      (field getter spec ...) ...)
-  "Define RTD as a record type with the given FIELDs and GETTERs, à la SRFI-9,
-and define JSON->RECORD as a conversion from JSON to a record of this type."
-  (begin
-    (define-record-type rtd
-      (ctor field ...)
-      pred
-      (field getter) ...)
+(define-syntax-rule (define-json-writer record->json
+                      (field-spec ...) ...)
+  "Define RECORD->JSON as a procedure that returns an alist, the Guile-JSON
+representation of the given record."
+  (define (record->json record)
+    (let-syntax ((field->alist (syntax-rules ()
+                                 ((_ field getter)
+                                  (cons (symbol->string 'field)
+                                        (getter record)))
+                                 ((_ field getter key _ value->json)
+                                  (cons key
+                                        (value->json (getter record))))
+                                 ((_ field getter key _ (... ...))
+                                  (cons key
+                                        (getter record))))))
+      (list (field->alist field-spec ...) ...))))
 
-    (define-json-reader json->record ctor
-      (field spec ...) ...)))
+(define-syntax define-json-mapping
+  (syntax-rules (<=>)
+    "Define RTD as a record type with the given FIELDs and GETTERs, à la SRFI-9,
+and define JSON->RECORD as a conversion from JSON to a record of this type.
+Optionally, define RECORD->JSON as the conversion from a record of this type
+to its JSON representation (an alist)."
+    ((_ rtd ctor pred json->record <=> record->json
+        (field getter spec ...) ...)
+     (begin
+       (define-json-mapping rtd ctor pred json->record
+         (field getter spec ...) ...)
+
+       (define-json-writer record->json
+         (field getter spec ...) ...)))
+    ((_ rtd ctor pred json->record
+        (field getter spec ...) ...)
+     (begin
+       (define-record-type rtd
+         (ctor field ...)
+         pred
+         (field getter) ...)
+
+       (define-json-reader json->record ctor
+         (field spec ...) ...)))))