From 57549a1759a25d4b7fcf51e827f36102c1f72be2 Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Mon, 9 Feb 2009 22:48:10 +0000 Subject: [PATCH] formlets svn: r13510 --- .../tests/web-server/all-web-server-tests.ss | 2 + collects/tests/web-server/formlets-test.ss | 64 ++++++- collects/web-server/formlets/input.ss | 179 ++++++++++++++++-- .../web-server/scribblings/formlets.scrbl | 73 ++++++- 4 files changed, 292 insertions(+), 26 deletions(-) diff --git a/collects/tests/web-server/all-web-server-tests.ss b/collects/tests/web-server/all-web-server-tests.ss index cf1831aa22..73a0cf1bf8 100644 --- a/collects/tests/web-server/all-web-server-tests.ss +++ b/collects/tests/web-server/all-web-server-tests.ss @@ -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 diff --git a/collects/tests/web-server/formlets-test.ss b/collects/tests/web-server/formlets-test.ss index bd96b39760..9f12129485 100644 --- a/collects/tests/web-server/formlets-test.ss +++ b/collects/tests/web-server/formlets-test.ss @@ -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")) diff --git a/collects/web-server/formlets/input.ss b/collects/web-server/formlets/input.ss index b56402d14d..4312d65967 100644 --- a/collects/web-server/formlets/input.ss +++ b/collects/web-server/formlets/input.ss @@ -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?)] diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index 3a448992ea..2754528afd 100644 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -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)]. } }