streamage

pitfall/restructure/decodestream.rkt

@@ -19,9 +19,11 @@
                                (values (string->symbol (format "~a~a" key endian)) value))))
 
 
-
+;; basically just a wrapper for a Racket port
 (define-subclass object% (RDecodeStream [buffer #""])
-  (field [pos 0]
+  (field [length (bytes-length buffer)]
-         [length (bytes-length buffer)]
+         [_port (open-input-bytes buffer)])
-         )
+  (getter-field [pos (port-position _port)])
-  )
+
+  (define/public (read-bytes count)
+    (read-bytes-exact count _port)))

pitfall/restructure/encodestream.rkt

@@ -0,0 +1,19 @@
+#lang restructure/racket
+(provide (all-defined-out))
+
+#| approximates
+https://github.com/mbutterick/restructure/blob/master/src/EncodeStream.coffee
+|#
+
+;; basically just a wrapper for a Racket outputport
+(define-subclass object% (REncodeStream [bufferSize 65536])
+  (field [_port (open-output-bytes)])
+  (getter-field [pos (port-position _port)])
+
+  (define/public (dump)
+    (get-output-bytes _port))
+
+  (define/public (write val)
+    (cond
+      [(bytes? val) (write-bytes val _port)]
+      [else (error 'REncodeStream:write:unknown-type)])))

pitfall/restructure/main.rkt

@@ -2,4 +2,5 @@
 
 (r+p "number.rkt"
      "struct.rkt"
-     "decodestream.rkt")
+     "decodestream.rkt"
+     "encodestream.rkt")

pitfall/restructure/number.rkt

@@ -1,5 +1,5 @@
 #lang restructure/racket
-(require "decodestream.rkt")
+(require "decodestream.rkt" "encodestream.rkt")
 
 ;; approximates https://github.com/mbutterick/restructure/blob/master/src/Number.coffee
 
@@ -23,36 +23,34 @@
   (getter-field [size (hash-ref type-sizes fn)])
 
   (define/override (decode stream [res #f])
-    (unless (input-port? stream)
+    (unless (is-a? stream RDecodeStream)
-      (raise-argument-error 'decode "input port" stream))
+      (raise-argument-error 'decode "RDecodeStream" stream))
-    (define bstr (read-bytes-exact size stream))
+    (define bstr (send stream read-bytes size))
     (if (= 1 size)
         (bytes-ref bstr 0)
         (integer-bytes->integer bstr (unsigned-type? type) (eq? endian 'BE))))
 
   (define/override (encode stream val)
     (when stream
-      (unless (output-port? stream)
+      (unless (is-a? stream REncodeStream)
-        (raise-argument-error 'encode "output port" stream)))
+        (raise-argument-error 'encode "REncodeStream" 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)))
+    (if stream (send stream write bstr) bstr)))
     
 
 (test-module
  (let ([o (make-object Number 'UInt16 'LE)]
-       [ip (open-input-bytes (bytes 1 2 3 4))]
+       [ip (make-object RDecodeStream (bytes 1 2 3 4))])
-       [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 #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))]
+       [ip (make-object RDecodeStream (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 #f 258) (bytes 1 2))

pitfall/restructure/struct.rkt

@@ -11,7 +11,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
   (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))
+    (hash-set! (hash-ref res '_props) '_currentOffset (· stream pos))
     res)
 
   (define/override (encode stream val [parent #f])
@@ -24,7 +24,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
     ;; define hidden properties
     (hash-set! res '_props
                (mhasheq 'parent (mhasheq 'value parent)
-                      '_startOffset (mhasheq 'value (port-position stream))
+                      '_startOffset (mhasheq 'value (· stream pos))
                       '_currentOffset (mhasheq 'value 0 'writable #t)
                       '_length (mhasheq 'value length)))
     res)

pitfall/restructure/test.rkt

@@ -7,7 +7,7 @@
            'age uint8)))
 
 ;; decode a person from a buffer
-(define stream (open-input-bytes #"ABC"))
+(define stream (make-object RDecodeStream #"ABC"))
 (define x (send Person decode stream))
 
 (test-module
@@ -15,8 +15,8 @@
  (check-equal? (hash-ref x 'age) 67))
 
 ;; encode a person from a hash
-(define out (open-output-bytes))
+(define out (make-object REncodeStream))
 (send Person encode out (hasheq 'name 16961 'age 67))
 
 (test-module
- (check-equal? (get-output-bytes out) #"ABC"))
+ (check-equal? (send out dump) #"ABC"))