update test

xenomorph/xenomorph/redo/test/array-test.rkt

@@ -16,6 +16,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
    (check-equal? (decode (+xarray uint8 4)) '(1 2 3 4))))
 
+(test-case 
+ "decode with post-decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
+   (define xa (+xarray uint8 4))
+   (set-post-decode! xa (λ (val . _) (map (λ (x) (* 2 x)) val)))
+   (check-equal? (decode xa) '(2 4 6 8))))
+
 (test-case 
  "decode fixed number of bytes"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
@@ -82,6 +89,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
  "encode using array length"
  (check-equal? (encode (+xarray uint8 10) '(1 2 3 4) #f) (bytes 1 2 3 4)))
 
+(test-case 
+ "encode with pre-encode"
+ (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
+   (define xa (+xarray uint8 4))
+   (set-pre-encode! xa (λ (val . _) (map (λ (x) (* 2 x)) val)))
+   (check-equal? (encode xa '(1 2 3 4) #f) (bytes 2 4 6 8))))
+
 (test-case 
  "encode length as number before array"
  (check-equal? (encode (+xarray uint8 uint8) '(1 2 3 4) #f) (bytes 4 1 2 3 4)))

xenomorph/xenomorph/redo/test/bitfield-test.rkt

@@ -32,6 +32,20 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
                                             'Jack #t
                                             'Kack #f))))
 
+(test-case
+ "bitfield should decode with post-decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes (bitwise-ior JACK MACK PACK NACK QUACK)))])
+   (set-post-decode! bitfield (λ (fh . _) (hash-set! fh 'foo 42) fh))
+   (check-equal? (decode bitfield) (mhasheq 'Quack #t
+                                            'Nack #t
+                                            'Lack #f
+                                            'Oack #f
+                                            'Pack #t
+                                            'Mack #t
+                                            'Jack #t
+                                            'Kack #f
+                                            'foo 42))))
+
 (test-case
  "bitfield should encode"
  (check-equal? (encode bitfield (mhasheq 'Quack #t
@@ -43,3 +57,20 @@ https://github.com/mbutterick/restructure/blob/master/test/Bitfield.coffee
                                          'Jack #t
                                          'Kack #f) #f)
                (bytes (bitwise-ior JACK MACK PACK NACK QUACK))))
+
+(test-case
+ "bitfield should encode with pre-encode"
+ (set-pre-encode! bitfield (λ (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
+                                         'Oack #f
+                                         'Pack #t
+                                         'Mack #t
+                                         'Jack #t
+                                         'Kack #f) #f)
+               (bytes (bitwise-ior NACK QUACK))))

xenomorph/xenomorph/redo/test/buffer-test.rkt

@@ -17,6 +17,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
    (check-equal? (decode buf) (bytes #xab #xff))
    (check-equal? (decode buf) (bytes #x1f #xb6))))
 
+(test-case
+ "buffer should decode with post-decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
+   (define buf (+xbuffer 2))
+   (set-post-decode! buf (λ (bs) (bytes 1 2)))
+   (check-equal? (decode buf) (bytes 1 2))
+   (check-equal? (decode buf) (bytes 1 2))))
+
 (test-case
  "buffer should decode with parent key length"
  (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff #x1f #xb6))])
@@ -39,6 +47,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Buffer.coffee
                   (encode buf (bytes #xab #xff) #f)
                   (encode buf (bytes #x1f #xb6) #f)) (bytes #xab #xff #x1f #xb6))))
 
+(test-case
+ "encode should encode with pre-encode"
+ (let ([buf (+xbuffer 2)])
+   (set-pre-encode! buf (λ (bs) (bytes 1 2)))
+   (check-equal? (bytes-append
+                  (encode buf (bytes #xab #xff) #f)
+                  (encode buf (bytes #x1f #xb6) #f)) (bytes 1 2 1 2))))
+
 (test-case
  "encode should encode length before buffer"
  (check-equal? (encode (+xbuffer uint8) (bytes #xab #xff) #f) (bytes 2 #xab #xff)))

xenomorph/xenomorph/redo/test/enum-test.rkt

@@ -23,6 +23,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
    (check-equal? (decode e) "baz")
    (check-equal? (decode e) "foo")))
 
+(test-case
+ "decode should decode with post-decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes 1 2 0))])
+   (set-post-decode! e (λ (val) "foobar"))
+   (check-equal? (decode e) "foobar")
+   (check-equal? (decode e) "foobar")
+   (check-equal? (decode e) "foobar")))
+
 (test-case
  "encode should encode"
  (parameterize ([current-output-port (open-output-bytes)])
@@ -31,6 +39,17 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee
    (encode e "foo")
    (check-equal? (dump (current-output-port)) (bytes 1 2 0))))
 
+(test-case
+ "encode should encode with pre-encode"
+ (parameterize ([current-output-port (open-output-bytes)])
+   (set-pre-encode! e (λ (val) "foo"))
+   (encode e "bar")
+   (encode e "baz")
+   (encode e "foo")
+   (check-equal? (dump (current-output-port)) (bytes 0 0 0))))
+
 (test-case
  "should throw on unknown option"
+ (set-pre-encode! e values)
+ (set-post-decode! e values)
  (check-exn exn:fail:contract? (λ () (encode e "unknown" (open-output-bytes)))))

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

@@ -15,8 +15,8 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
 (test-case
  "decode should decode items lazily"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define array (+xlazy-array uint8 4))
-   (define arr (decode array))
+   (define xla (+xlazy-array uint8 4))
+   (define arr (decode xla))
    (check-false (xarray? arr))
    (check-equal? (stream-length arr) 4)
    (check-equal? (pos (current-input-port)) 4)
@@ -25,30 +25,52 @@ https://github.com/mbutterick/restructure/blob/master/test/LazyArray.coffee
    (check-equal? (stream-ref arr 2) 3)
    (check-equal? (stream-ref arr 3) 4)))
 
+(test-case
+ "decode should decode items lazily with post-decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
+   (define xla (+xlazy-array uint8 4))
+   (set-post-decode! xla (λ (val) (* 2 val)))
+   (define arr (decode xla))
+   (check-false (xarray? arr))
+   (check-equal? (stream-length arr) 4)
+   (check-equal? (pos (current-input-port)) 4)
+   (check-equal? (stream-ref arr 0) 2)
+   (check-equal? (stream-ref arr 1) 4)
+   (check-equal? (stream-ref arr 2) 6)
+   (check-equal? (stream-ref arr 3) 8)))
+
 (test-case
  "should be able to convert to an array"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define array (+xlazy-array uint8 4))
-   (define arr (decode array))
+   (define xla (+xlazy-array uint8 4))
+   (define arr (decode xla))
    (check-equal? (stream->list arr) '(1 2 3 4))))
 
 (test-case
  "decode should decode length as number before array"
  (parameterize ([current-input-port (open-input-bytes (bytes 4 1 2 3 4 5))])
-   (define array (+xlazy-array uint8 uint8))
-   (define arr (decode array))
+   (define xla (+xlazy-array uint8 uint8))
+   (define arr (decode xla))
    (check-equal? (stream->list arr) '(1 2 3 4))))
 
 (test-case
  "size should work with xlazy-arrays"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define array (+xlazy-array uint8 4))
-   (define arr (decode array))
-   (check-equal? (size array arr) 4)))
+   (define xla (+xlazy-array uint8 4))
+   (define arr (decode xla))
+   (check-equal? (size xla arr) 4)))
 
 (test-case
  "encode should work with xlazy-arrays"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
-   (define array (+xlazy-array uint8 4))
-   (define arr (decode array))  
-   (check-equal? (encode array arr #f) (bytes 1 2 3 4))))
+   (define xla (+xlazy-array uint8 4))
+   (define arr (decode xla))  
+   (check-equal? (encode xla arr #f) (bytes 1 2 3 4))))
+
+(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 xla (+xlazy-array uint8 4))
+   (set-pre-encode! xla (λ (vals) (map (λ (val) (* 2 val)) vals)))
+   (define arr (decode xla))  
+   (check-equal? (encode xla arr #f) (bytes 2 4 6 8))))

xenomorph/xenomorph/redo/test/number-test.rkt

@@ -17,6 +17,19 @@ https://github.com/mbutterick/restructure/blob/master/test/Number.coffee
    (encode uint8 #xff port)
    (check-equal? (dump port) (bytes #xab #xff))))
 
+(test-case
+ "uint8: decode with post-decode, size, encode with pre-encode"
+ (parameterize ([current-input-port (open-input-bytes (bytes #xab #xff))])
+   (set-post-decode! uint8 (λ (b) #xdeadbeef))
+   (check-equal? (decode uint8) #xdeadbeef)
+   (check-equal? (decode uint8) #xdeadbeef))
+ (check-equal? (size uint8) 1)
+ (let ([port (open-output-bytes)])
+   (set-pre-encode! uint8 (λ (b) #xcc))
+   (encode uint8 #xab port)
+   (encode uint8 #xff port)
+   (check-equal? (dump port) (bytes #xcc #xcc))))
+
 (test-case
  "uint16 is the same endianness as the platform"
  (check-equal? (decode uint16 (bytes 0 1))

xenomorph/xenomorph/redo/test/optional-test.rkt

@@ -16,6 +16,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee
    (check-equal? (decode optional) (void))
    (check-equal? (pos (current-input-port)) 0)))
 
+(test-case
+ "decode with post-decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes 0))])
+   (define optional (+xoptional uint8 #f))
+   (set-post-decode! optional (λ (val) 42))
+   (check-equal? (decode optional) 42)
+   (check-equal? (pos (current-input-port)) 0)))
+
 (test-case
  "decode should not decode when condition is a function and falsy"
  (parameterize ([current-input-port (open-input-bytes (bytes 0))])
@@ -71,6 +79,14 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee
    (encode optional 128)
    (check-equal? (dump (current-output-port)) (bytes))))
 
+(test-case
+ "encode with pre-encode"
+ (parameterize ([current-output-port (open-output-bytes)])
+   (define optional (+xoptional uint8))
+   (set-pre-encode! optional (λ (val) 42))
+   (encode optional 128)
+   (check-equal? (dump (current-output-port)) (bytes 42))))
+
 (test-case
  "encode should not encode when condition is a function and falsy"
  (parameterize ([current-output-port (open-output-bytes)])

xenomorph/xenomorph/redo/test/pointer-test.rkt

@@ -23,12 +23,12 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
    (check-equal? (decode (+xpointer uint8 uint8) #:parent (mhash '_startOffset 0)) 53)))
 
 (test-case
- "decode 'should support immediate offsets"
+ "decode should support immediate offsets"
  (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
    (check-equal? (decode (+xpointer uint8 uint8 (mhash 'type 'immediate))) 53)))
 
 (test-case
- "decode 'should support offsets relative to the parent"
+ "decode should support offsets relative to the parent"
  (parameterize ([current-input-port (open-input-bytes (bytes 0 0 1 53))])
    (pos (current-input-port) 2)
    (check-equal? (decode (+xpointer uint8 uint8 (mhash 'type 'parent))

xenomorph/xenomorph/redo/test/reserved-test.rkt

@@ -24,9 +24,25 @@ https://github.com/mbutterick/restructure/blob/master/test/Reserved.coffee
    (check-equal? (decode reserved) (void))
    (check-equal? (pos (current-input-port)) 2)))
 
+(test-case
+ "should decode with post-decode"
+ (parameterize ([current-input-port (open-input-bytes (bytes 0 0))])
+   (define reserved (+xreserved uint16be))
+   (set-post-decode! reserved (λ (val) 42))
+   (check-equal? (decode reserved) 42)
+   (check-equal? (pos (current-input-port)) 2)))
+
 (test-case
  "should encode"
  (parameterize ([current-output-port (open-output-bytes)])
    (define reserved (+xreserved uint16be))
    (encode reserved #f)
-   (check-equal? (dump (current-output-port)) (bytes 0 0))))
+   (check-equal? (dump (current-output-port)) (bytes 0 0))))
+
+(test-case
+ "should encode with pre-encode"
+ (parameterize ([current-output-port (open-output-bytes)])
+   (define reserved (+xreserved uint32be))
+   (set-pre-encode! reserved (λ (val) 42))
+   (encode reserved #f)
+   (check-equal? (dump (current-output-port)) (bytes 0 0 0 0))))

xenomorph/xenomorph/redo/test/string-test.rkt

@@ -15,6 +15,13 @@ https://github.com/mbutterick/restructure/blob/master/test/String.coffee
  (parameterize ([current-input-port (open-input-bytes #"testing")])
    (check-equal? (decode (+xstring 7)) "testing")))
 
+(test-case
+ "decode fixed length with post-decode"
+ (parameterize ([current-input-port (open-input-bytes #"testing")])
+   (define xs (+xstring 7))
+   (set-post-decode! xs (λ (val) "ring a ding"))
+   (check-equal? (decode xs) "ring a ding")))
+
 (test-case
  "decode length from parent key"
  (parameterize ([current-input-port (open-input-bytes #"testing")])
@@ -62,7 +69,7 @@ https://github.com/mbutterick/restructure/blob/master/test/String.coffee
  "should add size of length field before string"
  (check-equal? (size (+xstring uint8 'utf8) "🍻") 5))
 
-; todo: it 'should work with utf16be encoding', ->
+; todo: it "should work with utf16be encoding"
 
 (test-case
  "size should take null-byte into account"
@@ -78,6 +85,14 @@ https://github.com/mbutterick/restructure/blob/master/test/String.coffee
    (encode (+xstring 7) "testing")
    (check-equal? (dump (current-output-port)) #"testing")))
 
+(test-case
+ "encode using string length and pre-encode"
+ (parameterize ([current-output-port (open-output-bytes)])
+   (define xs (+xstring 7))
+   (set-pre-encode! xs (compose1 list->string reverse string->list))
+   (encode xs "testing")
+   (check-equal? (dump (current-output-port)) #"gnitset")))
+
 (test-case
  "encode length as number before string"
  (parameterize ([current-output-port (open-output-bytes)])

xenomorph/xenomorph/redo/test/struct-test.rkt

@@ -25,7 +25,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
  (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
    (define struct (+xstruct (dictify 'name (+xstring uint8)
                                      'age uint8)))
-   (set-xstruct-post-decode! struct (λ (o . _) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o))
+   (set-post-decode! struct (λ (o . _) (dict-set! o 'canDrink (>= (dict-ref o 'age) 21)) o))
    (check-equal? (dump (decode struct))
                  '((name . "roxyb") (canDrink . #t) (age . 32)))))
 
@@ -75,7 +75,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
    (define struct (+xstruct (dictify 'nameLength uint8
                                      'name (+xstring 'nameLength)
                                      'age uint8)))
-   (set-xstruct-pre-encode! struct (λ (val port) (dict-set! val 'nameLength (string-length (dict-ref val 'name))) val))
+   (set-pre-encode! struct (λ (val) (dict-set! val 'nameLength (string-length (dict-ref val 'name))) val))
    (encode struct (mhasheq 'name "roxyb" 'age 21))
    (check-equal? (dump (current-output-port)) #"\x05roxyb\x15")))
 

xenomorph/xenomorph/redo/test/versioned-struct-test.rkt

@@ -103,7 +103,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
                                      1 (dictify 'name (+xstring uint8 'utf8)
                                                 'age uint8
                                                 'gender uint8)))])
-   (set-xversioned-struct-post-decode! vstruct (λ (o stream parent) (dict-set! o 'processed "true") o))
+   (set-post-decode! vstruct (λ (val) (dict-set! val 'processed "true") val))
    (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
      (check-equal? (dump (decode vstruct))
                    '((processed . "true") (version . 0) (age . 21) (name . "roxyb"))))))
@@ -263,8 +263,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
                                                 'age uint8
                                                 'gender uint8)))]
        [stream (open-output-bytes)])
-   (set-xversioned-struct-pre-encode! vstruct
-                                      (λ (val port) (dict-set! val 'version (if (dict-ref val 'gender #f) 1 0)) val))
+   (set-pre-encode! vstruct (λ (val) (dict-set! val 'version (if (dict-ref val 'gender #f) 1 0)) val))
    (encode vstruct (mhasheq 'name "roxyb"
                             'age 21
                             'version 0) stream)

xenomorph/xenomorph/redo/versioned-struct.rkt

@@ -9,7 +9,7 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 |#
 
-(define (xversioned-struct-decode xvs [port-arg (current-input-port)] #:parent [parent #f] [length 0])
+(define/post-decode (xversioned-struct-decode xvs [port-arg (current-input-port)] #:parent [parent #f] [length 0])
   (define port (->input-port port-arg))
   (define res (_setup port parent length))
 
@@ -28,13 +28,12 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
   (define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref res 'version #f) #f)
                      (raise-argument-error 'xversioned-struct-decode "valid version key" (cons version (xversioned-struct-versions xvs)))))
     
-  ((xversioned-struct-post-decode xvs)
-   (cond
+  (cond
      [(xversioned-struct? fields) (decode fields port #:parent parent)]
      [else (_parse-fields port res fields)
-           res]) port parent))
+           res]))
 
-(define (xversioned-struct-size xvs [val #f] #:parent [parent-arg #f] [include-pointers #t])
+(define/finalize-size (xversioned-struct-size xvs [val #f] #:parent [parent-arg #f] [include-pointers #t])
   (unless val
     (raise-argument-error 'xversioned-struct-size "value" val))
   (define parent (mhash 'parent parent-arg 'val val 'pointerSize 0))
@@ -51,13 +50,11 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
       (for/sum ([(key type) (in-dict fields)])
         (size type (and val (dict-ref val key)) #:parent parent))))
   (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0))
-  (finalize-size (+ version-size header-size fields-size pointer-size)))
+  (+ version-size header-size fields-size pointer-size))
 
-(define (xversioned-struct-encode xvs val-arg [port-arg (current-output-port)] #:parent [parent-arg #f])
+(define/pre-encode (xversioned-struct-encode xvs val [port-arg (current-output-port)] #:parent [parent-arg #f])
   (define port (if (output-port? port-arg) port-arg (open-output-bytes)))
   (parameterize ([current-output-port port])
-  (define val ((xversioned-struct-pre-encode xvs) val-arg port))
-
   (unless (dict? val)
     (raise-argument-error 'xversioned-struct-encode "dict" val))
 
@@ -88,7 +85,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
   
   (unless port-arg (get-output-bytes port))))
 
-(struct xversioned-struct structish (type versions version-getter version-setter pre-encode post-decode) #:transparent #:mutable
+(struct xversioned-struct structish (type versions version-getter version-setter) #:transparent #:mutable
   #:methods gen:xenomorphic
   [(define decode xversioned-struct-decode)
    (define encode xversioned-struct-encode)
@@ -106,7 +103,5 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
   (define version-setter (cond
                            [(procedure? type) type]
                            [(symbol? type) (λ (parent version) (dict-set! parent type version))]))
-  (define (no-op-pre-encode val port) val)
-  (define (no-op-post-decode xvs port parent) xvs)
-  (xversioned-struct type versions version-getter version-setter no-op-pre-encode no-op-post-decode))
+  (xversioned-struct type versions version-getter version-setter))