better pre post args

xenomorph/xenomorph/array.rkt

@@ -92,8 +92,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Array.coffee
                  #:type [type-kwarg #f]
                  #:length [len-kwarg #f]
                  #:count-bytes [count-bytes? #f]
-                 #:subclass [class xarray%])
-  (new class [type (or type-arg type-kwarg)]
+                 #:pre-encode [pre-proc #f]
+                 #:post-decode [post-proc #f])
+  (new (generate-subclass xarray% pre-proc post-proc) [type (or type-arg type-kwarg)]
        [len (or len-arg len-kwarg)]
        [length-type (if count-bytes? 'bytes length-type-arg)]))
 

xenomorph/xenomorph/bitfield.rkt

@@ -34,10 +34,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Bitfield.coffee
 (define (+xbitfield [type-arg #f] [flag-arg #f]
                     #:type [type-kwarg #f]
                     #:flags [flag-kwarg #f]
-                    #:subclass [class xbitfield%])
+                    #:pre-encode [pre-proc #f]
+                    #:post-decode [post-proc #f])
   (define type (or type-arg type-kwarg))
   (define flags (or flag-arg flag-kwarg null))
-  (new class [type type] [flags flags]))
+  (new (generate-subclass xbitfield% pre-proc post-proc) [type type] [flags flags]))
 
 (module+ test
   (require rackunit "number.rkt" "generic.rkt")

xenomorph/xenomorph/buffer.rkt

@@ -34,6 +34,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Buffer.coffee
 
 (define (+xbuffer [len-arg #f]
                   #:length [len-kwarg #f]
-                  #:subclass [class xbuffer%])
+                  #:pre-encode [pre-proc #f]
+                  #:post-decode [post-proc #f])
   (define len (or len-arg len-kwarg #xffff))
-  (new class [len len]))
+  (new (generate-subclass xbuffer% pre-proc post-proc) [len len]))

xenomorph/xenomorph/enum.rkt

@@ -33,7 +33,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee
 (define (+xenum [type-arg #f] [values-arg #f]
                 #:type [type-kwarg #f]
                 #:values [values-kwarg #f]
-                #:subclass [class xenum%])
+                #:pre-encode [pre-proc #f]
+                #:post-decode [post-proc #f])
   (define type (or type-arg type-kwarg))
   (define values (or values-arg values-kwarg))
-  (new class [type type] [values values]))
+  (new (generate-subclass xenum% pre-proc post-proc) [type type] [values values]))

xenomorph/xenomorph/helper.rkt

@@ -19,26 +19,44 @@
 (define xenomorphic<%>
   (interface* ()
               ([(generic-property gen:xenomorphic)
-                (generic-method-table gen:xenomorphic                                      
-                                      (define (decode xo [port-arg (current-input-port)] #:parent [parent #f])
-                                        (define port
-                                          (cond
-                                            [(input-port? port-arg) port-arg]
-                                            [(bytes? port-arg) (open-input-bytes port-arg)]
-                                            [else (raise-argument-error 'decode "byte string or input port" port-arg)]))
-                                        (send xo decode port parent))
+                (generic-method-table
+                 gen:xenomorphic                                      
+                 (define (decode xo [port-arg (current-input-port)] #:parent [parent #f])
+                   (define port
+                     (cond
+                       [(input-port? port-arg) port-arg]
+                       [(bytes? port-arg) (open-input-bytes port-arg)]
+                       [else (raise-argument-error 'decode "byte string or input port" port-arg)]))
+                   (send xo decode port parent))
                                       
-                                      (define (encode xo val [port-arg (current-output-port)]
-                                                      #:parent [parent #f])
-                                        (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
-                                        (send xo xxencode val port parent)
-                                        (unless port-arg (get-output-bytes port)))
+                 (define (encode xo val [port-arg (current-output-port)]
+                                 #:parent [parent #f])
+                   (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
+                   (send xo xxencode val port parent)
+                   (unless port-arg (get-output-bytes port)))
                                       
-                                      (define (size xo [val #f] #:parent [parent #f])
-                                        (send xo xxsize val parent)))])))
+                 (define (size xo [val #f] #:parent [parent #f])
+                   (send xo xxsize val parent)))])))
 
 (define (xenomorphic-type? x) (is-a? x xenobase%))
 
+(define-syntax-rule (generate-subclass CLASS PRE-ENCODE-PROC POST-DECODE-PROC)
+  (cond
+    [(and PRE-ENCODE-PROC POST-DECODE-PROC)
+     (class CLASS
+       (super-new)
+       (define/override (pre-encode x) (super pre-encode (PRE-ENCODE-PROC x)))
+       (define/override (post-decode x) (POST-DECODE-PROC (super post-decode x))))]
+    [PRE-ENCODE-PROC
+     (class CLASS
+       (super-new)
+       (define/override (pre-encode x) (super pre-encode (PRE-ENCODE-PROC x))))]
+    [POST-DECODE-PROC
+     (class CLASS
+       (super-new)
+       (define/override (post-decode x) (POST-DECODE-PROC (super post-decode x))))]
+    [else CLASS]))
+
 (define xenobase%
   (class* object% (xenomorphic<%>)
     (super-new)

xenomorph/xenomorph/lazy-array.rkt

@@ -41,10 +41,11 @@ https://github.com/mbutterick/restructure/blob/master/src/LazyArray.coffee
 (define (+xlazy-array [type-arg #f] [len-arg #f]
                       #:type [type-kwarg #f]
                       #:length [len-kwarg #f]
-                      #:subclass [class xlazy-array%])
+                      #:pre-encode [pre-proc #f]
+                      #:post-decode [post-proc #f])
   (define type (or type-arg type-kwarg))
   (define len (or len-arg len-kwarg))
-  (new class [type type]
+  (new (generate-subclass xlazy-array% pre-proc post-proc) [type type]
        [len len]
        [length-type 'count]))
 

xenomorph/xenomorph/number.rkt

@@ -73,8 +73,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 (define (+xint [size 2]
                #:signed [signed #true]
                #:endian [endian system-endian]
-               #:subclass [class xint%])
-  (new class [size size] [signed signed] [endian endian]))
+                 #:pre-encode [pre-proc #f]
+                 #:post-decode [post-proc #f])
+  (new (generate-subclass xint% pre-proc post-proc) [size size] [signed signed] [endian endian]))
 
 (define int8 (+xint 1))
 (define int16 (+xint 2))
@@ -155,8 +156,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
     (define/augment (xxencode val . _)
       (real->floating-point-bytes val @size (eq? @endian 'be)))))
 
-(define (+xfloat [size 4] #:endian [endian system-endian])
-  (new xfloat% [size size] [endian endian]))
+(define (+xfloat [size 4] #:endian [endian system-endian]
+                 #:pre-encode [pre-proc #f]
+                 #:post-decode [post-proc #f])
+  (new (generate-subclass xfloat% pre-proc post-proc) [size size] [endian endian]))
 
 (define float (+xfloat 4))
 (define floatbe (+xfloat 4 #:endian 'be))
@@ -184,8 +187,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 (define (+xfixed [size 2]
                  #:signed [signed #true]
                  #:endian [endian system-endian]
-                 #:fracbits [fracbits (/ (* size 8) 2)])  
-  (new xfixed% [size size] [signed signed] [endian endian] [fracbits fracbits]))
+                 #:fracbits [fracbits (/ (* size 8) 2)]
+                 #:pre-encode [pre-proc #f]
+                 #:post-decode [post-proc #f])  
+  (new (generate-subclass xfixed% pre-proc post-proc) [size size] [signed signed] [endian endian] [fracbits fracbits]))
 
 (define fixed16 (+xfixed 2))
 (define fixed16be (+xfixed 2 #:endian 'be))

xenomorph/xenomorph/optional.rkt

@@ -35,10 +35,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee
 (define (+xoptional [type-arg #f] [cond-arg no-val]
                     #:type [type-kwarg #f]
                     #:condition [cond-kwarg no-val]
-                    #:subclass [class xoptional%])
+                    #:pre-encode [pre-proc #f]
+                    #:post-decode [post-proc #f])
   (define type (or type-arg type-kwarg))
   (define condition (cond
                       [(and (eq? cond-arg no-val) (eq? cond-kwarg no-val)) #true]
                       [(not (eq? cond-arg no-val)) cond-arg]
                       [(not (eq? cond-kwarg no-val)) cond-kwarg]))
-  (new class [type type] [condition condition]))
+  (new (generate-subclass xoptional% pre-proc post-proc) [type type] [condition condition]))

xenomorph/xenomorph/pointer.rkt

@@ -26,19 +26,19 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
 (define xpointer%
   (class xenobase%
     (super-new)
-    (init-field [(@offset-type offset-type)][(@type type)] [(@options options)])
-
-    (define pointer-relative-to (dict-ref @options 'relative-to))
-    (define allow-null (dict-ref @options 'allowNull)) 
-    (define null-value (dict-ref @options 'nullValue))
-    (define pointer-lazy? (dict-ref @options 'lazy))
+    (init-field [(@offset-type offset-type)]
+                [(@type type)]
+                [(@pointer-relative-to pointer-relative-to)]
+                [(@allow-null? allow-null?)]
+                [(@null-value null-value)]
+                [(@pointer-lazy? pointer-lazy?)])
 
     (define/augment (xxdecode port parent)
       (define offset (send @offset-type xxdecode port parent))
       (cond
-        [(and allow-null (= offset null-value)) #f] ; handle null pointers
+        [(and @allow-null? (= offset @null-value)) #f] ; handle null pointers
         [else
-         (define relative (+ (case pointer-relative-to
+         (define relative (+ (case @pointer-relative-to
                                [(local) (dict-ref parent '_startOffset)]
                                [(immediate) (- (pos port) (send @offset-type xxsize))]
                                [(parent) (dict-ref (dict-ref parent 'parent) '_startOffset)]
@@ -52,7 +52,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
                     (begin0
                       (send @type xxdecode port parent)
                       (pos port orig-pos)))
-                  (if pointer-lazy? (delay (decode-value)) (decode-value))]
+                  (if @pointer-lazy? (delay (decode-value)) (decode-value))]
            [else ptr])]))
 
     (define/augment (xxencode val-in port [parent #f])
@@ -60,12 +60,12 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
         (raise-argument-error 'xpointer-encode "valid pointer context" parent))
       (cond
         [val-in
-         (define new-parent (case pointer-relative-to
+         (define new-parent (case @pointer-relative-to
                               [(local immediate) parent]
                               [(parent) (dict-ref parent 'parent)]
                               [(global) (find-top-parent parent)]
                               [else (error 'unknown-pointer-style)]))
-         (define relative (+ (case pointer-relative-to
+         (define relative (+ (case @pointer-relative-to
                                [(local parent) (dict-ref new-parent 'startOffset)]
                                [(immediate) (+ (pos port) (send @offset-type xxsize val-in parent))]
                                [(global) 0])))
@@ -75,10 +75,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
                        (λ (ptrs) (append ptrs (list (mhasheq 'type type 'val val 'parent parent)))))
          (dict-set! new-parent 'pointerOffset
                     (+ (dict-ref new-parent 'pointerOffset) (send type xxsize val parent)))]
-        [else (send @offset-type xxencode null-value port)]))
+        [else (send @offset-type xxencode @null-value port)]))
 
     (define/augment (xxsize [val-in #f] [parent #f])
-      (define new-parent (case pointer-relative-to
+      (define new-parent (case @pointer-relative-to
                            [(local immediate) parent]
                            [(parent) (dict-ref parent 'parent)]
                            [(global) (find-top-parent parent)]
@@ -93,24 +93,23 @@ https://github.com/mbutterick/restructure/blob/master/src/Pointer.coffee
 (define (+xpointer [offset-arg #f] [type-arg #f]
                    #:offset-type [offset-kwarg #f]
                    #:type [type-kwarg #f]
-                   #:relative-to [relative-to 'local]
-                   #:lazy [lazy? #f]
+                   #:relative-to [pointer-relative-to 'local]
+                   #:lazy [pointer-lazy? #f]
                    #:allow-null [allow-null? #t]
                    #:null [null-value 0]
-                   #:subclass [class xpointer%])
+                   #:pre-encode [pre-proc #f]
+                   #:post-decode [post-proc #f])
   (define valid-pointer-relatives '(local immediate parent global))
-  (unless (memq relative-to valid-pointer-relatives)
-    (raise-argument-error '+xpointer (format "~v" valid-pointer-relatives) relative-to))
-  (define options (mhasheq 'relative-to relative-to
-                           'lazy lazy?
-                           'allowNull allow-null?
-                           'nullValue null-value))
+  (unless (memq pointer-relative-to valid-pointer-relatives)
+    (raise-argument-error '+xpointer (format "~v" valid-pointer-relatives) pointer-relative-to))
   (define type-in (or type-arg type-kwarg uint8))
-  (new class
+  (new (generate-subclass xpointer% pre-proc post-proc)
        [offset-type (or offset-arg offset-kwarg uint8)]
        [type (case type-in [(void) #f][else type-in])]
-       [options options]))
-
+       [pointer-relative-to pointer-relative-to]
+       [pointer-lazy? pointer-lazy?]
+       [allow-null? allow-null?]
+       [null-value null-value]))
 
 ;; A pointer whose type is determined at decode time
 (define xvoid-pointer% (class xenobase%

xenomorph/xenomorph/reserved.rkt

@@ -28,7 +28,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
 (define (+xreserved [type-arg #f] [count-arg #f]
                     #:type [type-kwarg #f]
                     #:count [count-kwarg #f]
-                    #:subclass [class xreserved%])
+                    #:pre-encode [pre-proc #f]
+                    #:post-decode [post-proc #f])
   (define type (or type-arg type-kwarg))
   (define count (or count-arg count-kwarg 1))
-  (new class [type type] [count count]))
+  (new (generate-subclass xreserved% pre-proc post-proc) [type type] [count count]))

xenomorph/xenomorph/string.rkt

@@ -79,10 +79,11 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
 (define (+xstring [len-arg #f] [enc-arg #f]
                   #:length [len-kwarg #f]
                   #:encoding [enc-kwarg #f]
-                  #:subclass [class xstring%])
+                  #:pre-encode [pre-proc #f]
+                  #:post-decode [post-proc #f])
   (define len (or len-arg len-kwarg))
   (define encoding (or enc-arg enc-kwarg 'ascii))
-  (new class [len len] [encoding encoding]))
+  (new (generate-subclass xstring% pre-proc post-proc) [len len] [encoding encoding]))
 
 (define xsymbol%
   (class xstring%
@@ -99,10 +100,11 @@ https://github.com/mbutterick/restructure/blob/master/src/String.coffee
 (define (+xsymbol [len-arg #f] [enc-arg #f]
                   #:length [len-kwarg #f]
                   #:encoding [enc-kwarg #f]
-                  #:subclass [class xsymbol%])
+                  #:pre-encode [pre-proc #f]
+                  #:post-decode [post-proc #f])
   (define len (or len-arg len-kwarg))
   (define encoding (or enc-arg enc-kwarg 'utf8))
-  (new class [len len] [encoding encoding]))
+  (new (generate-subclass xsymbol% pre-proc post-proc) [len len] [encoding encoding]))
 
 (module+ test
   (require rackunit "generic.rkt")

xenomorph/xenomorph/struct.rkt

@@ -42,7 +42,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
   (define h (make-hasheq))
   (for ([(k v) (in-dict x)]
         #:unless (memq k private-keys))
-       (hash-set! h k v))
+    (hash-set! h k v))
   h)
 
 (define xstruct%
@@ -79,9 +79,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
                             'pointerSize 0)) 
       (dict-set! parent 'pointerOffset (+ (pos port) (xxsize val parent #f))) 
       (for ([(key type) (in-dict @fields)])
-           (send type xxencode (dict-ref val key) port parent))
+        (send type xxencode (dict-ref val key) port parent))
       (for ([ptr (in-list (dict-ref parent 'pointers))])
-           (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port (dict-ref ptr 'parent))))
+        (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port (dict-ref ptr 'parent))))
     
     (define/augride (xxsize [val #f] [parent-arg #f] [include-pointers #t])
       (define parent (mhasheq 'parent parent-arg
@@ -89,36 +89,37 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
                               'pointerSize 0))
       (define fields-size (for/sum ([(key type) (in-dict @fields)]
                                     #:when (xenomorphic-type? type))
-                                   (send type xxsize (and val (dict-ref val key)) parent)))
+                            (send type xxsize (and val (dict-ref val key)) parent)))
       (define pointers-size (if include-pointers (dict-ref parent 'pointerSize) 0))
       (+ fields-size pointers-size))))
 
 (define (xstruct? x) (is-a? x xstruct%))
 
-(define (+xstruct #:subclass [class xstruct%] . dicts)
+(define (+xstruct #:pre-encode [pre-proc #f]
+                  #:post-decode [post-proc #f] . dicts)
   (define args (flatten dicts))
   (unless (even? (length args))
     (raise-argument-error '+xstruct "equal number of keys and values" dicts))
   (define fields (for/list ([kv (in-slice 2 args)])
-                           (unless (symbol? (car kv))
-                             (raise-argument-error '+xstruct "symbol" (car kv)))
-                           (apply cons kv)))
-  (new class [fields fields]))
+                   (unless (symbol? (car kv))
+                     (raise-argument-error '+xstruct "symbol" (car kv)))
+                   (apply cons kv)))
+  (new (generate-subclass xstruct% pre-proc post-proc) [fields fields]))
 
 (module+ test
   (require rackunit "number.rkt" "generic.rkt")
   (define (random-pick xs) (list-ref xs (random (length xs))))
   (check-exn exn:fail:contract? (λ () (+xstruct 42)))
   (for ([i (in-range 20)])
-       ;; make random structs and make sure we can round trip
-       (define field-types
-         (for/list ([i (in-range 40)])
-                   (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
-       (define size-num-types
-         (for/sum ([num-type (in-list field-types)])
-                  (size num-type)))
-       (define xs (+xstruct (for/list ([num-type (in-list field-types)])
-                                      (cons (gensym) num-type))))
-       (define bs (apply bytes (for/list ([i (in-range size-num-types)])
-                                         (random 256))))
-       (check-equal? (encode xs (decode xs bs) #f) bs)))
+    ;; make random structs and make sure we can round trip
+    (define field-types
+      (for/list ([i (in-range 40)])
+        (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
+    (define size-num-types
+      (for/sum ([num-type (in-list field-types)])
+        (size num-type)))
+    (define xs (+xstruct (for/list ([num-type (in-list field-types)])
+                           (cons (gensym) num-type))))
+    (define bs (apply bytes (for/list ([i (in-range size-num-types)])
+                              (random 256))))
+    (check-equal? (encode xs (decode xs bs) #f) bs)))

xenomorph/xenomorph/test/array-test.rkt

@@ -20,10 +20,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
 (test-case 
  "decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define myarray% (class xarray%
-                   (super-new)
-                   (define/override (post-decode val) (map (λ (x) (* 2 x)) val))))
-   (define xa (+xarray #:type uint8 #:length 4 #:subclass myarray%))
+   (define xa (+xarray #:type uint8 #:length 4 #:post-decode (λ (val) (map (λ (x) (* 2 x)) val))))
    (check-equal? (decode xa) '(2 4 6 8))))
 
 (test-case 
@@ -95,10 +92,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
 (test-case 
  "encode with pre-encode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define myarray% (class xarray%
-                   (super-new)
-                   (define/override (pre-encode val) (map (λ (x) (* 2 x)) val))))
-   (define xa (+xarray #:type uint8 #:length 4 #:subclass myarray%))
+   (define xa (+xarray #:type uint8 #:length 4 #:pre-encode (λ (val) (map (λ (x) (* 2 x)) val))))
    (check-equal? (encode xa '(1 2 3 4) #f) (bytes 2 4 6 8))))
 
 (test-case 

xenomorph/xenomorph/test/bitfield-test.rkt

@@ -36,10 +36,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
 (test-case
  "bitfield should decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))])
-   (define mybitfield% (class xbitfield%
-                         (super-new)
-                         (define/override (post-decode fh) (hash-set! fh 'foo 42) fh)))
-   (define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack) #:subclass mybitfield%))
+   (define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)                                                                      #:post-decode (λ (fh) (hash-set! fh 'foo 42) fh)))
    (check-equal? (decode bitfield) (mhasheq 'Quack #t
                                             'Nack #t
                                             'Lack #f
@@ -64,14 +61,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
 
 (test-case
  "bitfield should encode with pre-encode"
- (define mybitfield% (class xbitfield%
-                       (super-new)
-                       (define/override (pre-encode fh)
-                         (hash-set! fh 'Jack #f)
-                         (hash-set! fh 'Mack #f)
-                         (hash-set! fh 'Pack #f)
-                         fh)))
- (define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack) #:subclass mybitfield%))
+ (define bitfield (+xbitfield uint8 '(Jack Kack Lack Mack Nack Oack Pack Quack)
+                              #:pre-encode (λ (fh)
+                                              (hash-set! fh 'Jack #f)
+                                              (hash-set! fh 'Mack #f)
+                                              (hash-set! fh 'Pack #f)
+                                              fh)))
  (check-equal? (encode bitfield (mhasheq 'Quack #t
                                          'Nack #t
                                          'Lack #f

xenomorph/xenomorph/test/buffer-test.rkt

@@ -24,10 +24,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
 (test-case
  "buffer should decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
-   (define myboof% (class xbuffer%
-                         (super-new)
-                         (define/override (post-decode val) (bytes 1 2))))
-   (define buf (+xbuffer #:length 2 #:subclass myboof%))
+   (define buf (+xbuffer #:length 2 #:post-decode (λ (val) (bytes 1 2))))
    (check-equal? (decode buf) (bytes 1 2))
    (check-equal? (decode buf) (bytes 1 2))))
 
@@ -56,10 +53,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
 (test-case
  "encode should encode with pre-encode"
  (let ()
-   (define myboof% (class xbuffer%
-                         (super-new)
-                         (define/override (pre-encode val) (bytes 1 2))))
-   (define buf (+xbuffer 2 #:subclass myboof%))
+   (define buf (+xbuffer 2 #:pre-encode (λ (val) (bytes 1 2))))
    (check-equal? (bytes-append
                   (encode buf (bytes #xab #xff) #f)
                   (encode buf (bytes #x1f #xb6) #f)) (bytes 1 2 1 2))))

xenomorph/xenomorph/test/enum-test.rkt

@@ -35,12 +35,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
 (test-case
  "decode should decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 0))])
-   (define myenum% (class xenum%
-                         (super-new)
-                         (define/override (post-decode val) "foobar")))
    (define e2 (+xenum #:type uint8
                   #:values '("foo" "bar" "baz")
-                  #:subclass myenum%))
+                  #:post-decode (λ (val) "foobar")))
    (check-equal? (decode e2) "foobar")
    (check-equal? (decode e2) "foobar")
    (check-equal? (decode e2) "foobar")))
@@ -56,12 +53,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
 (test-case
  "encode should encode with pre-encode"
  (parameterize ([current-output-port (open-output-bytes)])
-   (define myenum% (class xenum%
-                         (super-new)
-                         (define/override (pre-encode val) "foo")))
    (define e2 (+xenum #:type uint8
                   #:values '("foo" "bar" "baz")
-                  #:subclass myenum%))
+                  #:pre-encode (λ (val) "foo")))
    (encode e2 "bar")
    (encode e2 "baz")
    (encode e2 "foo")

xenomorph/xenomorph/test/lazy-array-test.rkt

@@ -28,10 +28,7 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 (test-case
  "decode should decode items lazily with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define myxla% (class xlazy-array%
-                    (super-new)
-                    (define/override (post-decode str) (stream-map (λ (i) (* 2 i)) str))))
-   (define xla (+xlazy-array uint8 4 #:subclass myxla%))
+   (define xla (+xlazy-array uint8 4 #:post-decode (λ (str) (stream-map (λ (i) (* 2 i)) str))))
    (define arr (decode xla))
    (check-false (xarray? arr))
    (check-equal? (stream-length arr) 4)
@@ -72,9 +69,6 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 (test-case
  "encode should work with xlazy-arrays with pre-encode"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define myxla% (class xlazy-array%
-                    (super-new)
-                    (define/override (pre-encode str) (stream-map (λ (val) (* 2 val)) str))))
-   (define xla (+xlazy-array uint8 4 #:subclass myxla%))
+   (define xla (+xlazy-array uint8 4 #:pre-encode (λ (str) (stream-map (λ (val) (* 2 val)) str))))
    (define arr (decode xla))  
    (check-equal? (encode xla arr #f) (bytes 2 4 6 8))))

xenomorph/xenomorph/test/number-test.rkt

@@ -22,11 +22,9 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee
 
 (test-case
  "uint8: decode with post-decode, size, encode with pre-encode"
- (define myuint8% (class xint%
-                   (super-new)
-                   (define/override (post-decode int) #xdeadbeef)
-                   (define/override (pre-encode val) #xcc)))
- (define myuint8 (+xint 1 #:signed #f #:subclass myuint8%))
+ (define myuint8 (+xint 1 #:signed #f
+                        #:post-decode (λ (val) #xdeadbeef)
+                        #:pre-encode (λ (val) #xcc)))
  (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff))])
    (check-equal? (decode myuint8) #xdeadbeef)
    (check-equal? (decode myuint8) #xdeadbeef))

xenomorph/xenomorph/test/optional-test.rkt

@@ -21,10 +21,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee
 (test-case
  "decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 0))])
-   (define myxopt% (class xoptional%
-                         (super-new)
-                         (define/override (post-decode val) 42)))
-   (define optional (+xoptional #:type uint8 #:condition #f #:subclass myxopt%))
+   (define optional (+xoptional #:type uint8 #:condition #f #:post-decode (λ (val) 42)))
    (check-equal? (decode optional) 42)
    (check-equal? (pos (current-input-port)) 0)))
 
@@ -86,10 +83,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee
 (test-case
  "encode with pre-encode"
  (parameterize ([current-output-port (open-output-bytes)])
-   (define myxopt% (class xoptional%
-                         (super-new)
-                         (define/override (pre-encode val) 42)))
-   (define optional (+xoptional #:type uint8 #:subclass myxopt%))
+   (define optional (+xoptional #:type uint8 #:pre-encode (λ (val) 42)))
    (encode optional 128)
    (check-equal? (get-output-bytes (current-output-port)) (bytes 42))))
 

xenomorph/xenomorph/test/reserved-test.rkt

@@ -29,10 +29,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Reserved.coffee
 (test-case
  "should decode with post-decode"
  (parameterize ([current-input-port (open-input-bytes (bytes 0 0))])
-   (define myxres% (class xreserved%
-                     (super-new)
-                     (define/override (post-decode val) 42)))
-   (define reserved (+xreserved uint16be #:subclass myxres%))
+   (define reserved (+xreserved uint16be #:post-decode (λ (val) 42)))
    (check-equal? (decode reserved) 42)
    (check-equal? (pos (current-input-port)) 2)))
 
@@ -46,9 +43,6 @@ https://github.com/mbutterick/restructure/blob/master/test/Reserved.coffee
 (test-case
  "should encode with pre-encode"
  (parameterize ([current-output-port (open-output-bytes)])
-   (define myxres% (class xreserved%
-                         (super-new)
-                         (define/override (pre-encode val) 42)))
-   (define reserved (+xreserved uint32be #:subclass myxres%))
+   (define reserved (+xreserved uint32be #:pre-encode (λ (val) 42)))
    (encode reserved #f)
    (check-equal? (get-output-bytes (current-output-port)) (bytes 0 0 0 0))))

xenomorph/xenomorph/test/string-test.rkt

@@ -20,10 +20,7 @@ https://github.com/mbutterick/restructure/blob/master/test/String.coffee
 (test-case
  "decode fixed length with post-decode"
  (parameterize ([current-input-port (open-input-bytes #"testing")])
-   (define mystr% (class xstring%
-                     (super-new)
-                     (define/override (post-decode val) "ring a ding")))
-   (define xs (+xstring 7 #:subclass mystr%))
+   (define xs (+xstring 7 #:post-decode (λ (val) "ring a ding")))
    (check-equal? (decode xs) "ring a ding")))
 
 (test-case
@@ -92,10 +89,7 @@ https://github.com/mbutterick/restructure/blob/master/test/String.coffee
 (test-case
  "encode using string length and pre-encode"
  (parameterize ([current-output-port (open-output-bytes)])
-   (define mystr% (class xstring%
-                     (super-new)
-                     (define/override (pre-encode val) (list->string (reverse (string->list val))))))
-   (define xs (+xstring 7 #:subclass mystr%))
+   (define xs (+xstring 7 #:pre-encode (λ (val) (list->string (reverse (string->list val))))))
    (encode xs "testing")
    (check-equal? (get-output-bytes (current-output-port)) #"gnitset")))
 

xenomorph/xenomorph/test/struct-test.rkt

@@ -24,10 +24,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 (test-case
  "decode with process hook"
  (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
-   (define mystruct% (class xstruct%
-                       (super-new)
-                       (define/override (post-decode o) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o)))
-   (define struct (+xstruct #:subclass mystruct% 'name (+xstring #:length uint8) 'age uint8))
+   (define struct (+xstruct #:post-decode (λ (o) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o)
+                   'name (+xstring #:length uint8) 'age uint8))
    (check-equal? (decode struct)
                  (mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
 
@@ -67,11 +65,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 (test-case
  "support pre-encode hook"
  (parameterize ([current-output-port (open-output-bytes)])
-   (define mystruct% (class xstruct%
-                       (super-new)
-                       (define/override (pre-encode val)
-                         (dict-set! val 'nameLength (string-length (dict-ref val 'name))) val)))
-   (define struct (+xstruct #:subclass mystruct%
+   (define struct (+xstruct #:pre-encode (λ (val)
+                         (dict-set! val 'nameLength (string-length (dict-ref val 'name))) val)
                             'nameLength uint8
                             'name (+xstring 'nameLength)
                             'age uint8))

xenomorph/xenomorph/versioned-struct.rkt

@@ -16,7 +16,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
     (init-field [(@type type)] [(@versions versions)])
 
     (unless (for/or ([proc (list integer? procedure? xenomorphic-type? symbol?)])
-                    (proc @type))
+              (proc @type))
       (raise-argument-error '+xversioned-struct "integer, procedure, symbol, or xenomorphic" @type))
     (unless (and (dict? @versions) (andmap (λ (v) (or (dict? v) (xstruct? v))) (dict-values @versions)))
       (raise-argument-error '+xversioned-struct "dict of dicts or structish" @versions))
@@ -72,15 +72,15 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
       (define maybe-header-dict (dict-ref @versions 'header #f))
       (when maybe-header-dict
         (for ([(key type) (in-dict maybe-header-dict)])
-             (send type xxencode (dict-ref encode-me key) port parent)))
+          (send type xxencode (dict-ref encode-me key) port parent)))
 
       (define fields (extract-fields-dict encode-me))
       (unless (andmap (λ (key) (member key (dict-keys encode-me))) (dict-keys fields))
         (raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys encode-me)))
       (for ([(key type) (in-dict fields)])
-           (send type xxencode (dict-ref encode-me key) port parent))
+        (send type xxencode (dict-ref encode-me key) port parent))
       (for ([ptr (in-list (dict-ref parent 'pointers))])
-           (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port (dict-ref ptr 'parent))))
+        (send (dict-ref ptr 'type) xxencode (dict-ref ptr 'val) port (dict-ref ptr 'parent))))
     
     (define/override (xxsize [val #f] [parent-arg #f] [include-pointers #t])
       (unless val
@@ -93,15 +93,17 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
               (send @type xxsize (dict-ref val 'version) parent))))
       (define header-size
         (for/sum ([(key type) (in-dict (or (dict-ref @versions 'header #f) null))])
-                 (send type xxsize (and val (dict-ref val key)) parent)))
+          (send type xxsize (and val (dict-ref val key)) parent)))
       (define fields-size
         (for/sum ([(key type) (in-dict (extract-fields-dict val))])
-                 (send type xxsize (and val (dict-ref val key)) parent)))
+          (send type xxsize (and val (dict-ref val key)) parent)))
       (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0))
       (+ version-size header-size fields-size pointer-size))))
 
 (define (xversioned-struct? x) (is-a? x xversioned-struct%))
 
-(define (+xversioned-struct #:subclass [class xversioned-struct%] type [versions (dictify)])
-  (new class [type type] [versions versions][fields #f]))
+(define (+xversioned-struct type [versions (dictify)]
+                            #:pre-encode [pre-proc #f]
+                            #:post-decode [post-proc #f])
+  (new (generate-subclass xversioned-struct% pre-proc post-proc) [type type] [versions versions][fields #f]))