From a4385f8c13b656185f67aa235f5de5351c7d50b5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 12 Dec 2018 11:31:43 -0800 Subject: [PATCH] versioned struct done --- xenomorph/xenomorph/redo/struct.rkt | 3 +- .../redo/test/versioned-struct-test.rkt | 543 ++++++++---------- xenomorph/xenomorph/redo/versioned-struct.rkt | 86 ++- 3 files changed, 307 insertions(+), 325 deletions(-) diff --git a/xenomorph/xenomorph/redo/struct.rkt b/xenomorph/xenomorph/redo/struct.rkt index e666d039..cb0fa494 100644 --- a/xenomorph/xenomorph/redo/struct.rkt +++ b/xenomorph/xenomorph/redo/struct.rkt @@ -101,7 +101,8 @@ https://github.com/mbutterick/restructure/blob/master/src/Struct.coffee (encode (d:dict-ref ptr 'type) (d:dict-ref ptr 'val) port #:parent (d:dict-ref ptr 'parent))) (unless port-arg (get-output-bytes port))) -(struct xstruct (fields post-decode pre-encode) #:transparent #:mutable +(struct structish () #:transparent) +(struct xstruct structish (fields post-decode pre-encode) #:transparent #:mutable #:methods gen:xenomorphic [(define decode xstruct-decode) (define encode xstruct-encode) diff --git a/xenomorph/xenomorph/redo/test/versioned-struct-test.rkt b/xenomorph/xenomorph/redo/test/versioned-struct-test.rkt index 86fb6d73..efd36235 100644 --- a/xenomorph/xenomorph/redo/test/versioned-struct-test.rkt +++ b/xenomorph/xenomorph/redo/test/versioned-struct-test.rkt @@ -1,9 +1,11 @@ #lang debug racket/base (require rackunit + racket/dict sugar/unstable/dict "../helper.rkt" "../number.rkt" "../string.rkt" + "../pointer.rkt" "../versioned-struct.rkt") #| @@ -14,328 +16,259 @@ https://github.com/mbutterick/restructure/blob/master/test/VersionedStruct.coffe (test-case "decode should get version from number type" (let ([vstruct (+xversioned-struct uint8 - (dictify - 0 (dictify 'name (+xstring uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+xstring uint8 'utf8) - 'age uint8 - 'gender uint8)))]) - + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))]) (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) (check-equal? (dump (decode vstruct)) '((version . 0) (age . 21) (name . "roxyb")))) - (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x0aroxyb 馃\x15\x00"))]) (check-equal? (dump (decode vstruct)) '((version . 1) (age . 21) (name . "roxyb 馃") (gender . 0)))))) -#| - -; it 'should throw for unknown version', -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))]) - - (parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")]) - (check-exn exn:fail:contract? (位 () (decode struct))))) - - -; -; it 'should support common header block', -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 'header (dictify 'age uint8 - 'alive uint8) - 0 (dictify 'name (+StringT uint8 'ascii)) - 1 (dictify 'name (+StringT uint8 'utf8) - 'gender uint8)))]) - - (parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")]) - (check-equal? (dump (decode struct)) (hasheq 'name "roxyb" - 'age 21 - 'alive 1 - 'version 0))) - - (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 馃\x00"))]) - (check-equal? (dump (decode struct)) (hasheq 'name "roxyb 馃" - 'age 21 - 'version 1 - 'alive 1 - 'gender 0)))) - - -; it 'should support parent version key', -> - -(let ([struct (+VersionedStruct 'version - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))]) - - (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")]) - (check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "roxyb" - 'age 21 - 'version 0))) - - (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 馃\x15\x00"))]) - (check-equal? (dump (decode struct #:parent (mhash 'version 1))) (hasheq 'name "roxyb 馃" - 'age 21 - 'version 1 - 'gender 0)))) - - - -; -; it 'should support sub versioned structs', -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8)) - 1 (dictify 'name (+StringT uint8) - 'isDessert uint8)))))]) - - (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) - (check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "roxyb" - 'age 21 - 'version 0))) - - (parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")]) - (check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "pasta" - 'version 0))) - - (parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")]) - (check-equal? (dump (decode struct #:parent (mhash 'version 0))) (hasheq 'name "ice cream" - 'isDessert 1 - 'version 1)))) - - -; -; it 'should support process hook', -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))]) - (set-field! post-decode struct (位 (o stream ctx) (ref-set! o 'processed "true") o)) - (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) - (check-equal? (dump (decode struct)) (hasheq 'name "roxyb" - 'processed "true" - 'age 21 - 'version 0)))) - - -; -; describe 'size', -> -; it 'should compute the correct size', -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))]) - - (check-equal? (size struct (mhasheq 'name "roxyb" - 'age 21 - 'version 0)) 8) - - (check-equal? (size struct (mhasheq 'name "roxyb 馃" - 'gender 0 - 'age 21 - 'version 1)) 14)) - - - - -; -; it 'should throw for unknown version', -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))]) - - (check-exn exn:fail:contract? (位 () (size struct (mhasheq 'name "roxyb" - 'age 21 - 'version 5))))) - - -; -; it 'should support common header block', -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 'header (dictify 'age uint8 - 'alive uint8) - 0 (dictify 'name (+StringT uint8 'ascii)) - 1 (dictify 'name (+StringT uint8 'utf8) - 'gender uint8)))]) - - (check-equal? (size struct (mhasheq 'name "roxyb" - 'age 21 - 'alive 1 - 'version 0)) 9) - - (check-equal? (size struct (mhasheq 'name "roxyb 馃" - 'gender 0 - 'age 21 - 'alive 1 - 'version 1)) 15)) - - - -; it 'should compute the correct size with pointers', -> - - -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'ptr (+Pointer uint8 (+StringT uint8)))))]) - - (check-equal? (size struct (mhasheq 'name "roxyb" - 'age 21 - 'version 1 - 'ptr "hello")) 15)) - +(test-case + "decode should throw for unknown version" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + (parameterize ([current-input-port (open-input-bytes #"\x05\x05roxyb\x15")]) + (check-exn exn:fail:contract? (位 () (decode vstruct)))))) -; -; it 'should throw if no value is given', -> +(test-case + "decode should support common header block" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 'header (dictify 'age uint8 + 'alive uint8) + 0 (dictify 'name (+xstring uint8 'ascii)) + 1 (dictify 'name (+xstring uint8 'utf8) + 'gender uint8)))]) + (parameterize ([current-input-port (open-input-bytes #"\x00\x15\x01\x05roxyb")]) + (check-equal? (dump (decode vstruct)) '((version . 0) (name . "roxyb") (age . 21) (alive . 1)))) + (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x01\x15\x01\x0aroxyb 馃\x00"))]) + (check-equal? (dump (decode vstruct)) '((version . 1) + (gender . 0) + (name . "roxyb 馃") + (age . 21) + (alive . 1)))))) +(test-case + "decode should support parent version key" + (let ([vstruct (+xversioned-struct 'version + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + (parameterize ([current-input-port (open-input-bytes #"\x05roxyb\x15")]) + (check-equal? (dump (decode vstruct #:parent (mhash 'version 0))) + '((version . 0) (age . 21) (name . "roxyb")))) + (parameterize ([current-input-port (open-input-bytes (string->bytes/utf-8 "\x0aroxyb 馃\x15\x00"))]) + (check-equal? (dump (decode vstruct #:parent (mhash 'version 1))) + '((version . 1) (age . 21) (name . "roxyb 馃") (gender . 0)))))) +(test-case + "decode should support sub versioned structs" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8)) + 1 (dictify 'name (+xstring uint8) + 'isDessert uint8)))))]) + (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) + (check-equal? (dump (decode vstruct #:parent (mhash 'version 0))) + '((version . 0) (age . 21) (name . "roxyb")))) + (parameterize ([current-input-port (open-input-bytes #"\x01\x00\x05pasta")]) + (check-equal? (dump (decode vstruct #:parent (mhash 'version 0))) + '((version . 0) (name . "pasta")))) + (parameterize ([current-input-port (open-input-bytes #"\x01\x01\x09ice cream\x01")]) + (check-equal? (dump (decode vstruct #:parent (mhash 'version 0))) + '((version . 1) (isDessert . 1) (name . "ice cream")))))) -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))]) - - (check-exn exn:fail:contract? (位 () (size struct)))) +(test-case + "decode should support process hook" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + (set-xversioned-struct-post-decode! vstruct (位 (o stream ctx) (dict-set! o 'processed "true") o)) + (parameterize ([current-input-port (open-input-bytes #"\x00\x05roxyb\x15")]) + (check-equal? (dump (decode vstruct)) + '((processed . "true") (version . 0) (age . 21) (name . "roxyb")))))) +(test-case + "size should compute the correct size" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + (check-equal? (size vstruct (mhasheq 'name "roxyb" + 'age 21 + 'version 0)) 8) + (check-equal? (size vstruct (mhasheq 'name "roxyb 馃" + 'gender 0 + 'age 21 + 'version 1)) 14))) +(test-case + "size should throw for unknown version" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + (check-exn exn:fail:contract? (位 () (size vstruct (mhasheq 'name "roxyb" + 'age 21 + 'version 5)))))) -; describe 'encode', -> -; it 'should encode objects to buffers', (done) -> +(test-case + "size should support common header block" + (let ([struct (+xversioned-struct uint8 + (dictify + 'header (dictify 'age uint8 + 'alive uint8) + 0 (dictify 'name (+xstring uint8 'ascii)) + 1 (dictify 'name (+xstring uint8 'utf8) + 'gender uint8)))]) + (check-equal? (size struct (mhasheq 'name "roxyb" + 'age 21 + 'alive 1 + 'version 0)) 9) + (check-equal? (size struct (mhasheq 'name "roxyb 馃" + 'gender 0 + 'age 21 + 'alive 1 + 'version 1)) 15))) -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))] - [port (open-output-bytes)]) - (encode struct (mhasheq 'name "roxyb" - 'age 21 - 'version 0) port) - (encode struct (mhasheq 'name "roxyb 馃" - 'age 21 - 'gender 0 - 'version 1) port) - (check-equal? (dump port) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 馃\x15\x00"))) +(test-case + "size should compute the correct size with pointers" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'ptr (+xpointer uint8 (+xstring uint8)))))]) + (check-equal? (size vstruct (mhasheq 'name "roxyb" + 'age 21 + 'version 1 + 'ptr "hello")) 15))) +(test-case + "size should throw if no value is given" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))]) + (check-exn exn:fail:contract? (位 () (size vstruct))))) -; -; it 'should throw for unknown version', -> +(test-case + "encode should encode objects to buffers" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))] + [op (open-output-bytes)]) + (encode vstruct (mhasheq 'name "roxyb" + 'age 21 + 'version 0) op) + (encode vstruct (mhasheq 'name "roxyb 馃" + 'age 21 + 'gender 0 + 'version 1) op) + (check-equal? (dump op) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 馃\x15\x00")))) -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))] - [port (open-output-bytes)]) - (check-exn exn:fail:contract? (位 () (encode struct port (mhasheq 'name "roxyb" +(test-case + "encode should throw for unknown version" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))] + [op (open-output-bytes)]) + (check-exn exn:fail:contract? (位 () (encode vstruct op (mhasheq 'name "roxyb" 'age 21 - 'version 5))))) - - - -; it 'should support common header block', (done) -> - -(let ([struct (+VersionedStruct uint8 - (dictify - 'header (dictify 'age uint8 - 'alive uint8) - 0 (dictify 'name (+StringT uint8 'ascii)) - 1 (dictify 'name (+StringT uint8 'utf8) - 'gender uint8)))] - [stream (open-output-bytes)]) - - (encode struct (mhasheq 'name "roxyb" - 'age 21 - 'alive 1 - 'version 0) stream) - - (encode struct (mhasheq 'name "roxyb 馃" - 'gender 0 - 'age 21 - 'alive 1 - 'version 1) stream) - - (check-equal? (dump stream) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 馃\x00"))) - - - -; it 'should encode pointer data after structure', (done) -> + 'version 5)))))) -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'ptr (+Pointer uint8 (+StringT uint8)))))] - [stream (open-output-bytes)]) - (encode struct (mhasheq 'version 1 - 'name "roxyb" - 'age 21 - 'ptr "hello") stream) - - (check-equal? (dump stream) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello"))) - - - - -; it 'should support preEncode hook', (done) -> +(test-case + "encode should support common header block" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 'header (dictify 'age uint8 + 'alive uint8) + 0 (dictify 'name (+xstring uint8 'ascii)) + 1 (dictify 'name (+xstring uint8 'utf8) + 'gender uint8)))] + [op (open-output-bytes)]) + (encode vstruct (mhasheq 'name "roxyb" + 'age 21 + 'alive 1 + 'version 0) op) + (encode vstruct (mhasheq 'name "roxyb 馃" + 'gender 0 + 'age 21 + 'alive 1 + 'version 1) op) + (check-equal? (dump op) (string->bytes/utf-8 "\x00\x15\x01\x05roxyb\x01\x15\x01\x0aroxyb 馃\x00")))) -(let ([struct (+VersionedStruct uint8 - (dictify - 0 (dictify 'name (+StringT uint8 'ascii) - 'age uint8) - 1 (dictify 'name (+StringT uint8 'utf8) - 'age uint8 - 'gender uint8)))] - [stream (open-output-bytes)]) - (set-field! pre-encode struct (位 (val port) (ref-set! val 'version (if (ref val 'gender) 1 0)) val)) - (encode struct (mhasheq 'name "roxyb" - 'age 21 - 'version 0) stream) - (encode struct (mhasheq 'name "roxyb 馃" - 'age 21 - 'gender 0) stream) - (check-equal? (dump stream) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 馃\x15\x00"))) +(test-case + "encode should encode pointer data after structure" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'ptr (+xpointer uint8 (+xstring uint8)))))] + [op (open-output-bytes)]) + (encode vstruct (mhasheq 'version 1 + 'name "roxyb" + 'age 21 + 'ptr "hello") op) + + (check-equal? (dump op) (string->bytes/utf-8 "\x01\x05roxyb\x15\x09\x05hello")))) -|# \ No newline at end of file +(test-case + "encode should support preEncode hook" + (let ([vstruct (+xversioned-struct uint8 + (dictify + 0 (dictify 'name (+xstring uint8 'ascii) + 'age uint8) + 1 (dictify 'name (+xstring uint8 'utf8) + 'age uint8 + 'gender uint8)))] + [stream (open-output-bytes)]) + (set-xversioned-struct-pre-encode! vstruct + (位 (val port) (dict-set! val 'version (if (dict-ref val 'gender #f) 1 0)) val)) + (encode vstruct (mhasheq 'name "roxyb" + 'age 21 + 'version 0) stream) + (encode vstruct (mhasheq 'name "roxyb 馃" + 'age 21 + 'gender 0) stream) + (check-equal? (dump stream) (string->bytes/utf-8 "\x00\x05roxyb\x15\x01\x0aroxyb 馃\x15\x00")))) \ No newline at end of file diff --git a/xenomorph/xenomorph/redo/versioned-struct.rkt b/xenomorph/xenomorph/redo/versioned-struct.rkt index 339a1f5b..1b19aee5 100644 --- a/xenomorph/xenomorph/redo/versioned-struct.rkt +++ b/xenomorph/xenomorph/redo/versioned-struct.rkt @@ -14,13 +14,13 @@ https://github.com/mbuttrackerick/restructure/blob/master/src/VersionedStruct.co (define res (_setup port parent length)) (dict-set! res 'version - (cond - #;[forced-version] ; for testing purposes: pass an explicit version - [(or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs))) - (unless parent - (raise-argument-error 'xversioned-struct-decode "valid parent" parent)) - ((xversioned-struct-version-getter xvs) parent)] - [else (decode (xversioned-struct-type xvs) port)])) + (cond + #;[forced-version] ; for testing purposes: pass an explicit version + [(or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs))) + (unless parent + (raise-argument-error 'xversioned-struct-decode "valid parent" parent)) + ((xversioned-struct-version-getter xvs) parent)] + [else (decode (xversioned-struct-type xvs) port)])) (when (dict-ref (xversioned-struct-versions xvs) 'header #f) (_parse-fields port res (dict-ref (xversioned-struct-versions xvs) 'header))) @@ -28,20 +28,66 @@ https://github.com/mbuttrackerick/restructure/blob/master/src/VersionedStruct.co (define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref res 'version #f) #f) (raise-argument-error 'xversioned-struct-decode "valid version key" (cons version (xversioned-struct-versions xvs))))) - (cond - [(xversioned-struct? fields) (decode fields port #:parent parent)] - [else (_parse-fields port res fields) - res])) - -(define (xversioned-struct-size xvs [val #f] [parent #f]) - 42) + ((xversioned-struct-post-decode xvs) + (cond + [(xversioned-struct? fields) (decode fields port #:parent parent)] + [else (_parse-fields port res fields) + res]) port parent)) + +(define (xversioned-struct-size xvs [val #f] [parent #f] [include-pointers #t]) + (unless val + (raise-argument-error 'xversioned-struct-size "value" val)) + (define ctx (mhash 'parent parent 'val val 'pointerSize 0)) + (define version-size + (if (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))) + (size (xversioned-struct-type xvs) (dict-ref val 'version) ctx) + 0)) + (define header-size + (for/sum ([(key type) (in-dict (or (dict-ref (xversioned-struct-versions xvs) 'header #f) null))]) + (size type (and val (dict-ref val key)) ctx))) + (define fields-size + (let ([fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version)) + (raise-argument-error 'xversioned-struct-size "valid version key" version))]) + (for/sum ([(key type) (in-dict fields)]) + (size type (and val (dict-ref val key)) ctx)))) + (define pointer-size (if include-pointers (dict-ref ctx 'pointerSize) 0)) + (+ version-size header-size fields-size pointer-size)) (define (xversioned-struct-encode xvs val-arg [port-arg (current-output-port)] #:parent [parent #f]) (define port (if (output-port? port-arg) port-arg (open-output-bytes))) - 42 + (define val ((xversioned-struct-pre-encode xvs) val-arg port)) + + (unless (dict? val) + (raise-argument-error 'xversioned-struct-encode "dict" val)) + + (define ctx (mhash 'pointers null + 'startOffset (pos port) + 'parent parent + 'val val + 'pointerSize 0)) + (dict-set! ctx 'pointerOffset (+ (pos port) (xversioned-struct-size xvs val ctx #f))) + + (when (not (or (symbol? (xversioned-struct-type xvs)) (procedure? (xversioned-struct-type xvs)))) + (encode (xversioned-struct-type xvs) (dict-ref val 'version #f) port)) + + (when (dict-ref (xversioned-struct-versions xvs) 'header #f) + (for ([(key type) (in-dict (dict-ref (xversioned-struct-versions xvs) 'header))]) + (encode type (dict-ref val key) port #:parent ctx))) + + (define fields (or (dict-ref (xversioned-struct-versions xvs) (dict-ref val 'version #f)) + (raise-argument-error 'xversioned-struct-encode "valid version key" version))) + + (unless (andmap (位 (key) (member key (dict-keys val))) (dict-keys fields)) + (raise-argument-error 'xversioned-struct-encode (format "hash that contains superset of Struct keys: ~a" (dict-keys fields)) (hash-keys val))) + + (for ([(key type) (in-dict fields)]) + (encode type (dict-ref val key) port #:parent ctx)) + (for ([ptr (in-list (dict-ref ctx 'pointers))]) + (encode (dict-ref ptr 'type) (dict-ref ptr 'val) port #:parent (dict-ref ptr 'parent))) + (unless port-arg (get-output-bytes port))) -(struct xversioned-struct (type versions version-getter version-setter) #:transparent +(struct xversioned-struct structish (type versions version-getter version-setter pre-encode post-decode) #:transparent #:mutable #:methods gen:xenomorphic [(define decode xversioned-struct-decode) (define encode xversioned-struct-encode) @@ -51,15 +97,17 @@ https://github.com/mbuttrackerick/restructure/blob/master/src/VersionedStruct.co (unless (for/or ([proc (list integer? procedure? xenomorphic? symbol?)]) (proc type)) (raise-argument-error '+xversioned-struct "integer, procedure, symbol, or xenomorphic" type)) - (unless (and (dict? versions) (andmap (位 (v) (or (dict? v) (xstruct? v))) (dict-values versions))) - (raise-argument-error '+xversioned-struct "dict of dicts or xstructs" versions)) + (unless (and (dict? versions) (andmap (位 (v) (or (dict? v) (structish? v))) (dict-values versions))) + (raise-argument-error '+xversioned-struct "dict of dicts or structish" versions)) (define version-getter (cond [(procedure? type) type] [(symbol? type) (位 (parent) (dict-ref parent type))])) (define version-setter (cond [(procedure? type) type] [(symbol? type) (位 (parent version) (dict-set! parent type version))])) - (xversioned-struct type versions version-getter version-setter)) + (define (no-op-pre-encode val port) val) + (define (no-op-post-decode xvs port ctx) xvs) + (xversioned-struct type versions version-getter version-setter no-op-pre-encode no-op-post-decode)) #| (define-subclass Struct (VersionedStruct type [versions (dictify)])