Converting structs to vectors and json (in the form of jsexprs).

more-struct-converters.rkt

#lang racket

(require (for-syntax racket/sequence
                     racket/symbol
                     racket/syntax
                     rebellion/collection/vector
                     syntax/parse/class/struct-id)
         syntax/parse/define)

;@------------------------------------------------------------------------------

(struct point (x y) #:transparent)

(begin-for-syntax
  (define (remove-common-identifier-prefix ids)
    (define id-list (sequence->list ids))
    (define id-strings
      (for/list ([id id-list]) (symbol->immutable-string (syntax-e id))))
    (define prefix-length (find-common-prefix-length id-strings))
    (for/list ([id id-list])
      (define id-str (symbol->immutable-string (syntax-e id)))
      (define new-id-symbol (string->symbol (substring id-str prefix-length)))
      (datum->syntax id new-id-symbol)))

  (define (find-common-prefix-length sequences)
    (define vecs (for/vector ([seq sequences]) (sequence->vector seq)))
    (define (same-element-at-index i)
      (define expected (vector-ref (vector-ref vecs 0) i))
      (for/and ([vec (in-vector vecs)])
        (equal? (vector-ref vec i) expected)))
    (define (compute-length known-prefix-length)
      (if (same-element-at-index known-prefix-length)
          (compute-length (add1 known-prefix-length))
          known-prefix-length))
    (compute-length 0)))


(define-simple-macro (define-struct-vector-converters id:struct-id)
  #:with instance->vector (format-id #'id "~a->vector" #'id)
  #:with vector->instance (format-id #'id "vector->~a" #'id)
  #:with (field-index ...)
    (for/list ([i (in-range (attribute id.num-fields))]) #`'#,i)
  (begin
    (define (instance->vector instance) (vector (id.accessor-id instance) ...))
    (define (vector->instance vec)
      (id.constructor-id (vector-ref vec field-index) ...))))

(define-simple-macro (define-struct-jsexpr-converters id:struct-id)
  #:with instance->jsexpr (format-id #'id "~a->jsexpr" #'id)
  #:with jsexpr->instance (format-id #'id "jsexpr->~a" #'id)
  #:with (field-index ...)
    (for/list ([i (in-range (attribute id.num-fields))]) #`'#,i)
  #:with (field-id ...)
    (remove-common-identifier-prefix (attribute id.accessor-id))
  (begin
    (define (instance->jsexpr instance)
      (hash (~@ 'field-id (id.accessor-id instance)) ...))
    (define (jsexpr->instance jsexpr)
      (id.constructor-id (hash-ref jsexpr 'field-id) ...))))

(define-struct-vector-converters point)
(define-struct-jsexpr-converters point)

point->vector
vector->point
point->jsexpr
jsexpr->point

(point->vector (point 2 5))
(point->jsexpr (point 2 5))

(vector->point (vector 2 5))
(jsexpr->point (hash 'x 2 'y 5))