reserved

xenomorph/xenomorph/reserved.rkt

@@ -1,5 +1,5 @@
 #lang racket/base
-(require "helper.rkt" "util.rkt")
+(require racket/class "helper.rkt" "util.rkt")
 (provide (all-defined-out))
 
 #|
@@ -7,27 +7,28 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Reserved.coffee
 |#
 
-(define/post-decode (xreserved-decode xo [port-arg (current-input-port)] #:parent [parent #f])
+(define xreserved%
-  (define port (->input-port port-arg))
+  (class xenobase%
-  (pos port (+ (pos port) (size xo #f #:parent parent)))
+    (super-new)
-  (void))
+    (init-field type count)
 
-(define/pre-encode (xreserved-encode xo val [port-arg (current-output-port)] #:parent [parent #f])
+    (unless (xenomorphic-type? type)
-  (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
+      (raise-argument-error '+xoptional"xenomorphic type" type))
-  (write-bytes (make-bytes (size xo val #:parent parent) 0) port)
-  (unless port-arg (get-output-bytes port)))
 
-(define/finalize-size (xreserved-size xo [val #f] #:parent [parent #f])
+    (define/augment (xxdecode port parent)
-  (define item-size (size (xreserved-type xo)))
+      (pos port (+ (pos port) (xxsize #f parent)))
-  (define count (resolve-length (xreserved-count xo) #f #:parent parent))
+      (void))
-  (* item-size count))
 
-(struct xreserved xbase (type count) #:transparent
+    (define/augment (xxencode val port [parent #f])
-  #:methods gen:xenomorphic
+      (make-bytes (xxsize val parent) 0))
-  [(define decode xreserved-decode)
+    
-   (define xdecode xreserved-decode)
+    (define/augment (xxsize [val #f] [parent #f])
-   (define encode xreserved-encode)
+      (* (send type xxsize) (resolve-length count #f #:parent parent)))))
-   (define size xreserved-size)])
 
-(define (+xreserved type [count 1])
+(define (+xreserved [type-arg #f] [count-arg #f]
-  (xreserved type count))
+                    #:type [type-kwarg #f]
+                    #:count [count-kwarg #f]
+                    #:subclass [class xreserved%])
+  (define type (or type-arg type-kwarg))
+  (define count (or count-arg count-kwarg 1))
+  (new class [type type] [count count]))

xenomorph/xenomorph/test/reserved-test.rkt

@@ -1,8 +1,10 @@
 #lang racket/base
 (require rackunit
+         racket/class
          "../number.rkt"
          "../helper.rkt"
-         "../reserved.rkt")
+         "../reserved.rkt"
+         "../generic.rkt")
 
 #|
 approximates
@@ -27,8 +29,10 @@ 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 reserved (+xreserved uint16be))
+   (define myxres% (class xreserved%
-   (set-post-decode! reserved (λ (val) 42))
+                     (super-new)
+                     (define/override (post-decode val) 42)))
+   (define reserved (+xreserved uint16be #:subclass myxres%))
    (check-equal? (decode reserved) 42)
    (check-equal? (pos (current-input-port)) 2)))
 
@@ -42,7 +46,9 @@ 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 reserved (+xreserved uint32be))
+   (define myxres% (class xreserved%
-   (set-pre-encode! reserved (λ (val) 42))
+                         (super-new)
+                         (define/override (pre-encode val) 42)))
+   (define reserved (+xreserved uint32be #:subclass myxres%))
    (encode reserved #f)
    (check-equal? (get-output-bytes (current-output-port)) (bytes 0 0 0 0))))