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

Adding radio and checkbox groups to formlets

Browse Source
This commit is contained in:
Jay McCarthy 2012-01-03 15:04:53 -07:00
parent 4271fe4231
commit ef1278d6e1
3 changed files with 171 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/tests/web-server/formlets-test.rkt
View File

@ -259,13 +259,67 @@
(cons #"input_0" #"value"))
(test-equal? "radio"
(test-display (radio #"start" #t))
'((input ((name "input_0") (type "radio") (checked "true")))))
'((input ((name "input_0") (type "radio") (value "start") (checked "true")))))
(test-equal? "radio"
(test-display (radio #"start" #f))
'((input ((name "input_0") (type "radio")))))
'((input ((name "input_0") (type "radio") (value "start")))))
(test-equal? "radio"
(test-display (radio #"start" #t #:attributes '([test "Test"])))
'((input ((name "input_0") (type "radio") (checked "true") (test "Test")))))
'((input ((name "input_0") (type "radio") (value "start") (checked "true") (test "Test")))))
; radio-group
(test-equal? "radio-group"
(test-process (radio-group (list "1" "2" "3"))
(list (make-binding:form #"input_0" #"0")))
"1")
(test-equal? "radio-group"
(test-process (radio-group (list 1 2 3) #:display number->string)
(list (make-binding:form #"input_0" #"0")))
1)
(test-equal? "radio-group"
(test-process (radio-group (list 1 2 3) #:display number->string)
(list (make-binding:form #"input_0" #"0")
(make-binding:form #"input_0" #"1")))
1)
(test-equal? "radio-group"
(test-display (radio-group
(list 1 2 3)
#:display number->string
#:checked? even?
#:attributes (λ (e) (list (list 'plus-one (number->string (add1 e)))))))
'((input ((name "input_0") (type "radio") (value "0") (plus-one "2")))
"1"
(input ((name "input_0") (type "radio") (value "1") (checked "true") (plus-one "3")))
"2"
(input ((name "input_0") (type "radio") (value "2") (plus-one "4")))
"3"))
; checkbox-group
(test-equal? "checkbox-group"
(test-process (checkbox-group (list "1" "2" "3"))
(list (make-binding:form #"input_0" #"0")))
(list "1"))
(test-equal? "checkbox-group"
(test-process (checkbox-group (list 1 2 3) #:display number->string)
(list (make-binding:form #"input_0" #"0")))
(list 1))
(test-equal? "checkbox-group"
(test-process (checkbox-group (list 1 2 3) #:display number->string)
(list (make-binding:form #"input_0" #"0")
(make-binding:form #"input_0" #"1")))
(list 1 2))
(test-equal? "checkbox-group"
(test-display (checkbox-group
(list 1 2 3)
#:display number->string
#:checked? even?
#:attributes (λ (e) (list (list 'plus-one (number->string (add1 e)))))))
'((input ((name "input_0") (type "checkbox") (value "0") (plus-one "2")))
"1"
(input ((name "input_0") (type "checkbox") (value "1") (checked "true") (plus-one "3")))
"2"
(input ((name "input_0") (type "checkbox") (value "2") (plus-one "4")))
"3"))
; submit
(test-equal? "submit"

88
collects/web-server/formlets/input.rkt
View File

@ -10,17 +10,22 @@
(define (next-name i)
(values (format "input_~a" i) (add1 i)))
(define (make-input* render)
(define (make-input*/forest render)
(lambda (i)
(let-values ([(w i) (next-name i)])
(define wb (string->bytes/utf-8 w))
(values (list (render w))
(values (render w)
(lambda (env)
(for/list ([b (in-list env)]
#:when (bytes=? wb (binding-id b)))
b))
i))))
(define (make-input* render)
(make-input*/forest
(lambda (w)
(list (render w)))))
(define (make-input render)
(lambda (i)
(let-values ([(w i) (next-name i)])
@ -109,9 +114,74 @@
#:attributes [attrs empty])
(input
#:type "radio"
#:value value
#:attributes
(if checked? (append (list (list 'checked "true")) attrs) attrs)))
(define (input-group l
#:kind kind
#:attributes [attrs (λ (x) empty)]
#:checked? [checked? (λ (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-group "Invalid selection: ~e" i))))
(for ([e l])
(remember! e))
(define (radio-first l)
(if (string=? kind "radio")
(first l)
l))
(cross
(pure
(lambda (bs)
(radio-first
(map (compose recall string->number
bytes->string/utf-8
binding:form-value)
bs))))
(make-input*/forest
(lambda (name)
(apply append
(for/list ([vn (in-range i)])
(define e (hash-ref value->element vn))
(define v (number->string vn))
(list
`(input ([name ,name]
[type ,kind]
[value ,v]
,@(if (checked? e)
'([checked "true"])
empty)
,@(attrs e)))
(display e))))))))
(define (radio-group l
#:attributes [attrs (λ (x) empty)]
#:checked? [checked? (λ (x) #f)]
#:display [display (λ (x) x)])
(input-group l
#:kind "radio"
#:attributes attrs
#:checked? checked?
#:display display))
(define (checkbox-group l
#:attributes [attrs (λ (x) empty)]
#:checked? [checked? (λ (x) #f)]
#:display [display (λ (x) x)])
(input-group l
#:kind "checkbox"
#:attributes attrs
#:checked? checked?
#:display display))
(define (submit value
#:attributes [attrs empty])
(input
@ -265,6 +335,20 @@
(#:attributes (listof (list/c symbol? string?)))
. ->* .
(formlet/c (or/c false/c binding?)))]
[radio-group ((sequence?)
(#:attributes
(-> any/c (listof (list/c symbol? string?)))
#:checked? (any/c . -> . boolean?)
#:display (any/c . -> . pretty-xexpr/c))
. ->* .
(formlet/c any/c))]
[checkbox-group ((sequence?)
(#:attributes
(-> any/c (listof (list/c symbol? string?)))
#:checked? (any/c . -> . boolean?)
#:display (any/c . -> . pretty-xexpr/c))
. ->* .
(formlet/c (listof any/c)))]
[submit ((bytes?)
(#:attributes (listof (list/c symbol? string?)))
. ->* .

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

@ -338,6 +338,34 @@ These @tech{formlet}s are the main combinators for form input.
This @tech{formlet} renders using an INPUT element with the RADIO type and the attributes given in the arguments.
}
@defproc[(radio-group [l sequence?]
[#:attributes attrs (any/c . -> . (listof (list/c symbol? string?))) (λ (x) empty)]
[#:checked? checked? (any/c . -> . boolean?) (λ (x) #f)]
[#:display display (any/c . -> . xexpr/c) (λ (x) x)])
(formlet/c any/c)]{
This @tech{formlet} renders using a sequence of INPUT elements of
RADIO type where each element gets its attributes from @racket[attrs]
that share a single NAME. An element is checked if @racket[checked?]
returns @racket[#t]. Elements are followed by the results of
@racket[display]. The result of processing this formlet is a single
element of the sequence.
}
@defproc[(checkbox-group [l sequence?]
[#:attributes attrs (any/c . -> . (listof (list/c symbol? string?))) (λ (x) empty)]
[#:checked? checked? (any/c . -> . boolean?) (λ (x) #f)]
[#:display display (any/c . -> . xexpr/c) (λ (x) x)])
(formlet/c (listof any/c))]{
This @tech{formlet} renders using a sequence of INPUT elements of
CHECKBOX type where each element gets its attributes from
@racket[attrs] that share a single NAME. An element is checked if
@racket[checked?] returns @racket[#t]. Elements are followed by the
results of @racket[display]. The result of processing this formlet is
a list of elements of the sequence.
}
@defproc[(submit [value bytes?]
[#:attributes attrs (listof (list/c symbol? string?)) empty])
(formlet/c (or/c false/c binding?))]{