a test

pitfall/restructure/decodestream.rkt

@@ -20,7 +20,7 @@
 
 
 
-(define-subclass object% (DecodeStream [buffer #""])
+(define-subclass object% (RDecodeStream [buffer #""])
   (field [pos 0]
          [length (bytes-length buffer)]
          )

pitfall/restructure/helper.rkt

@@ -70,4 +70,18 @@
 (define-syntax-rule (define-hashifier id hasher) (define (id . kvs) (hasher (listify kvs))))
 (define-hashifier mhash make-hash)
 (define-hashifier mhasheq make-hasheq)
-(define-hashifier mhasheqv make-hasheqv)
+(define-hashifier mhasheqv make-hasheqv)
+
+(define (port-position port)
+  (define-values (l c p) (port-next-location port))
+  p)
+
+(define-syntax (· stx)
+  (syntax-case stx ()
+    [(_ x ref)
+     #'(cond
+         [(object? x) (with-handlers ([exn:fail:object? (λ (exn) (send x ref))])
+                        (get-field ref x))]
+         [(hash? x) (hash-ref x 'ref #f)]
+         [else (raise-argument-error '· (format "~a must be object or hash" 'x) x)])]
+    [(_ x ref0 . refs) #'(· (· x ref0) . refs)]))

pitfall/restructure/main.rkt

@@ -1,4 +1,5 @@
 #lang restructure/racket
 
 (r+p "number.rkt"
-     "struct.rkt")
+     "struct.rkt"
+     "decodestream.rkt")

pitfall/restructure/number.rkt

@@ -22,7 +22,7 @@
   
   (getter-field [size (hash-ref type-sizes fn)])
 
-  (define/override (decode stream)
+  (define/override (decode stream [res #f])
     (unless (input-port? stream)
       (raise-argument-error 'decode "input port" stream))
     (define bstr (read-bytes-exact size stream))
@@ -31,11 +31,14 @@
         (integer-bytes->integer bstr (unsigned-type? type) (eq? endian 'BE))))
 
   (define/override (encode stream val)
-    (unless (output-port? stream)
-      (raise-argument-error 'encode "output port" stream))
-    (if (= 1 size)
-        (bytes val)
-        (integer->integer-bytes val size (unsigned-type? type) (eq? endian 'BE)))))
+    (when stream
+      (unless (output-port? stream)
+        (raise-argument-error 'encode "output port" stream)))
+    (define bstr
+      (if (= 1 size)
+          (bytes val)
+          (integer->integer-bytes val size (unsigned-type? type) (eq? endian 'BE))))
+    (if stream (write-bytes bstr stream) bstr)))
     
 
 (test-module
@@ -44,16 +47,16 @@
        [op (open-output-bytes)])
    (check-equal? (send o decode ip) 513) ;; 1000 0000  0100 0000
    (check-equal? (send o decode ip) 1027)  ;; 1100 0000 0010 0000
-   (check-equal? (send o encode op 513) (bytes 1 2))
-   (check-equal? (send o encode op 1027) (bytes 3 4)))
+   (check-equal? (send o encode #f 513) (bytes 1 2))
+   (check-equal? (send o encode #f 1027) (bytes 3 4)))
 
  (let ([o (make-object Number 'UInt16 'BE)]
        [ip (open-input-bytes (bytes 1 2 3 4))]
        [op (open-output-bytes)])
    (check-equal? (send o decode ip) 258) ;; 0100 0000 1000 0000 
    (check-equal? (send o decode ip) 772) ;; 0010 0000 1100 0000 
-   (check-equal? (send o encode op 258) (bytes 1 2))
-   (check-equal? (send o encode op 772) (bytes 3 4))))
+   (check-equal? (send o encode #f 258) (bytes 1 2))
+   (check-equal? (send o encode #f 772) (bytes 3 4))))
 
 
 (test-module
@@ -68,17 +71,17 @@
 ;; use keys of type-sizes hash to generate corresponding number definitions
 (define-macro (make-int-types)
   (with-pattern ([((ID BASE ENDIAN) ...) (for/list ([k (in-hash-keys type-sizes)])
-                                                   (define kstr (format "~a" k))
-                                                   (match-define (list* prefix suffix _)
-                                                     (regexp-split #rx"(?=[BL]E|$)" kstr))
-                                                   (map string->symbol
-                                                        (list (string-downcase kstr)
-                                                              prefix
-                                                              (if (positive? (string-length suffix))
-                                                                  suffix
-                                                                  (if (system-big-endian?) "BE" "LE")))))]
+                                           (define kstr (format "~a" k))
+                                           (match-define (list* prefix suffix _)
+                                             (regexp-split #rx"(?=[BL]E|$)" kstr))
+                                           (map string->symbol
+                                                (list (string-downcase kstr)
+                                                      prefix
+                                                      (if (positive? (string-length suffix))
+                                                          suffix
+                                                          (if (system-big-endian?) "BE" "LE")))))]
                  [(ID ...) (suffix-id #'(ID ...) #:context caller-stx)])
-                #'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...)))
+    #'(begin (define+provide ID (make-object Number 'BASE 'ENDIAN)) ...)))
                                                             
 
 (make-int-types)

pitfall/restructure/struct.rkt

@@ -8,12 +8,33 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
 
 (define-subclass RBase (RStruct [fields (mhash)])
 
-  (define/override (decode stream parent [length 0])
-    (unfinished))
+  (define/override (decode stream [parent #f] [length 0])
+    (define res (_setup stream parent length))
+    (_parseFields stream res fields)
+    (hash-set! (hash-ref res '_props) '_currentOffset (port-position stream))
+    res)
 
-  (define/override (encode stream val parent)
-    (unfinished))
-  )
+  (define/override (encode stream val [parent #f])
+    (for ([(key type) (in-hash fields)])
+      (send type encode stream (hash-ref val key))))
+
+  (define/private (_setup stream parent length)
+    (define res (mhasheq))
 
+    ;; define hidden properties
+    (hash-set! res '_props
+               (mhasheq 'parent (mhasheq 'value parent)
+                      '_startOffset (mhasheq 'value (port-position stream))
+                      '_currentOffset (mhasheq 'value 0 'writable #t)
+                      '_length (mhasheq 'value length)))
+    res)
 
-(make-object RStruct (mhash 'foo "bar"))
+  (define/private (_parseFields stream res field)
+    (for ([(key hashvalue) (in-hash fields)])
+      (define val
+        (if (procedure? hashvalue)
+            (hashvalue res)
+            (send hashvalue decode stream res)))
+      (hash-set! res key val)))
+
+  )

pitfall/restructure/test.rkt

@@ -0,0 +1,22 @@
+#lang restructure/racket
+(require "main.rkt")
+
+(define Person
+  (make-object RStruct
+    (mhash 'name uint16
+           'age uint8)))
+
+;; decode a person from a buffer
+(define stream (open-input-bytes #"ABC"))
+(define x (send Person decode stream))
+
+(test-module
+ (check-equal? (hash-ref x 'name) 16961)
+ (check-equal? (hash-ref x 'age) 67))
+
+;; encode a person from a hash
+(define out (open-output-bytes))
+(send Person encode out (hasheq 'name 16961 'age 67))
+
+(test-module
+ (check-equal? (get-output-bytes out) #"ABC"))