suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

formlets

Browse Source 
svn: r13510
This commit is contained in:
Jay McCarthy 2009-02-09 22:48:10 +00:00
parent 621602b42f
commit 57549a1759
4 changed files with 292 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/web-server/all-web-server-tests.ss
View File

@ -9,6 +9,7 @@
"private/all-private-tests.ss"
"servlet/all-servlet-tests.ss"
"stuffers-test.ss"
"formlets-test.ss"
"servlet-env-test.ss")
(provide all-web-server-tests)
@ -17,6 +18,7 @@
"Web Server"
all-http-tests
all-stuffers-tests
all-formlets-tests
all-configuration-tests
all-dispatchers-tests
all-lang-tests

64
collects/tests/web-server/formlets-test.ss
View File

@ -119,6 +119,68 @@
(check-equal? (third (run-formlet (cross* (text "One") (text "Two")) x))
x))))
(local [(define (->cons bf)
(cons (binding-id bf)
(binding:form-value bf)))
(define (test-process f bs)
(formlet-process f
(make-request #"GET" (string->url "http://test.com")
empty
bs
#f "127.0.0.1" 80 "127.0.0.1")))]
(test-suite
"Input"
(test-equal? "make-input"
(->cons (test-process (make-input (lambda (n) n)) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value"))
(test-equal? "make-input"
(test-process (make-input (lambda (n) n)) empty)
#f)
(test-equal? "text-input"
(->cons (test-process (text-input) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value"))
(test-equal? "password-input"
(->cons (test-process (password-input) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value"))
(test-equal? "checkbox"
(->cons (test-process (checkbox #"start" #t) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value"))
(test-equal? "required"
(test-process (required (text-input)) (list (make-binding:form #"input_0" #"value")))
#"value")
(test-exn "required"
exn?
(lambda ()
(test-process (required (text-input)) empty)))
(test-equal? "default"
(test-process (default #"def" (text-input)) (list (make-binding:form #"input_0" #"value")))
#"value")
(test-equal? "default"
(test-process (default #"def" (text-input)) empty)
#"def")
(test-equal? "to-string"
(test-process (to-string (required (text-input))) (list (make-binding:form #"input_0" #"value")))
"value")
(test-equal? "to-symbol"
(test-process (to-symbol (to-string (required (text-input)))) (list (make-binding:form #"input_0" #"value")))
'value)
(test-equal? "to-number"
(test-process (to-number (to-string (required (text-input)))) (list (make-binding:form #"input_0" #"100")))
100)
(test-equal? "to-boolean"
(test-process (to-boolean (required (text-input))) (list (make-binding:form #"input_0" #"on")))
#t)
(test-equal? "to-boolean"
(test-process (to-boolean (required (text-input))) (list (make-binding:form #"input_0" #"off")))
#f)
))
(local [(define-struct date (month day) #:transparent)
(define (date->xml d)
(format "~a/~a"
@ -155,7 +217,7 @@
"Departing:" ,(date->xml depart)))]))]
(test-suite
"Date"
(test-case "date->xml"
(check-equal? (date->xml (make-date 1 2))
"1/2"))

179
collects/web-server/formlets/input.ss
View File

@ -1,30 +1,171 @@
#lang scheme
(require web-server/http
"lib.ss")
xml
(only-in "lib.ss"
formlet/c
pure
cross))
; Low-level
(define (next-name i)
(values (format "input_~a" i) (add1 i)))
(define (input i)
(let-values ([(w i) (next-name i)])
(values (list `(input ([name ,w])))
(lambda (env) (bindings-assq (string->bytes/utf-8 w) env))
i)))
(define (make-input render)
(lambda (i)
(let-values ([(w i) (next-name i)])
(values (list (render w))
(lambda (env) (bindings-assq (string->bytes/utf-8 w) env))
i))))
(define input-string
(cross
(pure (lambda (bf)
(bytes->string/utf-8 (binding:form-value bf))))
input))
(define binding:form-required
(pure
(lambda (bf)
(if (binding:form? bf)
(binding:form-value bf)
(error 'formlets "Missing required field")))))
(define input-int
(cross
(pure string->number)
input-string))
(define (binding:form/default default)
(pure
(lambda (bf)
(if (binding:form? bf)
(binding:form-value bf)
default))))
(define input-symbol
(cross
(pure string->symbol)
input-string))
(provide/contract
[make-input ((string? . -> . xexpr/c) . -> . (formlet/c (or/c false/c binding?)))]
#;[binding:form-required (formlet/c (binding? . -> . bytes?))]
#;[binding:form/default (bytes? . -> . (formlet/c (binding? . -> . bytes?)))])
; HTML Spec
(define (text-or-password
#:password? password?
#:value [value #f]
#:size [size #f]
#:max-length [max-length #f]
#:read-only? [read-only? #f]
#:attributes [attrs empty])
(make-input
(lambda (n)
(list 'input
(list* (list 'name n)
(list 'type
(if password? "password" "text"))
(append
(filter list?
(list (and value (list 'value (bytes->string/utf-8 value)))
(and size (list 'size (number->string size)))
(and max-length (list 'maxlength (number->string max-length)))
(and read-only? (list 'readonly "true"))))
attrs))))))
(define (text-input
#:value [value #f]
#:size [size #f]
#:max-length [max-length #f]
#:read-only? [read-only? #f]
#:attributes [attrs empty])
(text-or-password
#:password? #f
#:value value
#:size size
#:max-length max-length
#:read-only? read-only?
#:attributes attrs))
(define (password-input
#:value [value #f]
#:size [size #f]
#:max-length [max-length #f]
#:read-only? [read-only? #f]
#:attributes [attrs empty])
(text-or-password
#:password? #f
#:value value
#:size size
#:max-length max-length
#:read-only? read-only?
#:attributes attrs))
(define (checkbox value checked?
#:attributes [attrs empty])
(make-input
(lambda (n)
(list 'input
(list* (list 'name n)
(list 'type "checkbox")
(list 'value (bytes->string/utf-8 value))
(append (if checked? (list (list 'checked "true")) empty)
attrs))))))
; XXX radio
; XXX submit
; XXX reset
; XXX file
; XXX hidden
; XXX image
; XXX button
(provide/contract
[text-input (()
(#:value (or/c false/c bytes?)
#:size (or/c false/c exact-nonnegative-integer?)
#:max-length (or/c false/c exact-nonnegative-integer?)
#:read-only? boolean?
#:attributes (listof (list/c symbol? string?)))
. ->* .
(formlet/c (or/c false/c binding?)))]
[password-input (()
(#:value (or/c false/c bytes?)
#:size (or/c false/c exact-nonnegative-integer?)
#:max-length (or/c false/c exact-nonnegative-integer?)
#:read-only? boolean?
#:attributes (listof (list/c symbol? string?)))
. ->* .
(formlet/c (or/c false/c binding?)))]
[checkbox ((bytes? boolean?)
(#:attributes (listof (list/c symbol? string?)))
. ->* .
(formlet/c (or/c false/c binding?)))])
; High-level
(define (required f)
(cross binding:form-required f))
(define (default d f)
(cross (binding:form/default d) f))
(define (to-string f)
(cross (pure bytes->string/utf-8) f))
(define (to-number f)
(cross (pure string->number) f))
(define (to-symbol f)
(cross (pure string->symbol) f))
(define (to-boolean f)
(cross (pure
(lambda (b)
(bytes=? b #"on")))
f))
(provide/contract
[required ((formlet/c (or/c false/c binding?)) . -> . (formlet/c bytes?))]
[default (bytes? (formlet/c (or/c false/c binding?)) . -> . (formlet/c bytes?))]
[to-string ((formlet/c bytes?) . -> . (formlet/c string?))]
[to-number ((formlet/c string?) . -> . (formlet/c number?))]
[to-symbol ((formlet/c string?) . -> . (formlet/c symbol?))]
[to-boolean ((formlet/c bytes?) . -> . (formlet/c boolean?))])
; OLD
(define input-string (to-string (required (text-input))))
(define input-int (to-number input-string))
(define input-symbol (to-symbol input-string))
(provide/contract
[input-string (formlet/c string?)]

73
collects/web-server/scribblings/formlets.scrbl
View File

@ -201,20 +201,81 @@ types. Refer to @secref["input-formlets"] for example low-level formlets using t
@(require (for-label web-server/formlets/input))
@defmodule[web-server/formlets/input]{
There are a few basic @tech{formlet}s provided by this library.
These @tech{formlet}s are the main combinators for form input.
@defproc[(make-input [render (string? . -> . xexpr/c)])
(formlet/c (or/c false/c binding?))]{
This @tech{formlet} is rendered with @scheme[render], which is passed the input name, and results in the
extracted @scheme[binding].
}
@defproc[(text-input [#:value value (or/c false/c bytes?) #f]
[#:size size (or/c false/c exact-nonnegative-integer?) #f]
[#:max-length max-length (or/c false/c exact-nonnegative-integer?) #f]
[#:read-only? read-only? boolean? #f]
[#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{
This @tech{formlet} renders using an INPUT element with the TEXT type and the attributes given in the arguments.
}
@defproc[(password-input [#:value value (or/c false/c bytes?) #f]
[#:size size (or/c false/c exact-nonnegative-integer?) #f]
[#:max-length max-length (or/c false/c exact-nonnegative-integer?) #f]
[#:read-only? read-only? boolean? #f]
[#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{
This @tech{formlet} renders using an INPUT element with the PASSWORD type and the attributes given in the arguments.
}
@defproc[(checkbox [value bytes?]
[checked? boolean?]
[#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{
This @tech{formlet} renders using a INPUT elemen with the CHECKBOX type and the attributes given in the arguments.
}
@defproc[(required [f (formlet/c (or/c false/c binding?))])
(formlet/c bytes?)]{
Constructs a @tech{formlet} that extracts the @scheme[binding:form-value] from the binding produced by @scheme[f], or errors.
}
@defproc[(default
[def bytes?]
[f (formlet/c (or/c false/c binding?))])
(formlet/c bytes?)]{
Constructs a @tech{formlet} that extracts the @scheme[binding:form-value] from the binding produced by @scheme[f], or returns @scheme[def].
}
@defproc[(to-string [f (formlet/c bytes?)])
(formlet/c string?)]{
Converts @scheme[f]'s output to a string. Equivalent to @scheme[(cross (pure bytes->string/utf-8) f)].
}
@defproc[(to-number [f (formlet/c string?)])
(formlet/c number?)]{
Converts @scheme[f]'s output to a number. Equivalent to @scheme[(cross (pure string->number) f)].
}
@defproc[(to-symbol [f (formlet/c string?)])
(formlet/c symbol?)]{
Converts @scheme[f]'s output to a symbol. Equivalent to @scheme[(cross (pure string->symbol) f)].
}
@defproc[(to-boolean [f (formlet/c bytes?)])
(formlet/c boolean?)]{
Converts @scheme[f]'s output to a boolean, if it is equal to @scheme[#"on"].
}
@defthing[input-string (formlet/c string?)]{
A @tech{formlet} that renders as @schemeblock[(list `(input ([name (format "input_~a" _next-id)])))] where
@scheme[_next-id] is the next available input index and extracts @scheme[(format "input_~a" _next-id)] in
the processing stage and converts it into a UTF-8 string.
Equivalent to @scheme[(to-string (required (text-input)))].
}
@defthing[input-int (formlet/c integer?)]{
Equivalent to @scheme[(cross (pure string->number) input-string)].
Equivalent to @scheme[(to-number input-string)].
}
@defthing[input-symbol (formlet/c symbol?)]{
Equivalent to @scheme[(cross (pure string->symbol) input-string)].
Equivalent to @scheme[(to-symbol input-string)].
}
}