recursive schema definition

telebot/api.rkt

@@ -20,15 +20,15 @@
   (chat chat)
   (text (optional string?)))
 
-(define-schema reply-params
-  (message-id integer?))
-
 (define-schema response
   (chat-id integer?)
   (text string?)
   (parse-mode (optional string?))
   (reply (optional reply-params) "reply_parameters"))
 
+(define-schema reply-params
+  (message-id integer?))
+
 (define-schema update
   (id integer? "update_id")
   (message (optional message)))

telebot/private/schema.rkt

@@ -83,7 +83,14 @@
              #:with struct-id (schema-info-struct-id local-value)
              #:attr fields (schema-info-fields local-value)
              #:with from-jsexpr (schema-info-from-jsexpr local-value)
-             #:with to-jsexpr (schema-info-to-jsexpr local-value)))
+             #:with to-jsexpr (schema-info-to-jsexpr local-value))
+    ;; this clause is a temporal fallback for recursive schema definition
+    ;; TODO: distinguish the strict and the loose situation
+    (pattern id:id
+             #:attr struct-id #f
+             #:attr fields '()
+             #:attr from-jsexpr #f
+             #:attr to-jsexpr #f))
 
   (define-syntax-class schema/opt
     #:literals (optional)
@@ -100,8 +107,8 @@
                  (kebab-case->snake-case/id #'name))
              #:with schema #'type+.type
              #:attr opt? (attribute type+.opt?)
-             #:with from-jsexpr #'type+.type.from-jsexpr
-             #:with to-jsexpr #'type+.type.to-jsexpr))
+             #:attr from-jsexpr (attribute type+.type.from-jsexpr)
+             #:attr to-jsexpr (attribute type+.type.to-jsexpr)))
 
   (define-syntax-class ref-key
     #:attributes (trimed)
@@ -127,6 +134,12 @@
      #:with ctor-id (format-id #'name "make-~a" #'name)
      #:with jsexpr->name (format-id #'name "jsexpr->~a" #'name)
      #:with name->jsexpr (format-id #'name "~a->jsexpr" #'name)
+
+     (syntax-local-lift-module-end-declaration
+      #'(begin
+          (define-jsexpr->schema name jsexpr->name)
+          (define-schema->jsexpr name name->jsexpr)))
+
      #'(begin
          (struct name (fld.name ...)
            ;; #:constructor-name struct-ctor-id
@@ -139,17 +152,13 @@
            (schema-info #'name
                         (list #'fld ...)
                         #'jsexpr->name
-                        #'name->jsexpr))
-
-         (define-jsexpr->schema name)
-         (define-schema->jsexpr name))]))
+                        #'name->jsexpr)))]))
 
 (define-syntax (define-jsexpr->schema stx)
   (syntax-parse stx
-    [(_ schema:schema-id)
+    [(_ schema:schema-id jsexpr->schema:id)
      #:do [(define schema-info (attribute schema.info))
            (define fields (schema-info-fields schema-info))]
-     #:with jsexpr->schema (schema-info-from-jsexpr schema-info)
      #:with struct-id (schema-info-struct-id schema-info)
      #:with (field-value ...)
      (for/list ([fld (in-list fields)])
@@ -166,20 +175,19 @@
 
 (define-syntax (define-schema->jsexpr stx)
   (syntax-parse stx
-    [(_ schema:schema-id)
+    [(_ schema:schema-id schema->jsexpr:id)
      #:do [(define schema-info (attribute schema.info))
            (define fields (schema-info-fields schema-info))]
-     #:with schema->jsexpr (schema-info-to-jsexpr schema-info)
      #:with struct-id (schema-info-struct-id schema-info)
      #:with (set-field-value ...)
      (for/list ([fld (in-list fields)])
        (syntax-parse fld
          [fld:field
           #:with accessor (format-id #'struct-id "~a-~a" #'struct-id #'fld.name)
           (if (attribute fld.opt?)
-              #'(let ([fld-v (accessor data)])
-                  (unless (json-undefined? fld-v)
-                    (hash-set! jsexpr 'fld.key (fld.to-jsexpr fld-v))))
+              #'(let ([fld-val (accessor data)])
+                  (unless (json-undefined? fld-val)
+                    (hash-set! jsexpr 'fld.key (fld.to-jsexpr fld-val))))
               #'(hash-set! jsexpr 'fld.key (fld.to-jsexpr (accessor data))))]))
      #'(define (schema->jsexpr data)
          (let ([jsexpr (make-hash)])