mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

struct → dict

Browse Source
main
Matthew Butterick 5 years ago
parent 077b227f03
commit 3d15b505f4
10 changed files with 133 additions and 123 deletions
Show Stats Download Patch File Download Diff File

33
xenomorph/xenomorph/struct.rkt → xenomorph/xenomorph/dict.rkt
Unescape Escape View File

@ -25,9 +25,9 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
mheq) mheq)
(define (parse-fields port mheq fields-arg) (define (parse-fields port mheq fields-arg)
(define fields (if (x:struct? fields-arg) (get-field fields fields-arg) fields-arg)) (define fields (if (x:dict? fields-arg) (get-field fields fields-arg) fields-arg))
(unless (assocs? fields) (unless (assocs? fields)
(raise-argument-error 'x:struct-parse-fields "assocs" fields)) (raise-argument-error 'x:dict-parse-fields "assocs" fields))
(for ([(key type) (in-dict fields)]) (for ([(key type) (in-dict fields)])
(define val (match type (define val (match type
[(? procedure? proc) (proc mheq)] [(? procedure? proc) (proc mheq)]
@ -37,7 +37,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(hash-set! mheq x:current-offset-key (- (pos port) (hash-ref mheq x:start-offset-key)))) (hash-set! mheq x:current-offset-key (- (pos port) (hash-ref mheq x:start-offset-key))))
mheq) mheq)
(define x:struct% (define x:dict%
(class x:base% (class x:base%
(super-new) (super-new)
(init-field [(@fields fields)]) (init-field [(@fields fields)])
@ -54,10 +54,10 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define/augride (x:encode field-data port [parent-arg #f]) (define/augride (x:encode field-data port [parent-arg #f])
(unless (dict? field-data) (unless (dict? field-data)
(raise-result-error 'x:struct-encode "dict" field-data)) (raise-result-error 'x:dict-encode "dict" field-data))
;; check keys, because `size` also relies on keys being valid ;; check keys, because `size` also relies on keys being valid
(unless (andmap (λ (field-key) (memq field-key (dict-keys field-data))) (dict-keys @fields)) (unless (andmap (λ (field-key) (memq field-key (dict-keys field-data))) (dict-keys @fields))
(raise-argument-error 'x:struct-encode (raise-argument-error 'x:dict-encode
(format "dict that contains superset of xstruct keys: ~a" (format "dict that contains superset of xstruct keys: ~a"
(dict-keys @fields)) (dict-keys field-data))) (dict-keys @fields)) (dict-keys field-data)))
(define parent (mhasheq x:pointers-key null (define parent (mhasheq x:pointers-key null
@ -82,22 +82,22 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define pointers-size (if include-pointers (dict-ref parent x:pointer-size-key) 0)) (define pointers-size (if include-pointers (dict-ref parent x:pointer-size-key) 0))
(+ fields-size pointers-size)))) (+ fields-size pointers-size))))
(define (x:struct? x) (is-a? x x:struct%)) (define (x:dict? x) (is-a? x x:dict%))
(define/contract (x:struct #:pre-encode [pre-proc #f] (define/contract (x:dict #:pre-encode [pre-proc #f]
#:post-decode [post-proc #f] #:post-decode [post-proc #f]
#:base-class [base-class x:struct%] #:base-class [base-class x:dict%]
. dicts) . dicts)
(() (()
(#:pre-encode (or/c (any/c . -> . any/c) #false) (#:pre-encode (or/c (any/c . -> . any/c) #false)
#:post-decode (or/c (any/c . -> . any/c) #false) #:post-decode (or/c (any/c . -> . any/c) #false)
#:base-class (λ (c) (subclass? c x:struct%))) #:base-class (λ (c) (subclass? c x:dict%)))
#:rest (listof any/c) #:rest (listof any/c)
. ->* . . ->* .
x:struct?) x:dict?)
(define args (flatten dicts)) (define args (flatten dicts))
(unless (even? (length args)) (unless (even? (length args))
(raise-argument-error 'x:struct "equal number of keys and values" dicts)) (raise-argument-error 'x:dict "equal number of keys and values" dicts))
(define fields (for/list ([kv (in-slice 2 args)]) (define fields (for/list ([kv (in-slice 2 args)])
(unless (symbol? (car kv)) (unless (symbol? (car kv))
(raise-argument-error '+xstruct "symbol" (car kv))) (raise-argument-error '+xstruct "symbol" (car kv)))
@ -107,7 +107,7 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(module+ test (module+ test
(require rackunit "number.rkt" "base.rkt") (require rackunit "number.rkt" "base.rkt")
(define (random-pick xs) (list-ref xs (random (length xs)))) (define (random-pick xs) (list-ref xs (random (length xs))))
(check-exn exn:fail:contract? (λ () (x:struct 42))) (check-exn exn:fail:contract? (λ () (x:dict 42)))
(for ([i (in-range 20)]) (for ([i (in-range 20)])
;; make random structs and make sure we can round trip ;; make random structs and make sure we can round trip
(define field-types (define field-types
@ -116,8 +116,13 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee
(define size-num-types (define size-num-types
(for/sum ([num-type (in-list field-types)]) (for/sum ([num-type (in-list field-types)])
(size num-type))) (size num-type)))
(define xs (x:struct (for/list ([num-type (in-list field-types)]) (define xs (x:dict (for/list ([num-type (in-list field-types)])
(cons (gensym) num-type)))) (cons (gensym) num-type))))
(define bs (apply bytes (for/list ([i (in-range size-num-types)]) (define bs (apply bytes (for/list ([i (in-range size-num-types)])
(random 256)))) (random 256))))
(check-equal? (encode xs (decode xs bs) #f) bs))) (check-equal? (encode xs (decode xs bs) #f) bs)))
;; bw compat
(define x:struct% x:dict%)
(define x:struct? x:dict?)
(define x:struct x:dict)

4
xenomorph/xenomorph/main.rkt
Unescape Escape View File

@ -6,6 +6,7 @@
(r+p "bitfield.rkt" (r+p "bitfield.rkt"
"bytes.rkt" "bytes.rkt"
"dict.rkt"
"enum.rkt" "enum.rkt"
"base.rkt" "base.rkt"
"list.rkt" "list.rkt"
@ -15,8 +16,7 @@
"reserved.rkt" "reserved.rkt"
"string.rkt" "string.rkt"
"stream.rkt" "stream.rkt"
"struct.rkt"
"symbol.rkt" "symbol.rkt"
"vector.rkt" "vector.rkt"
"versioned-struct.rkt" "versioned-dict.rkt"
"util.rkt") "util.rkt")

26
xenomorph/xenomorph/scribblings/xenomorph.scrbl
Unescape Escape View File

@ -21,7 +21,7 @@ OK, just a few of you, in the back. You're free to go.
As for everyone else: Xenomorph eases the pain of working with binary formats. Instead of laboriously counting bytes — As for everyone else: Xenomorph eases the pain of working with binary formats. Instead of laboriously counting bytes —
@itemlist[#:style 'ordered @itemlist[#:style 'ordered
@item{You describe a binary format declaratively by using smaller ingredients — e.g., integers, strings, lists, pointers, structs, and perhaps other nested encodings. This is known as a @deftech{xenomorphic object}.} @item{You describe a binary format declaratively by using smaller ingredients — e.g., integers, strings, lists, pointers, dicts, and perhaps other nested encodings. This is known as a @deftech{xenomorphic object}.}
@item{This xenomorphic object can then be used as a binary encoder, allowing you to convert Racket values to binary and write them out to a file.} @item{This xenomorphic object can then be used as a binary encoder, allowing you to convert Racket values to binary and write them out to a file.}
@ -823,13 +823,13 @@ Generate an instance of @racket[x:vector%] (or a subclass of @racket[x:vector%])
} }
@subsection{Structs} @subsection{Dicts}
@defmodule[xenomorph/struct] @defmodule[xenomorph/dict]
@defclass[x:struct% x:base% ()]{ @defclass[x:dict% x:base% ()]{
Base class for struct formats. Use @racket[x:struct] to conveniently instantiate new struct formats. Base class for struct formats. Use @racket[x:dict] to conveniently instantiate new struct formats.
@defconstructor[ @defconstructor[
([fields dict?])]{ ([fields dict?])]{
@ -859,22 +859,22 @@ Take the keys and values in @racket[kvs] and encode them as a @tech{byte string}
} }
@defproc[ @defproc[
(x:struct? (x:dict?
[x any/c]) [x any/c])
boolean?]{ boolean?]{
Whether @racket[x] is an object of type @racket[x:struct%]. Whether @racket[x] is an object of type @racket[x:dict%].
} }
@defproc[ @defproc[
(x:struct (x:dict
[#:pre-encode pre-encode-proc (or/c (any/c . -> . any/c) #false) #false] [#:pre-encode pre-encode-proc (or/c (any/c . -> . any/c) #false) #false]
[#:post-decode post-decode-proc (or/c (any/c . -> . any/c) #false) #false] [#:post-decode post-decode-proc (or/c (any/c . -> . any/c) #false) #false]
[#:base-class base-class (λ (c) (subclass? c x:struct%)) x:struct%] [#:base-class base-class (λ (c) (subclass? c x:dict%)) x:dict%]
[dict (listof (pairof symbol? xenomorphic?))] ... [dict (listof (pairof symbol? xenomorphic?))] ...
[key symbol?] [val-type xenomorphic?] ... ... [key symbol?] [val-type xenomorphic?] ... ...
) )
x:struct?]{ x:dict?]{
Generate an instance of @racket[x:struct%] (or a subclass of @racket[x:struct%]) with certain optional attributes. Generate an instance of @racket[x:dict%] (or a subclass of @racket[x:dict%]) with certain optional attributes.
The rest arguments determine the keys and value types of the struct. These arguments can either be alternating keys and value-type arguments (similar to the calling pattern for @racket[hasheq]) or @tech{association lists}. The rest arguments determine the keys and value types of the struct. These arguments can either be alternating keys and value-type arguments (similar to the calling pattern for @racket[hasheq]) or @tech{association lists}.
@ -885,9 +885,9 @@ The rest arguments determine the keys and value types of the struct. These argum
@subsection{Versioned structs} @subsection{Versioned dicts}
@defmodule[xenomorph/versioned-struct] @defmodule[xenomorph/versioned-dict]
@subsection{Pointers} @subsection{Pointers}

26
xenomorph/xenomorph/test/struct-test.rkt → xenomorph/xenomorph/test/dict-test.rkt
Unescape Escape View File

@ -2,7 +2,7 @@
(require rackunit racket/dict (require rackunit racket/dict
racket/class racket/class
"../base.rkt" "../base.rkt"
"../struct.rkt" "../dict.rkt"
"../string.rkt" "../string.rkt"
"../pointer.rkt" "../pointer.rkt"
"../number.rkt" "../number.rkt"
@ -18,21 +18,21 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
"struct: decode into an object" "struct: decode into an object"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (check-equal?
(decode (x:struct 'name (x:string #:length uint8) 'age uint8)) (decode (x:dict 'name (x:string #:length uint8) 'age uint8))
(mhasheq 'name "roxyb" 'age 21)))) (mhasheq 'name "roxyb" 'age 21))))
(test-case (test-case
"struct: decode nested struct into an object" "struct: decode nested struct into an object"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15\x05roxyb\x15")])
(check-equal? (check-equal?
(decode (x:struct 'name (x:string #:length uint8) 'age uint8 (decode (x:dict 'name (x:string #:length uint8) 'age uint8
'nested (x:struct 'name (x:string #:length uint8) 'age uint8))) 'nested (x:dict 'name (x:string #:length uint8) 'age uint8)))
(mhasheq 'name "roxyb" 'age 21 'nested (mhasheq 'name "roxyb" 'age 21))))) (mhasheq 'name "roxyb" 'age 21 'nested (mhasheq 'name "roxyb" 'age 21)))))
(test-case (test-case
"struct: decode with process hook" "struct: decode with process hook"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (x:struct #:post-decode (λ (o) (hash-set! o 'canDrink (>= (hash-ref o 'age) 21)) o) (define struct (x:dict #:post-decode (λ (o) (hash-set! o 'canDrink (>= (hash-ref o 'age) 21)) o)
'name (x:string #:length uint8) 'age uint8)) 'name (x:string #:length uint8) 'age uint8))
(check-equal? (decode struct) (check-equal? (decode struct)
(mhasheq 'name "roxyb" 'age 32 'canDrink #t)))) (mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
@ -40,40 +40,40 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(test-case (test-case
"struct: decode supports function keys" "struct: decode supports function keys"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x20")])
(define struct (x:struct 'name (x:string #:length uint8) 'age uint8 'canDrink (λ (o) (>= (hash-ref o 'age) 21)))) (define struct (x:dict 'name (x:string #:length uint8) 'age uint8 'canDrink (λ (o) (>= (hash-ref o 'age) 21))))
(check-equal? (decode struct) (check-equal? (decode struct)
(mhasheq 'name "roxyb" 'age 32 'canDrink #t)))) (mhasheq 'name "roxyb" 'age 32 'canDrink #t))))
(test-case (test-case
"struct: compute the correct size" "struct: compute the correct size"
(check-equal? (size (x:struct 'name (x:string #:length uint8) 'age uint8) (check-equal? (size (x:dict 'name (x:string #:length uint8) 'age uint8)
(hasheq 'name "roxyb" 'age 32)) 7)) (hasheq 'name "roxyb" 'age 32)) 7))
(test-case (test-case
"struct: compute the correct size with pointers" "struct: compute the correct size with pointers"
(check-equal? (size (x:struct 'name (x:string #:length uint8) (check-equal? (size (x:dict 'name (x:string #:length uint8)
'age uint8 'age uint8
'ptr (x:pointer #:type (x:string #:length uint8))) 'ptr (x:pointer #:type (x:string #:length uint8)))
(mhash 'name "roxyb" 'age 21 'ptr "hello")) 14)) (mhash 'name "roxyb" 'age 21 'ptr "hello")) 14))
(test-case (test-case
"struct: get the correct size when no value is given" "struct: get the correct size when no value is given"
(check-equal? (size (x:struct 'name (x:string 4) 'age uint8)) 5)) (check-equal? (size (x:dict 'name (x:string 4) 'age uint8)) 5))
(test-case (test-case
"struct: throw when getting non-fixed length size and no value is given" "struct: throw when getting non-fixed length size and no value is given"
(check-exn exn:fail:contract? (λ () (size (x:struct 'name (x:string #:length uint8) 'age uint8))))) (check-exn exn:fail:contract? (λ () (size (x:dict 'name (x:string #:length uint8) 'age uint8)))))
(test-case (test-case
"struct: encode objects to buffers" "struct: encode objects to buffers"
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
(check-equal? (decode (x:struct 'name (x:string #:length uint8) 'age uint8)) (check-equal? (decode (x:dict 'name (x:string #:length uint8) 'age uint8))
(mhasheq 'name "roxyb" 'age 21)))) (mhasheq 'name "roxyb" 'age 21))))
(test-case (test-case
"struct: support pre-encode hook" "struct: support pre-encode hook"
(parameterize ([current-output-port (open-output-bytes)]) (parameterize ([current-output-port (open-output-bytes)])
(define struct (x:struct #:pre-encode (λ (val) (define struct (x:dict #:pre-encode (λ (val)
(hash-set! val 'nameLength (string-length (hash-ref val 'name))) val) (hash-set! val 'nameLength (string-length (hash-ref val 'name))) val)
'nameLength uint8 'nameLength uint8
'name (x:string 'nameLength) 'name (x:string 'nameLength)
@ -84,7 +84,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Struct.coffee
(test-case (test-case
"struct: encode pointer data after structure" "struct: encode pointer data after structure"
(parameterize ([current-output-port (open-output-bytes)]) (parameterize ([current-output-port (open-output-bytes)])
(define struct (x:struct 'name (x:string #:length uint8) (define struct (x:dict 'name (x:string #:length uint8)
'age uint8 'age uint8
'ptr (x:pointer #:type (x:string #:length uint8)))) 'ptr (x:pointer #:type (x:string #:length uint8))))
(encode struct (hasheq 'name "roxyb" 'age 21 'ptr "hello")) (encode struct (hasheq 'name "roxyb" 'age 21 'ptr "hello"))

4
xenomorph/xenomorph/test/list-test.rkt
Unescape Escape View File

@ -2,7 +2,7 @@
(require rackunit (require rackunit
racket/class racket/class
"../list.rkt" "../list.rkt"
"../struct.rkt" "../dict.rkt"
"../number.rkt" "../number.rkt"
"../pointer.rkt" "../pointer.rkt"
"../base.rkt" "../base.rkt"
@ -21,7 +21,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(test-case (test-case
"list: decode nested" "list: decode nested"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:list #:type (x:struct 'foo uint8) #:length 4)) (check-equal? (decode (x:list #:type (x:dict 'foo uint8) #:length 4))
(list (mhasheq 'foo 1) (list (mhasheq 'foo 1)
(mhasheq 'foo 2) (mhasheq 'foo 2)
(mhasheq 'foo 3) (mhasheq 'foo 3)

4
xenomorph/xenomorph/test/main.rkt
Unescape Escape View File

@ -2,6 +2,7 @@
(require "bitfield-test.rkt" (require "bitfield-test.rkt"
"bytes-test.rkt" "bytes-test.rkt"
"dict-test.rkt"
"enum-test.rkt" "enum-test.rkt"
"list-test.rkt" "list-test.rkt"
"number-test.rkt" "number-test.rkt"
@ -11,6 +12,5 @@
"stream-test.rkt" "stream-test.rkt"
"string-test.rkt" "string-test.rkt"
"symbol-test.rkt" "symbol-test.rkt"
"struct-test.rkt"
"vector-test.rkt" "vector-test.rkt"
"versioned-struct-test.rkt") "versioned-dict-test.rkt")

4
xenomorph/xenomorph/test/pointer-test.rkt
Unescape Escape View File

@ -5,7 +5,7 @@
"../base.rkt" "../base.rkt"
"../pointer.rkt" "../pointer.rkt"
"../number.rkt" "../number.rkt"
"../struct.rkt" "../dict.rkt"
"../base.rkt" "../base.rkt"
racket/promise racket/promise
sugar/unstable/dict) sugar/unstable/dict)
@ -54,7 +54,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Pointer.coffee
(test-case (test-case
"pointer: decode should support decoding pointers lazily" "pointer: decode should support decoding pointers lazily"
(parameterize ([current-input-port (open-input-bytes (bytes 1 53))]) (parameterize ([current-input-port (open-input-bytes (bytes 1 53))])
(define res (decode (x:struct 'ptr (x:pointer #:lazy #t)))) (define res (decode (x:dict 'ptr (x:pointer #:lazy #t))))
(check-true (promise? (hash-ref res 'ptr))) (check-true (promise? (hash-ref res 'ptr)))
(check-equal? (force (hash-ref res 'ptr)) 53))) (check-equal? (force (hash-ref res 'ptr)) 53)))

4
xenomorph/xenomorph/test/vector-test.rkt
Unescape Escape View File

@ -3,7 +3,7 @@
racket/class racket/class
racket/vector racket/vector
"../vector.rkt" "../vector.rkt"
"../struct.rkt" "../dict.rkt"
"../number.rkt" "../number.rkt"
"../pointer.rkt" "../pointer.rkt"
"../base.rkt" "../base.rkt"
@ -22,7 +22,7 @@ https://github.com/mbutterick/restructure/blob/master/test/Array.coffee
(test-case (test-case
"vector: decode nested" "vector: decode nested"
(parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))]) (parameterize ([current-input-port (open-input-bytes (bytes 1 2 3 4 5))])
(check-equal? (decode (x:vector #:type (x:struct 'foo uint8) #:length 4)) (check-equal? (decode (x:vector #:type (x:dict 'foo uint8) #:length 4))
(vector (mhasheq 'foo 1) (vector (mhasheq 'foo 1)
(mhasheq 'foo 2) (mhasheq 'foo 2)
(mhasheq 'foo 3) (mhasheq 'foo 3)

110
xenomorph/xenomorph/test/versioned-struct-test.rkt → xenomorph/xenomorph/test/versioned-dict-test.rkt
Unescape Escape View File

@ -6,9 +6,9 @@
"../number.rkt" "../number.rkt"
"../string.rkt" "../string.rkt"
"../pointer.rkt" "../pointer.rkt"
"../struct.rkt" "../dict.rkt"
"../base.rkt" "../base.rkt"
"../versioned-struct.rkt") "../versioned-dict.rkt")
#| #|
approximates approximates
@ -16,12 +16,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
|# |#
(test-case (test-case
"versioned struct: decode should get version from number type" "versioned dict: decode should get version from number type"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
@ -30,41 +30,41 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(check-equal? (decode vstruct) (mhasheq 'name "roxyb 🤘" 'age 21 x:version-key 1 'gender 0))))) (check-equal? (decode vstruct) (mhasheq 'name "roxyb 🤘" 'age 21 x:version-key 1 'gender 0)))))
(test-case (test-case
"versioned struct: decode should get version from number type, nested" "versioned dict: decode should get version from number type, nested"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8 'age uint8
'nested (x:struct 'foo uint8)) 'nested (x:dict 'foo uint8))
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8 'gender uint8
'nested (x:struct 'foo uint8))))]) 'nested (x:dict 'foo uint8))))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15\x2a")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15\x2a")])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb" 'age 21 'nested (mhasheq 'foo 42) x:version-key 0))) (check-equal? (decode vstruct) (mhasheq 'name "roxyb" 'age 21 'nested (mhasheq 'foo 42) x:version-key 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 🤘\x15\x00\x2a"))]) (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 🤘\x15\x00\x2a"))])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb 🤘" 'age 21 x:version-key 1 'gender 0 'nested (mhasheq 'foo 42)))))) (check-equal? (decode vstruct) (mhasheq 'name "roxyb 🤘" 'age 21 x:version-key 1 'gender 0 'nested (mhasheq 'foo 42))))))
(test-case (test-case
"versioned struct: decode should throw for unknown version" "versioned dict: decode should throw for unknown version"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")])
(check-exn exn:fail:contract? (λ () (decode vstruct)))))) (check-exn exn:fail:contract? (λ () (decode vstruct))))))
(test-case (test-case
"versioned struct: decode should support common header block" "versioned dict: decode should support common header block"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
'header (dictify 'age uint8 'header (dictify 'age uint8
'alive uint8) 'alive uint8)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii))
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb" (check-equal? (decode vstruct) (mhasheq 'name "roxyb"
@ -79,12 +79,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender 0))))) 'gender 0)))))
(test-case (test-case
"versioned struct: decode should support parent version key" "versioned dict: decode should support parent version key"
(let ([vstruct (x:versioned-struct x:version-key (let ([vstruct (x:versioned-dict x:version-key
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")])
@ -95,12 +95,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(mhasheq 'name "roxyb 🤘" 'age 21 x:version-key 1 'gender 0))))) (mhasheq 'name "roxyb 🤘" 'age 21 x:version-key 1 'gender 0)))))
(test-case (test-case
"versioned struct: decode should support sub versioned structs" "versioned dict: decode should support sub versioned dicts"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:versioned-struct uint8 1 (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string uint8)) 0 (dictify 'name (x:string uint8))
1 (dictify 'name (x:string uint8) 1 (dictify 'name (x:string uint8)
@ -116,13 +116,13 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(mhasheq 'name "ice cream" 'isDessert 1 x:version-key 1))))) (mhasheq 'name "ice cream" 'isDessert 1 x:version-key 1)))))
(test-case (test-case
"versioned struct: decode should support process hook" "versioned dict: decode should support process hook"
(let ([vstruct (x:versioned-struct #:post-decode (λ (val) (hash-set! val 'processed "true") val) (let ([vstruct (x:versioned-dict #:post-decode (λ (val) (hash-set! val 'processed "true") val)
uint8 uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
@ -130,12 +130,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(mhasheq 'name "roxyb" 'processed "true" 'age 21 x:version-key 0))))) (mhasheq 'name "roxyb" 'processed "true" 'age 21 x:version-key 0)))))
(test-case (test-case
"versioned struct: size should compute the correct size" "versioned dict: size should compute the correct size"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(check-equal? (size vstruct (mhasheq 'name "roxyb" (check-equal? (size vstruct (mhasheq 'name "roxyb"
@ -147,35 +147,35 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
x:version-key 1)) 14))) x:version-key 1)) 14)))
(test-case (test-case
"versioned struct: size should throw for unknown version" "versioned dict: size should throw for unknown version"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 5)))))) (check-exn exn:fail:contract? (λ () (size vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 5))))))
(test-case (test-case
"versioned struct: size should support common header block" "versioned dict: size should support common header block"
(let ([struct (x:versioned-struct uint8 (let ([struct (x:versioned-dict uint8
(dictify (dictify
'header (dictify 'age uint8 'header (dictify 'age uint8
'alive uint8) 'alive uint8)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii))
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'gender uint8)))]) 'gender uint8)))])
(check-equal? (size struct (mhasheq 'name "roxyb" 'age 21 'alive 1 x:version-key 0)) 9) (check-equal? (size struct (mhasheq 'name "roxyb" 'age 21 'alive 1 x:version-key 0)) 9)
(check-equal? (size struct (mhasheq 'name "roxyb 🤘" 'gender 0 'age 21 'alive 1 x:version-key 1)) 15))) (check-equal? (size struct (mhasheq 'name "roxyb 🤘" 'gender 0 'age 21 'alive 1 x:version-key 1)) 15)))
(test-case (test-case
"versioned struct: size should compute the correct size with pointers" "versioned dict: size should compute the correct size with pointers"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'ptr (x:pointer #:offset-type uint8 'ptr (x:pointer #:offset-type uint8
#:type (x:string uint8)))))]) #:type (x:string uint8)))))])
@ -185,23 +185,23 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'ptr "hello")) 15))) 'ptr "hello")) 15)))
(test-case (test-case
"versioned struct: size should throw if no value is given" "versioned dict: size should throw if no value is given"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))]) 'gender uint8)))])
(check-exn exn:fail:contract? (λ () (size vstruct))))) (check-exn exn:fail:contract? (λ () (size vstruct)))))
(test-case (test-case
"versioned struct: encode should encode objects to buffers" "versioned dict: encode should encode objects to buffers"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
@ -210,25 +210,25 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00")))) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 🤘\x15\x00"))))
(test-case (test-case
"versioned struct: encode should throw for unknown version" "versioned dict: encode should throw for unknown version"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
(check-exn exn:fail:contract? (λ () (encode vstruct op (mhasheq 'name "roxyb" 'age 21 x:version-key 5)))))) (check-exn exn:fail:contract? (λ () (encode vstruct op (mhasheq 'name "roxyb" 'age 21 x:version-key 5))))))
(test-case (test-case
"versioned struct: encode should support common header block" "versioned dict: encode should support common header block"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
'header (dictify 'age uint8 'header (dictify 'age uint8
'alive uint8) 'alive uint8)
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii))
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
(encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 x:version-key 0) op) (encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 x:version-key 0) op)
@ -236,12 +236,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 🤘\x00")))) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 🤘\x00"))))
(test-case (test-case
"versioned struct: encode should encode pointer data after structure" "versioned dict: encode should encode pointer data after structure"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'ptr (x:pointer #:offset-type uint8 'ptr (x:pointer #:offset-type uint8
#:type (x:string uint8)))))] #:type (x:string uint8)))))]
@ -251,12 +251,12 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello")))) (check-equal? (get-output-bytes op) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello"))))
#;(test-case #;(test-case
"versioned struct: encode should support preEncode hook" "versioned dict: encode should support preEncode hook"
(let ([vstruct (x:versioned-struct uint8 (let ([vstruct (x:versioned-dict uint8
(dictify (dictify
0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii) 0 (dictify 'name (x:string #:length uint8 #:encoding 'ascii)
'age uint8) 'age uint8)
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:dict 'name (x:string #:length uint8 #:encoding 'utf8)
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])

41
xenomorph/xenomorph/versioned-struct.rkt → xenomorph/xenomorph/versioned-dict.rkt
Unescape Escape View File

@ -1,5 +1,5 @@
#lang debug racket/base #lang debug racket/base
(require "base.rkt" "struct.rkt" (require "base.rkt" "dict.rkt"
racket/dict racket/dict
racket/match racket/match
racket/class racket/class
@ -11,25 +11,25 @@ approximates
https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
|# |#
(define x:versioned-struct% (define x:versioned-dict%
(class x:struct% (class x:dict%
(super-new) (super-new)
(init-field [(@type type)] [(@versions versions)]) (init-field [(@type type)] [(@versions versions)])
(unless (for/or ([proc (list integer? procedure? xenomorphic-type? symbol?)]) (unless (for/or ([proc (list integer? procedure? xenomorphic-type? symbol?)])
(proc @type)) (proc @type))
(raise-argument-error 'x:versioned-struct "integer, procedure, symbol, or xenomorphic" @type)) (raise-argument-error 'x:versioned-dict "integer, procedure, symbol, or xenomorphic" @type))
(unless (and (dict? @versions) (andmap (λ (v) (or (dict? v) (x:struct? v))) (dict-values @versions))) (unless (and (dict? @versions) (andmap (λ (v) (or (dict? v) (x:dict? v))) (dict-values @versions)))
(raise-argument-error 'x:versioned-struct "dict of dicts or structish" @versions)) (raise-argument-error 'x:versioned-dict "dict of dicts or structish" @versions))
(define (select-field-set val) (define (select-field-set val)
(define version-key (define version-key
(or (dict-ref val x:version-key #f) (or (dict-ref val x:version-key #f)
(raise-argument-error 'x:versioned-struct-encode "value for version key" x:version-key))) (raise-argument-error 'x:versioned-dict-encode "value for version key" x:version-key)))
(define field-object (define field-object
(or (dict-ref @versions version-key #f) (or (dict-ref @versions version-key #f)
(raise-argument-error 'x:versioned-struct-encode (format "valid field version: ~v" (dict-keys @versions)) version-key))) (raise-argument-error 'x:versioned-dict-encode (format "valid field version: ~v" (dict-keys @versions)) version-key)))
(if (x:struct? field-object) (get-field fields field-object) field-object)) (if (x:dict? field-object) (get-field fields field-object) field-object))
(define/override (x:decode port parent [length 0]) (define/override (x:decode port parent [length 0])
(define res (setup-private-fields port parent length)) (define res (setup-private-fields port parent length))
@ -38,7 +38,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[(? symbol? key) #:when parent (dict-ref parent key)] [(? symbol? key) #:when parent (dict-ref parent key)]
[(? procedure? proc) #:when parent (proc parent)] [(? procedure? proc) #:when parent (proc parent)]
[(or (? symbol?) (? procedure?)) [(or (? symbol?) (? procedure?))
(raise-argument-error 'x:versioned-struct-decode "valid parent" parent)] (raise-argument-error 'x:versioned-dict-decode "valid parent" parent)]
[_ (send @type x:decode port parent)])) [_ (send @type x:decode port parent)]))
(dict-set! res x:version-key which-version) (dict-set! res x:version-key which-version)
@ -47,16 +47,16 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[header-val (parse-fields port res header-val)]) [header-val (parse-fields port res header-val)])
(match (dict-ref @versions which-version #f) (match (dict-ref @versions which-version #f)
[#false (raise-argument-error 'x:versioned-struct-decode [#false (raise-argument-error 'x:versioned-dict-decode
(format "valid field version: ~v" (dict-keys @versions)) which-version)] (format "valid field version: ~v" (dict-keys @versions)) which-version)]
[(? x:versioned-struct? vs) (send vs x:decode port parent)] [(? x:versioned-dict? vs) (send vs x:decode port parent)]
[field-object (parse-fields port res field-object)])) [field-object (parse-fields port res field-object)]))
(define/override (pre-encode val) val) (define/override (pre-encode val) val)
(define/override (x:encode field-data port [parent-arg #f]) (define/override (x:encode field-data port [parent-arg #f])
(unless (dict? field-data) (unless (dict? field-data)
(raise-argument-error 'x:versioned-struct-encode "dict" field-data)) (raise-argument-error 'x:versioned-dict-encode "dict" field-data))
(define parent (mhasheq x:pointers-key null (define parent (mhasheq x:pointers-key null
x:start-offset-key (pos port) x:start-offset-key (pos port)
x:parent-key parent-arg x:parent-key parent-arg
@ -70,7 +70,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(define fields (select-field-set field-data)) (define fields (select-field-set field-data))
(unless (andmap (λ (key) (member key (dict-keys field-data))) (dict-keys fields)) (unless (andmap (λ (key) (member key (dict-keys field-data))) (dict-keys fields))
(raise-argument-error 'x:versioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (dict-keys field-data))) (raise-argument-error 'x:versioned-dict-encode (format "hash that contains superset of xversioned-dict keys: ~a" (dict-keys fields)) (dict-keys field-data)))
(for ([(key type) (in-dict fields)]) (for ([(key type) (in-dict fields)])
(send type x:encode (dict-ref field-data key) port parent)) (send type x:encode (dict-ref field-data key) port parent))
(let loop ([i 0]) (let loop ([i 0])
@ -82,7 +82,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(define/override (x:size [val-arg #f] [parent-arg #f] [include-pointers #t]) (define/override (x:size [val-arg #f] [parent-arg #f] [include-pointers #t])
(unless val-arg (unless val-arg
(raise-argument-error 'x:versioned-struct-size "value" val-arg)) (raise-argument-error 'x:versioned-dict-size "value" val-arg))
(define val (pre-encode val-arg)) (define val (pre-encode val-arg))
(define parent (mhasheq x:parent-key parent-arg (define parent (mhasheq x:parent-key parent-arg
x:val-key val x:val-key val
@ -101,15 +101,20 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(define pointer-size (if include-pointers (dict-ref parent x:pointer-size-key) 0)) (define pointer-size (if include-pointers (dict-ref parent x:pointer-size-key) 0))
(+ version-size header-size fields-size pointer-size)))) (+ version-size header-size fields-size pointer-size))))
(define (x:versioned-struct? x) (is-a? x x:versioned-struct%)) (define (x:versioned-dict? x) (is-a? x x:versioned-dict%))
(define (x:versioned-struct type (define (x:versioned-dict type
[versions (dictify)] [versions (dictify)]
#:pre-encode [pre-proc #f] #:pre-encode [pre-proc #f]
#:post-decode [post-proc #f] #:post-decode [post-proc #f]
#:base-class [base-class x:versioned-struct%]) #:base-class [base-class x:versioned-dict%])
(new (generate-subclass base-class pre-proc post-proc) (new (generate-subclass base-class pre-proc post-proc)
[type type] [type type]
[versions versions] [versions versions]
[fields #f])) [fields #f]))
;; bw compat
(define x:versioned-struct% x:versioned-dict%)
(define x:versioned-struct? x:versioned-dict?)
(define x:versioned-struct x:versioned-dict)
Write Preview
Loading…
Cancel
Save