diff --git a/xenomorph/xenomorph/optional.rkt b/xenomorph/xenomorph/optional.rkt index 2747130f..657fe61a 100644 --- a/xenomorph/xenomorph/optional.rkt +++ b/xenomorph/xenomorph/optional.rkt @@ -1,5 +1,8 @@ #lang racket/base -(require "base.rkt" racket/class racket/match) +(require "base.rkt" + racket/class + racket/match + racket/contract) (provide (all-defined-out)) #| @@ -32,13 +35,30 @@ https://github.com/mbutterick/restructure/blob/master/src/Optional.coffee (if (resolve-condition parent) (send @type x:size val parent) 0)))) (define no-val (gensym)) -(define (x:optional [type-arg #f] [cond-arg no-val] + +(define (x:optional? x) (is-a? x x:optional%)) + +(define/contract (x:optional + [type-arg #f] + [cond-arg no-val] #:type [type-kwarg #f] #:condition [cond-kwarg no-val] #:pre-encode [pre-proc #f] #:post-decode [post-proc #f] #:base-class [base-class x:optional%]) + (() + ((or/c xenomorphic? #false) + any/c + #:type (or/c xenomorphic? #false) + #:condition any/c + #:pre-encode (or/c (any/c . -> . any/c) #false) + #:post-decode (or/c (any/c . -> . any/c) #false) + #:base-class (λ (c) (subclass? c x:optional%))) + . ->* . + x:optional?) (define type (or type-arg type-kwarg)) + (unless (xenomorphic? type) + (raise-argument-error 'x:optional "xenomorphic type" type)) (define condition (cond [(and (eq? cond-arg no-val) (eq? cond-kwarg no-val)) #true] [(not (eq? cond-arg no-val)) cond-arg] diff --git a/xenomorph/xenomorph/scribblings/xenomorph.scrbl b/xenomorph/xenomorph/scribblings/xenomorph.scrbl index a490f17b..ef29f723 100644 --- a/xenomorph/xenomorph/scribblings/xenomorph.scrbl +++ b/xenomorph/xenomorph/scribblings/xenomorph.scrbl @@ -1222,6 +1222,71 @@ Generate an instance of @racket[x:enum%] (or a subclass of @racket[x:enum%]) wit @defmodule[xenomorph/optional] +A wrapper format that decodes or encodes only if the embedded condition evaluates to true. + + +@defclass[x:optional% x:base% ()]{ +Base class for optional formats. Use @racket[x:optional] to conveniently instantiate new optional formats. + + +@defconstructor[ +([type xenomorphic?] +[condition any/c])]{ +Create class instance that represents an optional format. See @racket[x:optional] for a description of the fields. + +} + +@defmethod[ +#:mode extend +(x:decode +[input-port input-port?] +[parent (or/c xenomorphic? #false)]) +hash?]{ +Returns a value if the condition is met, otherwise returns @racket[(void)]. +} + +@defmethod[ +#:mode extend +(x:encode +[val any/c] +[input-port input-port?] +[parent (or/c xenomorphic? #false)]) +bytes?]{ +Encodes @racket[val] as a @tech{byte string}, but only if the embedded condition is met. +} + +} + +@defproc[ +(x:optional? +[x any/c]) +boolean?]{ +Whether @racket[x] is an object of type @racket[x:optional%]. +} + +@defproc[ +(x:optional +[type-arg (or/c xenomorphic? #false) #false] +[cond-arg any/c] +[#:type type-kw (or/c xenomorphic? #false)] +[#:condition cond-kw any/c #true] +[#: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] +[#:base-class base-class (λ (c) (subclass? c x:optional%)) x:optional%] +) +x:optional?]{ +Generate an instance of @racket[x:optional%] (or a subclass of @racket[x:optional%]) with certain optional attributes. + +@racket[type-arg] or @racket[type-kw] (whichever is provided, though @racket[type-arg] takes precedence) controls the type wrapped by the optional object, which must be @racket[xenomorphic?]. + +@racket[cond-arg] or @racket[cond-kw] (whichever is provided, though @racket[cond-arg] takes precedence) is the condition that is evaluated to determine if the optional object should encode or decode. If the condition is a procedure, the procedure is evaluated for its result. Default is @racket[#true]. + +@racket[pre-encode-proc] and @racket[post-decode-proc] control the pre-encoding and post-decoding procedures, respectively. Each takes as input the value to be processed and returns a new value. + +@racket[base-class] controls the class used for instantiation of the new object. +} + + @subsection{Reserved} diff --git a/xenomorph/xenomorph/test/optional-test.rkt b/xenomorph/xenomorph/test/optional-test.rkt index 97433938..c0ee9efc 100644 --- a/xenomorph/xenomorph/test/optional-test.rkt +++ b/xenomorph/xenomorph/test/optional-test.rkt @@ -14,103 +14,103 @@ https://github.com/mbutterick/restructure/blob/master/test/Optional.coffee (test-case "optional: decode should not decode when condition is falsy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (x:optional #:type uint8 #:condition #f)) + (define optional (x:optional uint8 #:condition #f)) (check-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 0))) (test-case "optional: decode with post-decode" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (x:optional #:type uint8 #:condition #f #:post-decode (λ (val) 42))) + (define optional (x:optional uint8 #:condition #f #:post-decode (λ (val) 42))) (check-equal? (decode optional) 42) (check-equal? (pos (current-input-port)) 0))) (test-case "optional: decode should not decode when condition is a function and falsy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (x:optional #:type uint8 #:condition (λ _ #f))) + (define optional (x:optional uint8 #:condition (λ _ #f))) (check-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 0))) (test-case "optional: decode should decode when condition is omitted" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (x:optional #:type uint8)) + (define optional (x:optional uint8)) (check-not-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 1))) (test-case "optional: decode should decode when condition is truthy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (x:optional #:type uint8 #:condition #t)) + (define optional (x:optional uint8 #:condition #t)) (check-not-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 1))) (test-case "optional: decode should decode when condition is a function and truthy" (parameterize ([current-input-port (open-input-bytes (bytes 0))]) - (define optional (x:optional #:type uint8 #:condition (λ _ #t))) + (define optional (x:optional uint8 #:condition (λ _ #t))) (check-not-equal? (decode optional) (void)) (check-equal? (pos (current-input-port)) 1))) (test-case "optional: size" - (check-equal? (size (x:optional #:type uint8 #:condition #f)) 0)) + (check-equal? (size (x:optional uint8 #:condition #f)) 0)) (test-case "optional: size should return 0 when condition is a function and falsy" - (check-equal? (size (x:optional #:type uint8 #:condition (λ _ #f))) 0)) + (check-equal? (size (x:optional uint8 #:condition (λ _ #f))) 0)) (test-case "optional: size should return given type size when condition is omitted" - (check-equal? (size (x:optional #:type uint8)) 1)) + (check-equal? (size (x:optional uint8)) 1)) (test-case "optional: size should return given type size when condition is truthy" - (check-equal? (size (x:optional #:type uint8 #:condition #t)) 1)) + (check-equal? (size (x:optional uint8 #:condition #t)) 1)) (test-case "optional: size should return given type size when condition is a function and truthy" - (check-equal? (size (x:optional #:type uint8 #:condition (λ _ #t))) 1)) + (check-equal? (size (x:optional uint8 #:condition (λ _ #t))) 1)) (test-case "optional: encode should not encode when condition is falsy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (x:optional #:type uint8 #:condition #f)) + (define optional (x:optional uint8 #:condition #f)) (encode optional 128) (check-equal? (get-output-bytes (current-output-port)) (bytes)))) (test-case "optional: encode with pre-encode" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (x:optional #:type uint8 #:pre-encode (λ (val) 42))) + (define optional (x:optional uint8 #:pre-encode (λ (val) 42))) (encode optional 128) (check-equal? (get-output-bytes (current-output-port)) (bytes 42)))) (test-case "optional: encode should not encode when condition is a function and falsy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (x:optional #:type uint8 #:condition (λ _ #f))) + (define optional (x:optional uint8 #:condition (λ _ #f))) (encode optional 128) (check-equal? (get-output-bytes (current-output-port)) (bytes)))) (test-case "optional: encode should encode when condition is omitted" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (x:optional #:type uint8)) + (define optional (x:optional uint8)) (encode optional 128) (check-equal? (get-output-bytes (current-output-port)) (bytes 128)))) (test-case "optional: encode should encode when condition is truthy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (x:optional #:type uint8 #:condition #t)) + (define optional (x:optional uint8 #:condition #t)) (encode optional 128) (check-equal? (get-output-bytes (current-output-port)) (bytes 128)))) (test-case "optional: encode should encode when condition is a function and truthy" (parameterize ([current-output-port (open-output-bytes)]) - (define optional (x:optional #:type uint8 #:condition (λ _ #t))) + (define optional (x:optional uint8 #:condition (λ _ #t))) (encode optional 128) (check-equal? (get-output-bytes (current-output-port)) (bytes 128)))) \ No newline at end of file