resume in subversioned structs

pitfall/restructure/generic.rkt

@@ -16,6 +16,9 @@
   ([hash? (define ref hash-ref)
           (define ref-set! hash-set!)
           (define ref-keys hash-keys)]
+   [dict? (define ref dict-ref)
+          (define ref-set! dict-set!)
+          (define ref-keys dict-keys)]
    [object? (define (ref o i) (with-handlers ([exn:fail:object? (λ (exn) (hash-ref (get-field _hash o) i))]) (dynamic-get-field i o)))
             (define (ref-set! o i v) (with-handlers ([exn:fail:object? (λ (exn) (hash-set! (get-field _hash o) i v))]) (dynamic-set-field! i o v)))
             (define (ref-keys o) (append (remove '_hash (field-names o)) (hash-keys (get-field _hash o))))]))

pitfall/restructure/main.rkt

@@ -3,6 +3,7 @@
 (r+p "base.rkt"
      "number.rkt"
      "struct.rkt"
+     "versioned-struct.rkt"
      "string.rkt"
      "array.rkt"
      "lazy-array.rkt"
@@ -14,6 +15,7 @@
 (test-module
  (require "number-test.rkt"
           "struct-test.rkt"
+          "versioned-struct-test.rkt"
           "string-test.rkt"
           "array-test.rkt"
           "lazy-array-test.rkt"

pitfall/restructure/versioned-struct-test.rkt

@@ -30,6 +30,28 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;        name: 'devon 👍'
 ;        age: 21
 ;        gender: 0
+
+(let ([struct (+VersionedStruct uint8
+                                (dictify
+                                 0 (dictify 'name (+StringT uint8 'ascii)
+                                            'age uint8)
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'age uint8
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0000\u0005devon\u0015"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon"
+                                                                 'age 21
+                                                                 'version 0)))
+
+  (let ([stream (+DecodeStream (+Buffer "\u0001\u000adevon 👍\u0015\u0000"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍"
+                                                                 'age 21
+                                                                 'version 1
+                                                                 'gender 0))))
+
+
+
 ;
 ;    it 'should throw for unknown version', ->
 ;      struct = new VersionedStruct uint8,
@@ -44,6 +66,19 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;      stream = new DecodeStream new Buffer '\x05\x05devon\x15'
 ;      should.throw ->
 ;        struct.decode(stream)
+
+
+(let ([struct (+VersionedStruct uint8
+                                (dictify
+                                 0 (dictify 'name (+StringT uint8 'ascii)
+                                            'age uint8)
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'age uint8
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0005\u0005devon\u0015"))])
+    (check-exn exn:fail:contract? (λ () (send struct decode stream)))))
+
 ;
 ;    it 'should support common header block', ->
 ;      struct = new VersionedStruct uint8,
@@ -70,6 +105,29 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;        alive: 1
 ;        name: 'devon 👍'
 ;        gender: 0
+
+
+(let ([struct (+VersionedStruct uint8
+                                (dictify
+                                 'header (dictify 'age uint8
+                                                  'alive uint8)
+                                 0 (dictify 'name (+StringT uint8 'ascii))
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0000\u0015\u0001\u0005devon"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon"
+                                                                 'age 21
+                                                                 'alive 1
+                                                                 'version 0)))
+
+  (let ([stream (+DecodeStream (+Buffer "\u0001\u0015\u0001\u000adevon 👍\u0000"))])
+    (check-equal? (send (send struct decode stream) ht) (mhasheq 'name "devon 👍"
+                                                                 'age 21
+                                                                 'version 1
+                                                                 'alive 1
+                                                                 'gender 0))))
+
 ;
 ;    it 'should support parent version key', ->
 ;      struct = new VersionedStruct 'version',
@@ -93,6 +151,26 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
 ;        name: 'devon 👍'
 ;        age: 21
 ;        gender: 0
+
+(let ([struct (+VersionedStruct 'version
+                                (dictify
+                                 0 (dictify 'name (+StringT uint8 'ascii)
+                                            'age uint8)
+                                 1 (dictify 'name (+StringT uint8 'utf8)
+                                            'age uint8
+                                            'gender uint8)))])
+
+  (let ([stream (+DecodeStream (+Buffer "\u0005devon\u0015"))])
+    (check-equal? (send (send struct decode stream (mhash 'version 0)) ht) (mhasheq 'name "devon"
+                                                                                    'age 21
+                                                                                    'version 0)))
+
+  (let ([stream (+DecodeStream (+Buffer "\u000adevon 👍\u0015\u0000" 'utf8))])
+    (check-equal? (send (send struct decode stream (mhash 'version 1)) ht) (mhasheq 'name "devon 👍"
+                                                                                    'age 21
+                                                                                    'version 1
+                                                                                    'gender 0))))
+
 ;
 ;    it 'should support sub versioned structs', ->
 ;      struct = new VersionedStruct uint8,

pitfall/restructure/versioned-struct.rkt

@@ -8,45 +8,47 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
 |#
 
 (define-subclass Struct (VersionedStruct type [versions (dictify)])
+  
   (unless ((disjoin integer? procedure? RestructureBase? symbol?) type)
     (raise-argument-error 'VersionedStruct "integer, function, symbol, or Restructure object" type))
   (unless (and (dict? versions) (andmap (λ (val) (or (dict? val) (Struct? val))) (map cdr versions)))
     (raise-argument-error 'VersionedStruct "dict of dicts or Structs" versions))
+
+  (inherit _setup  _parseFields process)
   (inherit-field fields)
-  (field [forced-version #f])
+  (field [forced-version #f]
-  
+         [versionGetter void]
-  (define/public-final (force-version! version)
+         [versionSetter void])
-    (set! forced-version version))
+
+  (when (symbol? type) ; instead of string
+    (set-field! versionGetter this (λ (parent) (ref parent type)))
+    (set-field! versionSetter this (λ (parent version) (ref-set! parent type version))))
 
-  (define/public (resolve-version [stream #f] [parent #f])
-    (cond
-      [forced-version] ; for testing purposes: pass an explicit version
-      [(integer? type) type]
-      [(symbol? type)
-       ;; find the first Struct in the chain of ancestors
-       ;; with the target key
-       (let loop ([x parent])
-         (cond
-           [(and x (Struct? x) (dict-ref (· x res) type #f))]
-           [(· x parent) => loop]
-           [else #f]))]
-      [(and (procedure? type) (positive? (procedure-arity type))) (type parent)]
-      [(RestructureBase? type) (send type decode stream)]
-      [else (raise-argument-error 'VersionedStruct:resolve-version "way of finding version" type)]))
-  
   (define/override (decode stream [parent #f] [length 0])
-    (set! res (send this _setup stream parent length))
+    (define res (_setup stream parent length))
-    (report res 'versioned-struct-res)
+    
-    (define version (resolve-version stream parent))
+    (ref-set! res 'version
-    (hash-set! res 'version version)
+              (cond
-    (define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions))))))
+                [forced-version] ; for testing purposes: pass an explicit version
+                [(symbol? type) (unless parent
+                                  (raise-argument-error 'VersionedStruct:decode "valid parent" parent))
+                                (versionGetter parent)]
+                [else (send type decode stream)]))
+
+    (when (dict-ref versions 'header #f)
+      (_parseFields stream res (ref versions 'header)))
+    
+    (define fields (dict-ref versions (ref res 'version) (λ () (raise-argument-error 'VersionedStruct:decode "valid version key" (cons version (· this versions))))))
+
     (cond
       [(VersionedStruct? fields) (send fields decode stream parent)]
       [else
-       (report res 'whatigot)
+       (_parseFields stream res fields)
-       (send this _parseFields stream res fields)
+       (process res stream)
-       (send this process res stream)
        res]))
+  
+  (define/public-final (force-version! version)
+    (set! forced-version version))  
 
   (define/override (encode stream input-hash [parent #f])
     (unless (hash? input-hash)
@@ -66,49 +68,64 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
       [else (send fields encode stream input-hash parent)]))
 
   
-  (define/override (size [input-hash (mhash)] [parent #f] [includePointers #t])
+  (define/override (size [val (mhash)] [parent #f] [includePointers #t])
-    (when (and (not input-hash) (not forced-version))
+    (unless (or val forced-version)
       (error 'VersionedStruct-cannot-compute-size))
-    (define version (resolve-version #f parent))
+
-    (define fields (dict-ref versions version (λ () (raise-argument-error 'VersionedStruct:size "valid version key" version))))
+    (define ctx (mhash 'parent parent
-    (cond
+                       'val val
-      [(dict? fields)
+                       'pointerSize 0))
-       (for/sum ([(key type) (in-dict fields)])
+
-         (define val (hash-ref input-hash key #f))
+    (define size 0)
-         (define args (if val (list val) empty))
+    (when (not (string? type))
-         (send type size . args))]
+      (increment! size (send type size (ref val 'version) ctx)))
-      [else (send fields size input-hash parent includePointers)])))
+
-
+    (when (ref versions 'header)
-(test-module
+      (increment! size
- (require "number.rkt")
+                  (for/sum ([(key type) (in-dict (ref versions 'header))])
-  (define (random-pick xs) (list-ref xs (random (length xs))))
+                    (send type size (ref val key) ctx))))
- (check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42)))
+    
-
+    (define fields (dict-ref versions (ref val 'version) (λ () (raise-argument-error 'VersionedStruct:encode "valid version key" version))))
- ;; make random versioned structs and make sure we can round trip
+
- (for ([i (in-range 20)])
+    (increment! size
-   (define field-types (for/list ([i (in-range 200)])
+                (for/sum ([(key type) (in-dict (ref versions 'header))])
-                         (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
+                  (send type size (ref val key) ctx)))
-   (define num-versions 20)
+
-   (define which-struct (random num-versions))
+    (when includePointers
-   (define struct-versions (for/list ([v (in-range num-versions)])
+      (increment! size (ref ctx 'pointerSize)))
-                             (cons v (for/list ([num-type (in-list field-types)])
+
-                                       (cons (gensym) num-type)))))
+    size))
-   (define vs (+VersionedStruct which-struct struct-versions))
+
-   (define struct-size (for/sum ([num-type (in-list (map cdr (dict-ref struct-versions which-struct)))])
+#;(test-module
-                         (send num-type size)))
+   (require "number.rkt")
-   (define bs (apply bytes (for/list ([i (in-range struct-size)])
+   (define (random-pick xs) (list-ref xs (random (length xs))))
-                             (random 256))))
+   (check-exn exn:fail:contract? (λ () (+VersionedStruct 42 42)))
-   (check-equal? (send vs encode #f (send vs decode bs)) bs))
+
-
+   ;; make random versioned structs and make sure we can round trip
- (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
+   (for ([i (in-range 20)])
- (check-equal? (send s size) 3)
+     (define field-types (for/list ([i (in-range 200)])
- (define vs (+VersionedStruct (λ (p) 2) (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s))))
+                           (random-pick (list uint8 uint16be uint16le uint32be uint32le double))))
- (check-equal? (send vs size) 6)
+     (define num-versions 20)
- (define s2 (+Struct (dictify 'a vs)))
+     (define which-struct (random num-versions))
- (check-equal? (send s2 size) 6)
+     (define struct-versions (for/list ([v (in-range num-versions)])
- (define vs2 (+VersionedStruct (λ (p) 2) (dictify 1 vs 2 vs)))
+                               (cons v (for/list ([num-type (in-list field-types)])
- (check-equal? (send vs2 size) 6)
+                                         (cons (gensym) num-type)))))
-
+     (define vs (+VersionedStruct which-struct struct-versions))
- )
+     (define struct-size (for/sum ([num-type (in-list (map cdr (dict-ref struct-versions which-struct)))])
+                           (send num-type size)))
+     (define bs (apply bytes (for/list ([i (in-range struct-size)])
+                               (random 256))))
+     (check-equal? (send vs encode #f (send vs decode bs)) bs))
+
+   (define s (+Struct (dictify 'a uint8 'b uint8 'c uint8)))
+   (check-equal? (send s size) 3)
+   (define vs (+VersionedStruct (λ (p) 2) (dictify 1 (dictify 'd s) 2 (dictify 'e s 'f s))))
+   (check-equal? (send vs size) 6)
+   (define s2 (+Struct (dictify 'a vs)))
+   (check-equal? (send s2 size) 6)
+   (define vs2 (+VersionedStruct (λ (p) 2) (dictify 1 vs 2 vs)))
+   (check-equal? (send vs2 size) 6)
+
+   )