change version-key name

main
Matthew Butterick 6 years ago
parent a14d4feddb
commit 51db49a10b

@ -6,6 +6,8 @@
"generic.rkt") "generic.rkt")
(provide (all-defined-out)) (provide (all-defined-out))
(define x:version-key 'x:version)
(define (dict-ref* d . keys) (define (dict-ref* d . keys)
(for/fold ([d d]) (for/fold ([d d])
([k (in-list keys)]) ([k (in-list keys)])
@ -16,7 +18,7 @@
(file-position p new-pos)) (file-position p new-pos))
(file-position p)) (file-position p))
(define x:enomorphic<%> (define xenomorphic<%>
(interface* () (interface* ()
([(generic-property gen:xenomorphic) ([(generic-property gen:xenomorphic)
(generic-method-table (generic-method-table
@ -58,7 +60,7 @@
[else CLASS])) [else CLASS]))
(define xenobase% (define xenobase%
(class* object% (x:enomorphic<%>) (class* object% (xenomorphic<%>)
(super-new) (super-new)
(define/pubment (x:decode input-port [parent #f]) (define/pubment (x:decode input-port [parent #f])

@ -25,9 +25,9 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'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")])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb" 'age 21 'version 0))) (check-equal? (decode vstruct) (mhasheq 'name "roxyb" 'age 21 x:version-key 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 🤘\x15\x00"))]) (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 🤘\x15\x00"))])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb 🤘" 'age 21 'version 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 throw for unknown version" "versioned struct: decode should throw for unknown version"
@ -54,17 +54,17 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
(check-equal? (decode vstruct) (mhasheq 'name "roxyb" (check-equal? (decode vstruct) (mhasheq 'name "roxyb"
'age 21 'age 21
'alive 1 'alive 1
'version 0))) x:version-key 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 🤘\x00"))]) (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 🤘\x00"))])
(check-equal? (decode vstruct) (mhasheq 'name "roxyb 🤘" (check-equal? (decode vstruct) (mhasheq 'name "roxyb 🤘"
'age 21 'age 21
'version 1 x:version-key 1
'alive 1 'alive 1
'gender 0))))) 'gender 0)))))
(test-case (test-case
"versioned struct: decode should support parent version key" "versioned struct: decode should support parent version key"
(let ([vstruct (x:versioned-struct 'version (let ([vstruct (x:versioned-struct 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)
@ -72,11 +72,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'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")])
(check-equal? (decode vstruct #:parent (mhash 'version 0)) (check-equal? (decode vstruct #:parent (mhash x:version-key 0))
(mhasheq 'name "roxyb" 'age 21 'version 0))) (mhasheq 'name "roxyb" 'age 21 x:version-key 0)))
(parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 🤘\x15\x00"))]) (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 🤘\x15\x00"))])
(check-equal? (decode vstruct #:parent (mhash 'version 1)) (check-equal? (decode vstruct #:parent (mhash x:version-key 1))
(mhasheq 'name "roxyb 🤘" 'age 21 'version 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 struct: decode should support sub versioned structs"
@ -90,14 +90,14 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
1 (dictify 'name (x:string uint8) 1 (dictify 'name (x:string uint8)
'isDessert uint8)))))]) 'isDessert uint8)))))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (decode vstruct #:parent (mhash 'version 0)) (check-equal? (decode vstruct #:parent (mhash x:version-key 0))
(mhasheq 'name "roxyb" 'age 21 'version 0))) (mhasheq 'name "roxyb" 'age 21 x:version-key 0)))
(parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")]) (parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")])
(check-equal? (decode vstruct #:parent (mhash 'version 0)) (check-equal? (decode vstruct #:parent (mhash x:version-key 0))
(mhasheq 'name "pasta" 'version 0))) (mhasheq 'name "pasta" x:version-key 0)))
(parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")]) (parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")])
(check-equal? (decode vstruct #:parent (mhash 'version 0)) (check-equal? (decode vstruct #:parent (mhash x:version-key 0))
(mhasheq 'name "ice cream" 'isDessert 1 'version 1))))) (mhasheq 'name "ice cream" 'isDessert 1 x:version-key 1)))))
(test-case (test-case
"versioned struct: decode should support process hook" "versioned struct: decode should support process hook"
@ -111,7 +111,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))]) 'gender uint8)))])
(parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")])
(check-equal? (decode vstruct) (check-equal? (decode vstruct)
(mhasheq 'name "roxyb" 'processed "true" 'age 21 'version 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 struct: size should compute the correct size"
@ -124,11 +124,11 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'gender uint8)))]) 'gender uint8)))])
(check-equal? (size vstruct (mhasheq 'name "roxyb" (check-equal? (size vstruct (mhasheq 'name "roxyb"
'age 21 'age 21
'version 0)) 8) x:version-key 0)) 8)
(check-equal? (size vstruct (mhasheq 'name "roxyb 🤘" (check-equal? (size vstruct (mhasheq 'name "roxyb 🤘"
'gender 0 'gender 0
'age 21 'age 21
'version 1)) 14))) x:version-key 1)) 14)))
(test-case (test-case
"versioned struct: size should throw for unknown version" "versioned struct: size should throw for unknown version"
@ -139,7 +139,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:struct '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 'version 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 struct: size should support common header block"
@ -150,8 +150,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
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:struct 'name (x:string #:length uint8 #:encoding 'utf8)
'gender uint8)))]) 'gender uint8)))])
(check-equal? (size struct (mhasheq 'name "roxyb" 'age 21 'alive 1 'version 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 'version 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 struct: size should compute the correct size with pointers"
@ -165,7 +165,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
#:type (x:string uint8)))))]) #:type (x:string uint8)))))])
(check-equal? (size vstruct (mhasheq 'name "roxyb" (check-equal? (size vstruct (mhasheq 'name "roxyb"
'age 21 'age 21
'version 1 x:version-key 1
'ptr "hello")) 15))) 'ptr "hello")) 15)))
(test-case (test-case
@ -189,8 +189,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
(encode vstruct (mhasheq 'name "roxyb" 'age 21 'version 0) op) (encode vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 0) op)
(encode vstruct (mhasheq 'name "roxyb 🤘" 'age 21 'gender 0 'version 1) op) (encode vstruct (mhasheq 'name "roxyb 🤘" 'age 21 'gender 0 x:version-key 1) op)
(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
@ -203,7 +203,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'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 'version 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 struct: encode should support common header block"
@ -215,8 +215,8 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
1 (x:struct 'name (x:string #:length uint8 #:encoding 'utf8) 1 (x:struct '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 'version 0) op) (encode vstruct (mhasheq 'name "roxyb" 'age 21 'alive 1 x:version-key 0) op)
(encode vstruct (mhasheq 'name "roxyb 🤘" 'gender 0 'age 21 'alive 1 'version 1) op) (encode vstruct (mhasheq 'name "roxyb 🤘" 'gender 0 'age 21 'alive 1 x:version-key 1) op)
(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
@ -230,7 +230,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'ptr (x:pointer #:offset-type uint8 'ptr (x:pointer #:offset-type uint8
#:type (x:string uint8)))))] #:type (x:string uint8)))))]
[op (open-output-bytes)]) [op (open-output-bytes)])
(encode vstruct (mhasheq 'version 1 'name "roxyb" 'age 21 'ptr "hello") op) (encode vstruct (mhasheq x:version-key 1 'name "roxyb" 'age 21 'ptr "hello") op)
(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"))))
@ -244,7 +244,7 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe
'age uint8 'age uint8
'gender uint8)))] 'gender uint8)))]
[op (open-output-bytes)]) [op (open-output-bytes)])
(set-pre-encode! vstruct (λ (val) (dict-set! val 'version (if (dict-ref val 'gender #f) 1 0)) val)) (set-pre-encode! vstruct (λ (val) (dict-set! val x:version-key (if (dict-ref val 'gender #f) 1 0)) val))
(encode vstruct (mhasheq 'name "roxyb" 'age 21 'version 0) op) (encode vstruct (mhasheq 'name "roxyb" 'age 21 x:version-key 0) op)
(encode vstruct (mhasheq 'name "roxyb 🤘" 'age 21 'gender 0) op) (encode vstruct (mhasheq 'name "roxyb 🤘" 'age 21 'gender 0) op)
(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"))))

@ -1,4 +1,4 @@
#lang racket/base #lang debug racket/base
(require "helper.rkt" "struct.rkt" (require "helper.rkt" "struct.rkt"
racket/dict racket/dict
racket/class racket/class
@ -16,7 +16,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(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 '+xversioned-struct "integer, procedure, symbol, or xenomorphic" @type)) (raise-argument-error '+xversioned-struct "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:struct? v))) (dict-values @versions)))
(raise-argument-error '+xversioned-struct "dict of dicts or structish" @versions)) (raise-argument-error '+xversioned-struct "dict of dicts or structish" @versions))
@ -30,14 +30,17 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
[(symbol? @type) (λ (parent version) (dict-set! parent @type version))])) [(symbol? @type) (λ (parent version) (dict-set! parent @type version))]))
(define (extract-fields-dict val) (define (extract-fields-dict val)
(define field-object (dict-ref @versions (dict-ref val 'version #f) #f)) (define version-key
(unless field-object (or (dict-ref val x:version-key #f)
(raise-argument-error 'xversioned-struct-encode "valid version key" version)) (raise-argument-error 'xversioned-struct-encode "value for version key" x:version-key)))
(define field-object
(or (dict-ref @versions version-key #f)
(raise-argument-error 'xversioned-struct-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:struct? 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 (xstruct-setup port parent length)) (define res (xstruct-setup port parent length))
(dict-set! res 'version (dict-set! res x:version-key
(cond (cond
[(integer? @type) @type] [(integer? @type) @type]
[(or (symbol? @type) (procedure? @type)) [(or (symbol? @type) (procedure? @type))
@ -50,7 +53,7 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(xstruct-parse-fields port res (dict-ref @versions 'header))) (xstruct-parse-fields port res (dict-ref @versions 'header)))
(define fields (define fields
(or (dict-ref @versions (dict-ref res 'version #f) #f) (or (dict-ref @versions (dict-ref res x:version-key #f) #f)
(raise-argument-error 'xversioned-struct-decode "valid version key" (cons version @versions)))) (raise-argument-error 'xversioned-struct-decode "valid version key" (cons version @versions))))
(cond (cond
@ -68,19 +71,19 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
'pointerSize 0)) 'pointerSize 0))
(dict-set! parent 'pointerOffset (+ (pos port) (x:size encode-me parent #f))) (dict-set! parent 'pointerOffset (+ (pos port) (x:size encode-me parent #f)))
(unless (or (symbol? @type) (procedure? @type)) (unless (or (symbol? @type) (procedure? @type))
(send @type x:encode (dict-ref encode-me 'version #f) port parent)) (send @type x:encode (dict-ref encode-me x:version-key #f) port parent))
(define maybe-header-dict (dict-ref @versions 'header #f)) (define maybe-header-dict (dict-ref @versions 'header #f))
(when maybe-header-dict (when maybe-header-dict
(for ([(key type) (in-dict maybe-header-dict)]) (for ([(key type) (in-dict maybe-header-dict)])
(send type x:encode (dict-ref encode-me key) port parent))) (send type x:encode (dict-ref encode-me key) port parent)))
(define fields (extract-fields-dict encode-me)) (define fields (extract-fields-dict encode-me))
(unless (andmap (λ (key) (member key (dict-keys encode-me))) (dict-keys fields)) (unless (andmap (λ (key) (member key (dict-keys encode-me))) (dict-keys fields))
(raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys encode-me))) (raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of xversioned-struct keys: ~a" (dict-keys fields)) (hash-keys encode-me)))
(for ([(key type) (in-dict fields)]) (for ([(key type) (in-dict fields)])
(send type x:encode (dict-ref encode-me key) port parent)) (send type x:encode (dict-ref encode-me key) port parent))
(for ([ptr (in-list (dict-ref parent 'pointers))]) (for ([ptr (in-list (dict-ref parent 'pointers))])
(send (dict-ref ptr 'type) x:encode (dict-ref ptr 'val) port (dict-ref ptr 'parent)))) (send (dict-ref ptr 'type) x:encode (dict-ref ptr 'val) port (dict-ref ptr 'parent))))
(define/override (x:size [val #f] [parent-arg #f] [include-pointers #t]) (define/override (x:size [val #f] [parent-arg #f] [include-pointers #t])
(unless val (unless val
@ -90,13 +93,13 @@ https://github.com/mbutterick/restructure/blob/master/src/VersionedStruct.coffee
(let ([struct-type @type]) (let ([struct-type @type])
(if (or (symbol? struct-type) (procedure? struct-type)) (if (or (symbol? struct-type) (procedure? struct-type))
0 0
(send @type x:size (dict-ref val 'version) parent)))) (send @type x:size (dict-ref val x:version-key) parent))))
(define header-size (define header-size
(for/sum ([(key type) (in-dict (or (dict-ref @versions 'header #f) null))]) (for/sum ([(key type) (in-dict (or (dict-ref @versions 'header #f) null))])
(send type x:size (and val (dict-ref val key)) parent))) (send type x:size (and val (dict-ref val key)) parent)))
(define fields-size (define fields-size
(for/sum ([(key type) (in-dict (extract-fields-dict val))]) (for/sum ([(key type) (in-dict (extract-fields-dict val))])
(send type x:size (and val (dict-ref val key)) parent))) (send type x:size (and val (dict-ref val key)) parent)))
(define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0)) (define pointer-size (if include-pointers (dict-ref parent 'pointerSize) 0))
(+ version-size header-size fields-size pointer-size)))) (+ version-size header-size fields-size pointer-size))))

Loading…
Cancel
Save