update sugar/coerce & docs

pull/2/head
Matthew Butterick 10 years ago
parent 2741f08625
commit 30ee7910ca

@ -1,4 +1,156 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(require net/url xml racket/set racket/contract racket/sequence racket/stream racket/dict)
(require "len.rkt" "define.rkt")
(define (make-coercion-error-handler target-format x)
(λ(e) (error (format "Cant convert ~a to ~a" x target-format))))
(define+provide (->int x)
(with-handlers ([exn:fail? (make-coercion-error-handler 'integer x)])
(cond
[(or (integer? x) (real? x)) (inexact->exact (floor x))]
[(and (string? x) (> (len x) 0)) (->int (string->number x))]
[(symbol? x) (->int (->string x))]
[(char? x) (char->integer x)]
[(path? x) (->int (->string x))]
[else (len x)])))
(provide ->macrostring)
(define-syntax-rule (->macrostring x)
(if (string? x)
x ; fast exit for strings
(with-handlers ([exn:fail? (make-coercion-error-handler 'string (format "~a (result of ~a" x 'x))])
(cond
[(equal? '() x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (format "~a" x)]
[else (error)]))))
(define+provide (->string x)
(if (string? x)
x ; fast exit for strings
(with-handlers ([exn:fail? (make-coercion-error-handler 'string x)])
(cond
[(equal? '() x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (format "~a" x)]
[else (error)]))))
(define+provide (->symbol x)
(if (symbol? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'symbol x)])
(string->symbol (->string x)))))
(define+provide (->path x)
(if (path? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'path x)])
(cond
[(url? x) (apply build-path (map path/param-path (url-path x)))]
[else (string->path (->string x))]))))
(define+provide (->url x)
(with-handlers ([exn:fail? (make-coercion-error-handler 'url x)])
(string->url (->string x))))
(define+provide (->complete-path x)
(with-handlers ([exn:fail? (make-coercion-error-handler 'complete-path x)])
(path->complete-path (->path x))))
(define+provide (->list x)
(if (list? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'list x)])
(cond
[(string? x) (list x)]
[(vector? x) (vector->list x)]
[(set? x) (set->list x)]
;; location relevant because hash or dict are also sequences
[(dict? x) (dict->list x)]
[(sequence? x) (sequence->list x)]
[(stream? x) (stream->list x)]
[else (list x)]))))
(define+provide (->vector x)
(if (vector? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'vector x)])
(list->vector (->list x)))))
(define+provide (->boolean x)
(and x #t))
(define-syntax (make-*ish-predicate stx)
(syntax-case stx ()
[(_ stem)
(with-syntax ([stemish? (format-id stx "~aish?" #'stem)]
[->stem (format-id stx "->~a" #'stem)])
#`(begin
(define+provide (stemish? x)
(with-handlers ([exn:fail? (λ(e) #f)]) (and (->stem x) #t)))))]))
(make-*ish-predicate int)
(make-*ish-predicate string)
(make-*ish-predicate symbol)
(make-*ish-predicate url)
(make-*ish-predicate complete-path)
(make-*ish-predicate path)
(make-*ish-predicate list)
(make-*ish-predicate vector)
;; no point to having list and vector here; they work with everything
(define-syntax-rule (make-blame-handler try-proc expected-sym)
(λ(b)
(λ(x)
(with-handlers ([exn:fail? (λ(e)
(raise-blame-error
b x
'(expected: "~a" given: "~e")
expected-sym x))])
(try-proc x)))))
(provide make-coercion-contract)
(define-syntax (make-coercion-contract stx)
(syntax-case stx ()
[(_ stem coerce-proc)
(with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)]
[can-be-stem? (format-id stx "can-be-~a?" #'stem)])
#'(make-contract
#:name 'coerce/stem?
#:projection (make-blame-handler coerce-proc 'can-be-stem?)))]
[(_ stem)
(with-syntax ([->stem (format-id stx "->~a" #'stem)])
#'(make-coercion-contract stem ->stem))]))
(define-syntax (define+provide-coercion-contract stx)
(syntax-case stx ()
[(_ stem)
(with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)])
#'(define+provide coerce/stem? (make-coercion-contract stem)))]))
(define+provide-coercion-contract int)
(define+provide-coercion-contract string)
(define+provide-coercion-contract symbol)
(define+provide-coercion-contract path)
(define+provide-coercion-contract boolean)
(require "coerce/value.rkt" "coerce/contract.rkt")
(provide (all-from-out "coerce/value.rkt" "coerce/contract.rkt"))

@ -1,39 +0,0 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(require racket/contract "../define/provide.rkt" "value.rkt")
(define-syntax-rule (make-blame-handler try-proc expected-sym)
(λ(b)
(λ(x)
(with-handlers ([exn:fail? (λ(e)
(raise-blame-error
b x
'(expected: "~a" given: "~e")
expected-sym x))])
(try-proc x)))))
(provide make-coercion-contract)
(define-syntax (make-coercion-contract stx)
(syntax-case stx ()
[(_ stem coerce-proc)
(with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)]
[can-be-stem? (format-id stx "can-be-~a?" #'stem)])
#'(make-contract
#:name 'coerce/stem?
#:projection (make-blame-handler coerce-proc 'can-be-stem?)))]
[(_ stem)
(with-syntax ([->stem (format-id stx "->~a" #'stem)])
#'(make-coercion-contract stem ->stem))]))
(define-syntax (define+provide-coercion-contract stx)
(syntax-case stx ()
[(_ stem)
(with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)])
#'(define+provide coerce/stem? (make-coercion-contract stem)))]))
(define+provide-coercion-contract int)
(define+provide-coercion-contract string)
(define+provide-coercion-contract symbol)
(define+provide-coercion-contract path)
(define+provide-coercion-contract boolean)

@ -1,110 +0,0 @@
#lang racket/base
(require (for-syntax racket/base racket/syntax))
(require net/url xml racket/set)
(require "../len.rkt" "../define/provide.rkt")
(define (make-coercion-error-handler target-format x)
(λ(e) (error (format "Cant convert ~a to ~a" x target-format))))
(define+provide (->int x)
(with-handlers ([exn:fail? (make-coercion-error-handler 'integer x)])
(cond
[(or (integer? x) (real? x)) (inexact->exact (floor x))]
[(and (string? x) (> (len x) 0)) (->int (string->number x))]
[(symbol? x) (->int (->string x))]
[(char? x) (char->integer x)]
[(path? x) (->int (->string x))]
[else (len x)])))
(provide ->macrostring)
(define-syntax-rule (->macrostring x)
(if (string? x)
x ; fast exit for strings
(with-handlers ([exn:fail? (make-coercion-error-handler 'string (format "~a (result of ~a" x 'x))])
(cond
[(equal? '() x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (format "~a" x)]
[else (error)]))))
(define+provide (->string x)
(if (string? x)
x ; fast exit for strings
(with-handlers ([exn:fail? (make-coercion-error-handler 'string x)])
(cond
[(equal? '() x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (format "~a" x)]
[else (error)]))))
(define+provide (->symbol x)
(if (symbol? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'symbol x)])
(string->symbol (->string x)))))
(define+provide (->path x)
(if (path? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'path x)])
(cond
[(url? x) (apply build-path (map path/param-path (url-path x)))]
[else (string->path (->string x))]))))
(define+provide (->url x)
(with-handlers ([exn:fail? (make-coercion-error-handler 'url x)])
(string->url (->string x))))
(define+provide (->complete-path x)
(with-handlers ([exn:fail? (make-coercion-error-handler 'complete-path x)])
(path->complete-path (->path x))))
(define+provide (->list x)
(if (list? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'list x)])
(cond
[(vector? x) (vector->list x)]
[(set? x) (set->list x)]
[else (list x)]))))
(define+provide (->vector x)
(if (vector? x)
x
(with-handlers ([exn:fail? (make-coercion-error-handler 'vector x)])
(list->vector (->list x)))))
(define+provide (->boolean x)
(and x #t))
(define-syntax (make-*ish-predicate stx)
(syntax-case stx ()
[(_ stem)
(with-syntax ([stemish? (format-id stx "~aish?" #'stem)]
[->stem (format-id stx "->~a" #'stem)])
#`(begin
(define+provide (stemish? x)
(with-handlers ([exn:fail? (λ(e) #f)]) (and (->stem x) #t)))))]))
(make-*ish-predicate int)
(make-*ish-predicate string)
(make-*ish-predicate symbol)
(make-*ish-predicate url)
(make-*ish-predicate complete-path)
(make-*ish-predicate path)
;; no point to having list and vector here; they work with everything

@ -1,5 +1,5 @@
#lang racket/base
(require "define/contract.rkt")
(require "define.rkt")
(require "coerce.rkt" "len.rkt" racket/list)
(define (sliceable-container? x)

@ -1,5 +1,52 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/contract)
(require "define/provide.rkt" "define/contract.rkt")
(provide (all-defined-out) (all-from-out racket/contract))
(provide (all-from-out "define/provide.rkt" "define/contract.rkt"))
;; each define macro recursively converts any form of define
;; into its lambda form (define name body ...) and then operates on that.
(define-syntax (define+provide+safe stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define+provide+safe proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(define name body ...)
(provide name)
(module+ safe
(provide (contract-out [name contract]))))]))
(define-syntax (define+provide/contract stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define+provide/contract proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(provide (contract-out [name contract]))
(define name body ...))]))
(define-syntax (define/contract+provide stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define/contract+provide proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(provide name)
(define/contract name contract body ...))]))
(define-syntax (define+provide stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) body ...)
#'(define+provide proc
(λ(arg ... . rest-arg) body ...))]
[(_ name body ...)
#'(begin
(provide name)
(define name body ...))]))

@ -1,41 +0,0 @@
#lang racket/base
(require (for-syntax racket/base))
(require racket/contract)
(provide (all-defined-out) (all-from-out racket/contract))
;; each define macro recursively converts any form of define
;; into its lambda form (define name body ...) and then operates on that.
(define-syntax (define+provide+safe stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define+provide+safe proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(define name body ...)
(provide name)
(module+ safe
(provide (contract-out [name contract]))))]))
(define-syntax (define+provide/contract stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define+provide/contract proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(provide (contract-out [name contract]))
(define name body ...))]))
(define-syntax (define/contract+provide stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) contract body ...)
#'(define/contract+provide proc contract
(λ(arg ... . rest-arg) body ...))]
[(_ name contract body ...)
#'(begin
(provide name)
(define/contract name contract body ...))]))

@ -1,14 +0,0 @@
#lang racket/base
(require (for-syntax racket/base))
(provide (all-defined-out))
(define-syntax (define+provide stx)
(syntax-case stx ()
[(_ (proc arg ... . rest-arg) body ...)
#'(define+provide proc
(λ(arg ... . rest-arg) body ...))]
[(_ name body ...)
#'(begin
(provide name)
(define name body ...))]))

@ -1,5 +1,5 @@
#lang racket/base
(require sugar/define/contract sugar/coerce/contract sugar/string racket/path)
(require "define.rkt" "coerce.rkt" "string.rkt" racket/path)

@ -1,6 +1,6 @@
#lang racket/base
(require racket/list)
(require "define/contract.rkt" "len.rkt" "coerce/value.rkt")
(require "define.rkt" "len.rkt" "coerce.rkt")
(define+provide/contract (trim items test-proc)
(list? procedure? . -> . list?)

@ -1,6 +1,6 @@
#lang racket/base
(require (for-syntax racket/base))
(require "define/contract.rkt")
(require "define.rkt")
(define+provide/contract (bytecount->string bytecount)
(integer? . -> . string?)

@ -9,27 +9,42 @@
@defmodule[sugar/coerce]
@section{Values}
@defmodule[sugar/coerce/value]
@defproc[
(->int
[v any/c])
integer?]
Convert @racket[_v] to an integer in the least surprising way possible, or raise an error if it can't be done
Convert @racket[_v] to an integer in the least surprising way, or raise an error if no conversion is possible.
Numbers are rounded down to the nearest integer.
Stringlike values are converted to numbers and rounded down.
@examples[#:eval my-eval
(->int 3)
(->int 3.5)
(->int -2.5)
(->int (+ 3 (/ 1 2)))]
Stringlike values — paths, symbols, and strings — are converted to numbers and rounded down.
@examples[#:eval my-eval
(->int "3.5")
(->int '3.5)
(->int (string->path "3.5"))]
Characters are directly converted to integers.
@examples[#:eval my-eval
(->int #\A)
(->int #\◊)]
Lists, vectors, and other multi-value datatypes return their length (using @racket[len]).
@examples[#:eval my-eval
(map ->int (list 3 3.5 -2.5 (+ 3 (/ 1 2))))
(map ->int (list "3.5" '3.5 (string->path "3.5")))
(->int (list 5 6 7))
(->int (hash 'a 1 'b 2 'c 3))
(->int (hash 'a 1 'b 2 'c 3))]
The function will raise an error if no sensible conversion is possible.
@examples[#:eval my-eval
(->int #t)
]
@ -52,7 +67,7 @@ Return the most natural string representation of @racket[_v], or raise an error
(->symbol
[v any/c])
symbol?]
Same as @racket[->string], but returns a symbol rather than a string.
Same as @racket[->string], but return a symbol rather than a string.
@examples[#:eval my-eval
(->symbol "string")
@ -74,7 +89,7 @@ path?]
[v any/c])
complete-path?]
)]
Same as @racket[->string], but returns a path (or complete path) rather than a string.
Same as @racket[->string], but return a path (or complete path) rather than a string.
@examples[#:eval my-eval
(->path "string")
@ -90,14 +105,18 @@ Same as @racket[->string], but returns a path (or complete path) rather than a s
(->list
[v any/c])
list?]
Convert a listlike @racket[_v] into a list, or put an atomic @racket[_v] into a single-member list.
If @racket[_v] is a listlike data type — a vector, set, stream, sequence, or list — convert it to a list. A hash or dictionary becomes a list using @racket[dict->list]. If @racket[_v] is an atomic value, turn it into a single-member list.
Note that a string is treated as an atomic value rather than decomposed with @racket[string->list]. This is done so the function handles strings the same way as symbols and paths.
@examples[#:eval my-eval
(->list '(a b c))
(->list (list->vector '(a b c)))
(->list (make-hash '((k . v) (k2 . v2))))
(->list "string")
(->list 'symbol)
(->list (string->path "path"))
(->list +)
(->list '(a b c))
(->list (list->vector '(a b c)))
]
@defproc[
@ -107,21 +126,27 @@ vector?]
Same as @racket[->list], but returns a vector rather than a list.
@examples[#:eval my-eval
(->vector '(a b c))
(->vector (list->vector '(a b c)))
(->vector (make-hash '((k . v) (k2 . v2))))
(->vector "string")
(->vector 'symbol)
(->vector (string->path "path"))
(->vector +)
(->vector '(a b c))
(->vector (list->vector '(a b c)))
]
@defproc[
(->boolean
[v any/c])
boolean?]
Return @racket[#t] for any @racket[_v] except @racket[#f], which remains @racket[#f]. Same as @code{(and v #t)}.
Return @racket[#t] for all @racket[_v] except @racket[#f], which remains @racket[#f].
@examples[#:eval my-eval
(map ->boolean (list "string" 'symbol + '(l i s t) #f))
(->boolean "string")
(->boolean 'symbol)
(->boolean +)
(->boolean '(l i s t))
(->boolean #f)
]
@ -131,8 +156,10 @@ Return @racket[#t] for any @racket[_v] except @racket[#f], which remains @racket
@defproc[(symbolish? [v any/c]) boolean?]
@defproc[(pathish? [v any/c]) boolean?]
@defproc[(complete-pathish? [v any/c]) boolean?]
@defproc[(listish? [v any/c]) boolean?]
@defproc[(vectorish? [v any/c]) boolean?]
)]
Report whether @racket[_v] can be coerced to the specified type.
Predicates that report whether @racket[_v] can be coerced to the specified type.
@examples[#:eval my-eval
(map intish? (list 3 3.5 #\A "A" + #t))
@ -140,33 +167,49 @@ Report whether @racket[_v] can be coerced to the specified type.
(map symbolish? (list 3 3.5 #\A "A" + #t))
(map pathish? (list 3 3.5 #\A "A" + #t))
(map complete-pathish? (list 3 3.5 #\A "A" + #t))
(map listish? (list 3 3.5 #\A "A" + #t))
(map vectorish? (list 3 3.5 #\A "A" + #t))
]
@section{Contracts that coerce}
@defmodule[sugar/coerce/contract]
@section{Coercion contracts}
@deftogether[(
@defproc[(coerce/int? [v any/c]) int?]
@defproc[(coerce/string? [v any/c]) string]
@defproc[(coerce/symbol? [v any/c]) symbol]
@defproc[(coerce/int? [v any/c]) integer?]
@defproc[(coerce/string? [v any/c]) string?]
@defproc[(coerce/symbol? [v any/c]) symbol?]
@defproc[(coerce/path? [v any/c]) path?]
@defproc[(coerce/boolean? [v any/c]) boolean?]
)]
If @racket[_v] can be coerced to the specified type, these contracts will return it so coerced. If not, they raise the usual contract error. This is an unusual way to use contracts, but it can be handy.
If @racket[_v] can be coerced to the specified type, change it to that type, then return it. If not, raise the usual contract error. These contracts can be used with input or output values.
@examples[#:eval my-eval
(define/contract (add-ints x y)
(coerce/int? coerce/int? . -> . any/c)
(+ x y))
(code:comment @#,t{Input arguments will be coerced to integers, then added})
(add-ints 1.6 3.8)
(define/contract (int-sum x y)
(any/c any/c . -> . coerce/int?)
(+ x y))
(code:comment @#,t{Input arguments will be added, and the result coerced to an integer})
(int-sum 1.6 3.8)
]
Please note: this is not an officially sanctioned way to use Racket's contract system, because contracts aren't supposed to mutate their values (see @racket[make-contract]).
But coercion contracts can be useful in two situations:
@itemlist[
@item{You want to be liberal about input types, but don't want to deal with the housekeeping and manual conversions between types.}
@item{Your contract involves an expensive operation that you'd rather avoid performing twice.}
]

@ -10,7 +10,7 @@
@author[(author+email "Matthew Butterick" "mb@mbtype.com")]
A collection of tiny functions to help make Racket code more readable.
A collection of small functions to help make Racket code simpler & more readable.
@section{Installation & updates}

@ -1,5 +1,5 @@
#lang racket/base
(require "define/contract.rkt" "coerce.rkt")
(require "define.rkt" "coerce.rkt")
(define+provide/contract (starts-with? str starter)

@ -1,5 +1,5 @@
#lang racket/base
(require "define/contract.rkt")
(require "define.rkt")
(module+ test (require rackunit))

Loading…
Cancel
Save