struct tests pass

pitfall/restructure/generic.rkt

@@ -11,26 +11,31 @@
 (define-generics indexable
   (ref indexable i)
   (ref-set! indexable i v)
+  (ref-keys indexable)
   #:defaults
   ([hash? (define ref hash-ref)
-          (define ref-set! hash-set!)]
+          (define ref-set! hash-set!)
+          (define ref-keys hash-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-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))))]))
 
 (module+ test
-  (require rackunit)
+  (require rackunit racket/set)
   (define h (make-hash '((foo . 42))))
   (check-equal? (ref h 'foo) 42)
   (ref-set! h 'foo 85)
   (check-equal? (ref h 'foo) 85)
   (ref-set! h 'bar 121)
   (check-equal? (ref h 'bar) 121)
+  (check-equal? (apply set (ref-keys h)) (apply set '(foo bar)))
   (define o (make-object (class object% (super-new) (field [_hash (make-hash)][foo 42]))))
   (check-equal? (ref o 'foo) 42)
   (ref-set! o 'foo 100)
   (check-equal? (ref o 'foo) 100)
   (ref-set! o 'bar 121)
-  (check-equal? (ref o 'bar) 121))
+  (check-equal? (ref o 'bar) 121)
+  (check-equal? (apply set (ref-keys o)) (apply set '(foo bar))))
 
 (define (ref* c . is)
   (for/fold ([c c])

pitfall/restructure/struct-test.rkt

@@ -22,8 +22,8 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 (let ([stream (+DecodeStream (+Buffer (bytes->list (bytes-append (bytes #x05) #"devon" (bytes #x15)))))]
       [struct (+Struct (dictify 'name (+StringT uint8)
                                 'age uint8))])
-  (check-equal? (send struct decode stream) (dictify 'name "devon"
-                                                     'age 21)))
+  (check-equal? (send (send struct decode stream) ht)
+                (mhasheq 'name "devon" 'age 21)))
 
 
 ;
@@ -40,6 +40,15 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        name: 'devon'
 ;        age: 32
 ;        canDrink: true
+
+(let ([stream (+DecodeStream (+Buffer (bytes->list (bytes-append (bytes #x05) #"devon" (bytes #x20)))))]
+      [struct (+Struct (dictify 'name (+StringT uint8)
+                                'age uint8))])
+  (set-field! process struct (λ (o stream) (ref-set! o 'canDrink (>= (ref o 'age) 21))))
+  (check-equal? (send (send struct decode stream) ht)
+                (mhasheq 'name "devon" 'age 32 'canDrink #t)))
+
+
 ;
 ;    it 'should support function keys', ->
 ;      stream = new DecodeStream new Buffer '\x05devon\x20'
@@ -52,6 +61,15 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        name: 'devon'
 ;        age: 32
 ;        canDrink: true
+
+(let ([stream (+DecodeStream (+Buffer (bytes->list (bytes-append (bytes #x05) #"devon" (bytes #x20)))))]
+      [struct (+Struct (dictify 'name (+StringT uint8)
+                                'age uint8
+                                'canDrink (λ (o) (>= (ref o 'age) 21))))])
+  (check-equal? (send (send struct decode stream) ht)
+                (mhasheq 'name "devon" 'age 32 'canDrink #t)))
+
+
 ;
 ;  describe 'size', ->
 ;    it 'should compute the correct size', ->
@@ -60,7 +78,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        age: uint8
 ;
 ;      struct.size(name: 'devon', age: 21).should.equal 7
-;
+
+(let ([struct (+Struct (dictify 'name (+StringT uint8)
+                                'age uint8))])
+  (check-equal? (send struct size (hasheq 'name "devon" 'age 32)) 7))
+
+
+; todo: when pointers are ready
 ;    it 'should compute the correct size with pointers', ->
 ;      struct = new Struct
 ;        name: new StringT uint8
@@ -73,6 +97,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        ptr: 'hello'
 ;
 ;      size.should.equal 14
+
+
+(displayln 'warning:pointer-not-done)
+
+
 ;      
 ;    it 'should get the correct size when no value is given', ->
 ;      struct = new Struct
@@ -80,6 +109,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        age: uint8
 ;
 ;      struct.size().should.equal 5
+
+
+(let ([struct (+Struct (dictify 'name (+StringT 4)
+                                'age uint8))])
+  (check-equal? (send struct size) 5))
+
+
 ;      
 ;    it 'should throw when getting non-fixed length size and no value is given', ->
 ;      struct = new Struct
@@ -89,6 +125,11 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;      should.throw ->
 ;        struct.size()
 ;      , /not a fixed size/i
+
+(let ([struct (+Struct (dictify 'name (+StringT uint8)
+                                'age uint8))])
+  (check-exn exn:fail:contract? (λ () (send struct size))))
+
 ;      
 ;  describe 'encode', ->
 ;    it 'should encode objects to buffers', (done) ->
@@ -106,6 +147,13 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        age: 21
 ;
 ;      stream.end()
+
+(let ([stream (+DecodeStream (+Buffer (bytes->list (bytes-append (bytes #x05) #"devon" (bytes #x15)))))]
+      [struct (+Struct (dictify 'name (+StringT uint8)
+                                'age uint8))])
+  (check-equal? (send (send struct decode stream) ht)
+                (mhasheq 'name "devon" 'age 21)))
+
 ;
 ;    it 'should support preEncode hook', (done) ->
 ;      stream = new EncodeStream
@@ -126,7 +174,18 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        age: 21
 ;
 ;      stream.end()
-;
+
+(let ([stream (+EncodeStream)]
+      [struct (+Struct (dictify 'nameLength uint8
+                                'name (+StringT 'nameLength)
+                                'age uint8))])
+  (set-field! preEncode struct (λ (val stream) (ref-set! val 'nameLength (length (ref val 'name)))))
+  (send struct encode stream (mhasheq 'name "devon" 'age 21))
+  (check-equal? (send stream dump)
+                (+Buffer (bytes->list (bytes-append (bytes #x05) #"devon" (bytes #x15))))))
+
+
+; todo: when pointer is ready
 ;    it 'should encode pointer data after structure', (done) ->
 ;      stream = new EncodeStream
 ;      stream.pipe concat (buf) ->
@@ -143,4 +202,5 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
 ;        age: 21
 ;        ptr: 'hello'
 ;
-;      stream.end()
+;      stream.end()
+(displayln 'warning:pointer-not-done)

pitfall/restructure/struct.rkt

@@ -1,5 +1,5 @@
 #lang restructure/racket
-(require racket/dict "stream.rkt")
+(require racket/dict "stream.rkt" racket/private/generic-methods racket/struct)
 (provide (all-defined-out))
 
 #|
@@ -7,7 +7,33 @@ approximates
 https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
 |#
 
+(define hashable<%>
+  (interface* ()
+              ([(generic-property gen:indexable)
+                (generic-method-table gen:indexable
+                                      (define (ref o i) (or (hash-ref (get-field kv o) i #f)
+                                                            (hash-ref (get-field _hash o) i #f)))
+                                      (define (ref-set! o i v) (hash-set! (get-field kv o) i v))
+                                      (define (ref-keys o) (hash-keys (get-field kv o))))]
+               [(generic-property gen:custom-write)
+                (generic-method-table gen:custom-write
+                                      (define (write-proc o port mode)
+                                        (define proc (case mode
+                                                       [(#t) write]
+                                                       [(#f) display]
+                                                       [else (λ (p port) (print p port mode))]))
+                                        (proc (get-field kv o) port)))])))
+
+(define StructRes (class* RestructureBase (hashable<%>)
+                    (super-make-object)
+                    (field [kv (mhasheq)])
+                    (define/public (ht) kv)))
+
 (define-subclass Streamcoder (Struct [fields (dictify)])
+  (field [[_process process] void]
+         [[_preEncode preEncode] void]) ; store as field so it can be mutated from outside
+  (define/override (process . args) (apply _process args))
+  (define/override (preEncode . args) (apply _preEncode args))
   
   (unless ((disjoin assocs? Struct?) fields) ; should be Versioned Struct but whatever
     (raise-argument-error 'Struct "assocs or Versioned Struct" fields))
@@ -15,28 +41,28 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
   (define/augride (decode stream [parent #f] [length_ 0])
     (define res (_setup stream parent length_))
     (_parseFields stream res fields)
-    (send this process res stream)
+    (process res stream)
     res)
 
   (define/augride (encode stream input-hash [parent #f])
     
-    (unless (hash? input-hash)
-      (raise-argument-error 'Struct:encode "hash" input-hash))
+    #;(unless (hash? input-hash)
+        (raise-argument-error 'Struct:encode "hash" input-hash))
 
     (send this preEncode input-hash stream) ; preEncode goes first, because it might bring input hash into compliance
 
-    (unless (andmap (λ (key) (member key (hash-keys input-hash))) (dict-keys fields))
+    (unless (andmap (λ (key) (member key (ref-keys input-hash))) (dict-keys fields))
       (raise-argument-error 'Struct:encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys input-hash)))
 
     (cond
       [(dict? fields)
        (for* ([(key type) (in-dict fields)])
-         (send type encode stream (hash-ref input-hash key)))]
+         (send type encode stream (ref input-hash key)))]
       [else (send fields encode stream input-hash parent)]))
 
   (define/public-final (_setup stream parent length)
-    (define res (mhasheq))
-    (hash-set*! res 'parent parent
+    (define res (make-object StructRes)) ; not mere hash
+    (hash-set*! (· res _hash) 'parent parent
                 '_startOffset (· stream pos)
                 '_currentOffset 0
                 '_length length)
@@ -49,9 +75,11 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
       (define val
         (if (procedure? type)
             (type res)
-            (send type decode stream this)))
-      (hash-set! res key val)
-      (hash-set! res '_currentOffset (- (· stream pos) (· res _startOffset)))))
+            (send type decode stream res)))
+      ;; skip PropertyDescriptor maneuver. Only used for lazy pointer
+      (ref-set! res key val)
+      (hash-set! (· res _hash) '_currentOffset (- (· stream pos) (ref res '_startOffset)))))
+  
 
   (define/override (size [input-hash (mhash)] [parent #f] [includePointers #t])
     (for/sum ([(key type) (in-dict fields)])