diff --git a/xenomorph/xenomorph/enum.rkt b/xenomorph/xenomorph/enum.rkt index c62db0f9..3ad53399 100644 --- a/xenomorph/xenomorph/enum.rkt +++ b/xenomorph/xenomorph/enum.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "helper.rkt" racket/list) +(require racket/class "helper.rkt" racket/list) (provide (all-defined-out)) #| @@ -7,38 +7,53 @@ approximates https://github.com/mbutterick/restructure/blob/master/src/Enum.coffee |# -(define/post-decode (xenum-decode xe [port-arg (current-input-port)] #:parent [parent #f]) - (define port (->input-port port-arg)) - (parameterize ([current-input-port port]) - (define index (decode (xenum-type xe))) - (or (list-ref (xenum-options xe) index) index))) - -(define (xenum-size xe [val #f] #:parent [parent #f]) - (size (xenum-type xe))) - -(define/pre-encode (xenum-encode xe val [port-arg (current-output-port)] #:parent [parent #f]) - (define port (if (output-port? port-arg) port-arg (open-output-bytes))) - (parameterize ([current-output-port port]) - (define index (index-of (xenum-options xe) val)) - (unless index - (raise-argument-error 'xenum-encode "valid option" val)) - (encode (xenum-type xe) index) - (unless port-arg (get-output-bytes port)))) - -(struct xenum xbase (type options) #:transparent - #:methods gen:xenomorphic - [(define decode xenum-decode) - (define xdecode xenum-decode) - (define encode xenum-encode) - (define size xenum-size)]) +#;(define/post-decode (xenum-decode xe [port-arg (current-input-port)] #:parent [parent #f]) + (define port (->input-port port-arg)) + (parameterize ([current-input-port port]) + )) + +#;(define (xenum-size xe [val #f] #:parent [parent #f]) + ) + +#;(define/pre-encode (xenum-encode xe val [port-arg (current-output-port)] #:parent [parent #f]) + (define port (if (output-port? port-arg) port-arg (open-output-bytes))) + (parameterize ([current-output-port port]) + + (unless port-arg (get-output-bytes port)))) + +#;(struct xenum xbase (type options) #:transparent + #:methods gen:xenomorphic + [(define decode xenum-decode) + (define xdecode xenum-decode) + (define encode xenum-encode) + (define size xenum-size)]) + +(define xenum% + (class xenobase% + (super-new) + (init-field type values) + + (define/augment (xxdecode port parent) + (define index (send type xxdecode port parent)) + (or (list-ref values index) index)) + + (define/augment (xxencode val port [parent #f]) + (define index (index-of values val)) + (unless index + (raise-argument-error 'xenum-encode "valid option" val)) + (send type xxencode index port parent)) + + (define/augment (xxsize [val #f] [parent #f]) + (send type xxsize)))) (define (+xenum [type-arg #f] [values-arg #f] #:type [type-kwarg #f] - #:values [values-kwarg #f]) + #:values [values-kwarg #f] + #:subclass [class xenum%]) (define type (or type-arg type-kwarg)) - (unless (xenomorphic? type) + (unless (xenomorphic-type? type) (raise-argument-error '+xenum "xenomorphic type" type)) (define values (or values-arg values-kwarg)) (unless (list? values) (raise-argument-error '+xenum "list of values" values)) - (xenum type values)) \ No newline at end of file + (new class [type type] [values values])) \ No newline at end of file diff --git a/xenomorph/xenomorph/test/enum-test.rkt b/xenomorph/xenomorph/test/enum-test.rkt index fe3842a8..bcad246b 100644 --- a/xenomorph/xenomorph/test/enum-test.rkt +++ b/xenomorph/xenomorph/test/enum-test.rkt @@ -1,9 +1,11 @@ #lang racket/base (require rackunit + racket/class sugar/unstable/dict "../helper.rkt" "../number.rkt" - "../enum.rkt") + "../enum.rkt" + "../generic.rkt") #| approximates @@ -35,10 +37,15 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee (test-case "decode should decode with post-decode" (parameterize ([current-input-port (open-input-bytes (bytes 1 2 0))]) - (set-post-decode! e (λ (val) "foobar")) - (check-equal? (decode e) "foobar") - (check-equal? (decode e) "foobar") - (check-equal? (decode e) "foobar"))) + (define myenum% (class xenum% + (super-new) + (define/override (post-decode val) "foobar"))) + (define e2 (+xenum #:type uint8 + #:values '("foo" "bar" "baz") + #:subclass myenum%)) + (check-equal? (decode e2) "foobar") + (check-equal? (decode e2) "foobar") + (check-equal? (decode e2) "foobar"))) (test-case "encode should encode" @@ -51,14 +58,17 @@ https://github.com/mbutterick/restructure/blob/master/test/Enum.coffee (test-case "encode should encode with pre-encode" (parameterize ([current-output-port (open-output-bytes)]) - (set-pre-encode! e (λ (val) "foo")) - (encode e "bar") - (encode e "baz") - (encode e "foo") + (define myenum% (class xenum% + (super-new) + (define/override (pre-encode val) "foo"))) + (define e2 (+xenum #:type uint8 + #:values '("foo" "bar" "baz") + #:subclass myenum%)) + (encode e2 "bar") + (encode e2 "baz") + (encode e2 "foo") (check-equal? (get-output-bytes (current-output-port)) (bytes 0 0 0)))) (test-case "should throw on unknown option" - (set-pre-encode! e values) - (set-post-decode! e values) (check-exn exn:fail:contract? (λ () (encode e "unknown" (open-output-bytes))))) \ No newline at end of file