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

New library formlets

Browse Source 
svn: r18720
This commit is contained in:
Jay McCarthy 2010-04-02 18:53:29 +00:00
parent eff3c44ad3
commit 7b61ba023d
3 changed files with 153 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -137,6 +137,19 @@
(test-equal? "make-input"
(test-process (make-input (lambda (n) n)) empty)
#f)
(test-equal? "make-input*"
(map ->cons (test-process (make-input* (lambda (n) n)) (list (make-binding:form #"input_0" #"value"))))
(list (cons #"input_0" #"value")))
(test-equal? "make-input*"
(map ->cons (test-process (make-input* (lambda (n) n)) (list (make-binding:form #"input_0" #"value0")
(make-binding:form #"input_0" #"value1"))))
(list (cons #"input_0" #"value0")
(cons #"input_0" #"value1")))
(test-equal? "make-input*"
(test-process (make-input* (lambda (n) n)) empty)
empty)
(test-equal? "text-input"
(->cons (test-process (text-input) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value"))
@ -147,6 +160,37 @@
(->cons (test-process (checkbox #"start" #t) (list (make-binding:form #"input_0" #"value"))))
(cons #"input_0" #"value"))
(test-equal? "multiselect-input"
(test-process (multiselect-input (list 1 2 3))
(list (make-binding:form #"input_0" #"0")))
(list 1))
(test-equal? "multiselect-input"
(test-process (multiselect-input (list 1 2 3))
(list (make-binding:form #"input_0" #"0")
(make-binding:form #"input_0" #"2")))
(list 1 3))
(test-equal? "multiselect-input"
(test-process (multiselect-input (list 1 2 3))
empty)
empty)
; XXX check output
(test-equal? "select-input"
(test-process (select-input (list 1 2 3))
(list (make-binding:form #"input_0" #"0")))
1)
(test-equal? "select-input"
(test-process (select-input (list 1 2 3))
(list (make-binding:form #"input_0" #"0")
(make-binding:form #"input_0" #"2")))
1)
(test-exn "select-input"
exn?
(lambda ()
(test-process (select-input (list 1 2 3))
empty)))
(test-equal? "required"
(test-process (required (text-input)) (list (make-binding:form #"input_0" #"value")))
#"value")
@ -162,6 +206,10 @@
(test-process (default #"def" (text-input)) empty)
#"def")
(test-equal? "textarea-input"
(test-process (textarea-input) (list (make-binding:form #"input_0" #"value")))
"value")
(test-equal? "to-string"
(test-process (to-string (required (text-input))) (list (make-binding:form #"input_0" #"value")))
"value")
@ -254,3 +302,6 @@
(list "Jay" (make-date 10 6) (make-date 10 8))))))
))
(require schemeunit/text-ui)
(run-tests all-formlets-tests)

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

@ -9,6 +9,16 @@
; Low-level
(define (next-name i)
(values (format "input_~a" i) (add1 i)))
(define (make-input* render)
(lambda (i)
(let-values ([(w i) (next-name i)])
(define wb (string->bytes/utf-8 w))
(values (list (render w))
(lambda (env)
(for/list ([b (in-list env)]
#:when (bytes=? wb (binding-id b)))
b))
i))))
(define (make-input render)
(lambda (i)
(let-values ([(w i) (next-name i)])
@ -31,6 +41,7 @@
default))))
(provide/contract
[make-input* ((string? . -> . pretty-xexpr/c) . -> . (formlet/c (listof binding?)))]
[make-input ((string? . -> . pretty-xexpr/c) . -> . (formlet/c (or/c false/c binding?)))]
#;[binding:form-required (formlet/c (binding? . -> . bytes?))]
#;[binding:form/default (bytes? . -> . (formlet/c (binding? . -> . bytes?)))])
@ -110,7 +121,70 @@
; XXX button
(define (multiselect-input l
#:multiple? [multiple? #t]
#:selected? [selected? (λ (x) #f)]
#:display [display (λ (x) x)])
(define value->element (make-hasheq))
(define i 0)
(define (remember! e)
(define this-i
(begin0 i (set! i (add1 i))))
(hash-set! value->element this-i e))
(define (recall i)
(hash-ref value->element i
(λ () (error 'input-select* "Invalid selection: ~e" i))))
(for ([e l])
(remember! e))
(cross
(pure
(lambda (bs)
(map (compose recall string->number
bytes->string/utf-8
binding:form-value)
bs)))
(make-input*
(lambda (name)
`(select (,@(if multiple? '([multiple "true"]) empty)
[name ,name])
,@(for/list ([(vn e) (in-hash value->element)])
(define v (number->string vn))
`(option ([value ,v]
,@(if (selected? e)
'([selected "true"])
empty))
,(display e))))))))
(define (select-input l
#:selected? [selected? (λ (x) #f)]
#:display [display (λ (x) x)])
(cross
(pure first)
(multiselect-input l
#:multiple? #f
#:selected? selected?
#:display display)))
(define (textarea-input)
(to-string
(required
(make-input
(lambda (n)
(list 'textarea
(list (list 'name n))
""))))))
(provide/contract
[multiselect-input (->* (sequence?)
(#:multiple? boolean?
#:selected? (any/c . -> . boolean?)
#:display (any/c . -> . pretty-xexpr/c))
(formlet/c (listof any/c)))]
[select-input (->* (sequence?)
(#:selected? (any/c . -> . boolean?)
#:display (any/c . -> . pretty-xexpr/c))
(formlet/c any/c))]
[textarea-input (-> (formlet/c string?))]
[text-input (()
(#:value (or/c false/c bytes?)
#:size (or/c false/c exact-nonnegative-integer?)

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

@ -206,6 +206,12 @@ These @tech{formlet}s are the main combinators for form input.
extracted @scheme[binding].
}
@defproc[(make-input* [render (string? . -> . xexpr/c)])
(formlet/c (listof binding?))]{
This @tech{formlet} is rendered with @scheme[render], which is passed the input name, and results in all the
@scheme[binding]s that use the name.
}
@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]
@ -223,14 +229,34 @@ These @tech{formlet}s are the main combinators for form input.
(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[(textarea-input)
(formlet/c string?)]{
This @tech{formlet} renders using an TEXTAREA element.
}
@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[(multiselect-input [l sequence?]
[#:multiple? multiple? boolean? #t]
[#:selected? selected? (any/c . -> . boolean?) (λ (x) #f)]
[#:display display (any/c . -> . xexpr/c) (λ (x) x)])
(formlet/c list?)]{
This @tech{formlet} renders using an SELECT element with an OPTION for each element of the sequence. If @scheme[multiple?] is @scheme[#t], then multiple options may be selected. An element is selected if @scheme[selected?] returns @scheme[#t]. Elements are displayed with @scheme[display].
}
@defproc[(select-input [l sequence?]
[#:selected? selected? (any/c . -> . boolean?) (λ (x) #f)]
[#:display display (any/c . -> . xexpr/c) (λ (x) x)])
(formlet/c any/c)]{
This @tech{formlet} renders using an SELECT element with an OPTION for each element of the sequence. An element is selected if @scheme[selected?] returns @scheme[#t]. Elements are displayed with @scheme[display].
}
@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.