From 5641ab84db74fc47ddceb8b1ddc379ea182f4dd2 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 18 Jul 2014 20:58:30 -0500 Subject: [PATCH] add contracts to file/convertible --- .../file/scribblings/convertible.scrbl | 94 +++++++++++++++---- racket/collects/file/convertible.rkt | 58 ++++++++++-- 2 files changed, 125 insertions(+), 27 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl b/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl index 623f8131b2..57edc59da8 100644 --- a/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl +++ b/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl @@ -64,15 +64,56 @@ should be considered standard: but for an PDF document} ] -@defthing[prop:convertible struct-type-property?]{ +@defthing[prop:convertible + (struct-type-property/c + (->i ([v convertible?] [request symbol?] [default default/c]) + [result + (case request + [(text) + (or/c string? default/c)] + [(gif-bytes + png-bytes + png@2x-bytes + ps-bytes + eps-bytes + pdf-bytes + svg-bytes) + (or/c bytes? default/c)] + [(png-bytes+bounds + png@2x-bytes+bounds + eps-bytes+bounds + pdf-bytes+bounds) + (or/c (list/c bytes? + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?))) + default/c)] + [(png-bytes+bounds8 + png@2x-bytes+bounds8 + eps-bytes+bounds8 + pdf-bytes+bounds8) + (or/c (list/c bytes? + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?))) + default/c)] + [else (or/c opaque-default/c any/c)])]))]{ -A property whose value should be a procedure of three arguments. The -procedure is called when a structure with the property is passed to -@racket[convert]; the first argument to the procedure is the -structure, the second argument is a symbol for the requested -conversion, and the third argument is a value to return (typically -@racket[#f] if the conversion is not supported. The procedure's result -depends on the requested conversion.} +A property whose value is invoked by @racket[convert]. + +The @racket[_v] argument to the procedure is the +structure, the @racket[_request] argument is a symbol for the requested +conversion, and the @racket[_default] argument is a value to return (typically +@racket[#f] if the conversion is not supported). The procedure's result +depends on the requested conversion, as above. + +The @racket[default/c] contract is one generated by @racket[new-α/c].} @defproc[(convertible? [v any/c]) boolean?]{ @@ -81,20 +122,30 @@ Returns @racket[#t] if @racket[v] supports the conversion protocol, @defproc[(convert [v convertible?] [request symbol?] [default any/c #f]) (case request - [(text) (or/c string? (λ (x) (eq? x default)))] - [(gif-bytes png-bytes png@2x-bytes - ps-bytes eps-bytes pdf-bytes svg-bytes) - (or/c bytes? (λ (x) (eq? x default)))] - [(png-bytes+bounds png@2x-bytes+bounds - eps-bytes+bounds pdf-bytes+bounds) + [(text) + (or/c string? default/c)] + [(gif-bytes + png-bytes + png@2x-bytes + ps-bytes + eps-bytes + pdf-bytes + svg-bytes) + (or/c bytes? default/c)] + [(png-bytes+bounds + png@2x-bytes+bounds + eps-bytes+bounds + pdf-bytes+bounds) (or/c (list/c bytes? (and/c real? (not/c negative?)) (and/c real? (not/c negative?)) (and/c real? (not/c negative?)) (and/c real? (not/c negative?))) - (λ (x) (eq? x default)))] - [(png-bytes+bounds8 png@2x-bytes+bounds8 - eps-bytes+bounds8 pdf-bytes+bounds8) + default/c)] + [(png-bytes+bounds8 + png@2x-bytes+bounds8 + eps-bytes+bounds8 + pdf-bytes+bounds8) (or/c (list/c bytes? (and/c real? (not/c negative?)) (and/c real? (not/c negative?)) @@ -104,11 +155,14 @@ Returns @racket[#t] if @racket[v] supports the conversion protocol, (and/c real? (not/c negative?)) (and/c real? (not/c negative?)) (and/c real? (not/c negative?))) - (λ (x) (eq? x default)))] - [else any/c])]{ + default/c)] + [else (or/c opaque-default/c any/c)])]{ Requests a data conversion from @racket[v], where @racket[request] indicates the type of requested data and @racket[default] is the value that the converter should return if it cannot produce data in the -format indicated by @racket[request].} +format indicated by @racket[request]. +The @racket[default/c] contract is one created by @racket[new-α/c] +and it guarantees that the result of @racket[convert] is the given +default argument (or @racket[#f] if one is not supplied).} diff --git a/racket/collects/file/convertible.rkt b/racket/collects/file/convertible.rkt index 6af83fb1d5..0abea6524e 100644 --- a/racket/collects/file/convertible.rkt +++ b/racket/collects/file/convertible.rkt @@ -1,13 +1,57 @@ #lang racket/base -(provide prop:convertible convertible? convert) +(require racket/contract) + +(define opaque-default/c (new-∀/c)) + +(define default/c (or/c #f opaque-default/c)) + +(define (make-result-contract request default) + (define default/c + (if (unsupplied-arg? default) default/c opaque-default/c)) + (case request + [(text) + (or/c string? default/c)] + [(gif-bytes png-bytes png@2x-bytes ps-bytes eps-bytes pdf-bytes svg-bytes) + (or/c bytes? default/c)] + [(png-bytes+bounds png@2x-bytes+bounds eps-bytes+bounds pdf-bytes+bounds) + (or/c (list/c bytes? + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?))) + default/c)] + [(png-bytes+bounds8 png@2x-bytes+bounds8 eps-bytes+bounds8 pdf-bytes+bounds8) + (or/c (list/c bytes? + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?)) + (and/c real? (not/c negative?))) + default/c)] + [else (or/c opaque-default/c any/c)])) + +(provide + (contract-out + + [convertible? (-> any/c boolean?)] + + [prop:convertible + (struct-type-property/c + (->i ([v convertible?] [request symbol?] [default default/c]) + [result (request default) (make-result-contract request default)]))] + + [convert + (->i ([v convertible?] [request symbol?]) + ([default default/c]) + [result (request default) (make-result-contract request default)])])) + (define-values (prop:convertible convertible? convertible-ref) (make-struct-type-property 'convertible)) -(define (convert v target [default #f]) - (unless (convertible? v) - (raise-type-error 'convert "convertible" 0 v target)) - (unless (symbol? target) - (raise-type-error 'convert "symbol" 1 v target)) - ((convertible-ref v) v target default)) +(define (convert v request [default #f]) + ((convertible-ref v) v request default))