diff --git a/collects/tests/web-server/formlets/formlet-star.rkt b/collects/tests/web-server/formlets/formlet-star.rkt new file mode 100644 index 0000000000..9d1dc28f7a --- /dev/null +++ b/collects/tests/web-server/formlets/formlet-star.rkt @@ -0,0 +1,108 @@ +#lang racket +(require web-server/formlets + web-server/formlets/new-syntax + tests/eli-tester + web-server/http + net/url) + +(define (make-test-req bs) + (make-request #"GET" (string->url "http://test.com") empty (delay bs) #f "127.0.0.1" 80 "127.0.0.1")) +(define (make-test-bindings . bs) + (for/list ([b (in-list bs)] + [i (in-naturals)]) + (make-binding:form (string->bytes/utf-8 (format "input_~a" i)) b))) +(define-syntax-rule (test-formlet formlet display args result) + (test (formlet-display formlet) => display + (formlet-process formlet (make-test-req (make-test-bindings . args))) => result)) + +(test + (test-formlet + (formlet* + (list 'p (input-string . =>* . name)) + name) + '((p () (input ((name "input_0") (type "text"))))) + (#"Jay") + '("Jay")) + + (test-formlet + (formlet* + `(p ,(input-string . =>* . name)) + name) + '((p () (input ((name "input_0") (type "text"))))) + (#"Jay") + '("Jay")) + + (test-formlet + (formlet* + (#%# `(p ,(input-string . =>* . name))) + name) + '((p () (input ((name "input_0") (type "text"))))) + (#"Jay") + '("Jay")) + + (test-formlet + (formlet* + `(div + ,@(for/list ([i (in-range 3)]) + `(p ,(input-string . =>* . name)))) + name) + '((div () + (p () (input ((name "input_0") (type "text")))) + (p () (input ((name "input_1") (type "text")))) + (p () (input ((name "input_2") (type "text")))))) + (#"Jay" #"Ness" #"Pokey") + (list "Jay" "Ness" "Pokey")) + + (test-formlet + (formlet* + `(div + ,@(for/list ([i (in-range 0)]) + `(p ,(input-string . =>* . name)))) + name) + '((div ())) + () + (list)) + + (local [(define two-names + (formlet (#%# ,(input-string . => . first-name) + ,(input-string . => . last-name)) + (values first-name last-name)))] + (test-formlet + (formlet* + `(div + ,@(for/list ([i (in-range 3)]) + `(p ,(two-names . =>* . (values first-name last-name))))) + (map string-append first-name (for/list ([e (in-list first-name)]) " ") last-name)) + '((div () + (p () (input ((name "input_0") (type "text"))) (input ((name "input_1") (type "text")))) + (p () (input ((name "input_2") (type "text"))) (input ((name "input_3") (type "text")))) + (p () (input ((name "input_4") (type "text"))) (input ((name "input_5") (type "text")))))) + (#"Jay" #"McCarthy" + #"Ness" #"Ninten" + #"Pokey" #"Porkey") + (list "Jay McCarthy" + "Ness Ninten" + "Pokey Porkey"))) + + (local [(define two-names + (formlet* (#%# (input-string . =>* . first-name) + (input-string . =>* . last-name)) + (values (first first-name) (first last-name))))] + (test-formlet + (formlet* + `(div + ,@(for/list ([i (in-range 3)]) + `(p ,(two-names . =>* . (values first-name last-name))))) + (map string-append first-name (for/list ([e (in-list first-name)]) " ") last-name)) + '((div () + (p () (input ((name "input_0") (type "text"))) (input ((name "input_1") (type "text")))) + (p () (input ((name "input_2") (type "text"))) (input ((name "input_3") (type "text")))) + (p () (input ((name "input_4") (type "text"))) (input ((name "input_5") (type "text")))))) + (#"Jay" #"McCarthy" + #"Ness" #"Ninten" + #"Pokey" #"Porkey") + (list "Jay McCarthy" + "Ness Ninten" + "Pokey Porkey"))) + + ) \ No newline at end of file diff --git a/collects/web-server/formlets.rkt b/collects/web-server/formlets.rkt index 25598e5c54..e0412b4011 100644 --- a/collects/web-server/formlets.rkt +++ b/collects/web-server/formlets.rkt @@ -1,11 +1,13 @@ #lang racket (require web-server/formlets/syntax + web-server/formlets/new-syntax web-server/formlets/input web-server/formlets/servlet web-server/formlets/lib) (provide (all-from-out web-server/formlets/servlet) (all-from-out web-server/formlets/input) (all-from-out web-server/formlets/syntax) + (all-from-out web-server/formlets/new-syntax) formlet/c formlet-display formlet-process) diff --git a/collects/web-server/formlets/lib.rkt b/collects/web-server/formlets/lib.rkt index bbe57c5e5b..ef8c9be086 100644 --- a/collects/web-server/formlets/lib.rkt +++ b/collects/web-server/formlets/lib.rkt @@ -53,7 +53,7 @@ (define (tag-xexpr t ats f) (lambda (i) (let-values ([(x p i) (f i)]) - (values (list (list* t ats x)) p i)))) + (values (list (list* t ats x)) p i)))) ; Helpers (define (formlet-display f) @@ -87,7 +87,7 @@ [pure (alpha . -> . (formlet/c alpha))] [cross ((formlet/c procedure?) formlet*/c . -> . formlet*/c)] - [cross* (((formlet/c (() () #:rest (listof alpha) . ->* . beta))) + [cross* (((formlet/c (unconstrained-domain-> beta))) () #:rest (listof (formlet/c alpha)) . ->* . (formlet/c beta))] [xml-forest (xexpr-forest/c . -> . (formlet/c procedure?))] diff --git a/collects/web-server/formlets/new-syntax.rkt b/collects/web-server/formlets/new-syntax.rkt new file mode 100644 index 0000000000..f2927cb002 --- /dev/null +++ b/collects/web-server/formlets/new-syntax.rkt @@ -0,0 +1,94 @@ +#lang racket +(require (for-syntax racket + syntax/parse + syntax/strip-context) + racket/stxparam + "lib.rkt" + "syntax.rkt" + (for-syntax "lib.rkt")) + +(define-syntax-parameter =>* + (λ (stx) (raise-syntax-error '=>* "Only allowed inside formlet*" stx))) + +(define (snoc x l) (append l (list x))) + +(struct label-formlet (p)) + +(define (label-formlet-answers labels formlet) + (label-formlet + (cross (pure (λ anss + (λ (answers) + (for ([label (in-list labels)] + [ans (in-list anss)]) + (hash-update! answers label (curry snoc ans) empty))))) + formlet))) + +(define xexpr-forest->label-formlet + (match-lambda + [(list) + (pure (λ (x) x))] + [(list-rest xe xf) + (cross* (pure (lambda (xe-populate-hash! xf-populate-hash!) + (lambda (answers) + (xe-populate-hash! answers) + (xf-populate-hash! answers)))) + (xexpr->label-formlet xe) + (xexpr-forest->label-formlet xf))])) + +(define xexpr->label-formlet + (match-lambda + [(#%#-mark l) + (xexpr-forest->label-formlet l)] + [(list (? symbol? tag) (list (list (? symbol? attr) (? string? str)) ...) xexpr ...) + (tag-xexpr tag (map list attr str) + (xexpr-forest->label-formlet xexpr))] + [(list (? symbol? tag) xexpr ...) + (tag-xexpr tag empty + (xexpr-forest->label-formlet xexpr))] + [(label-formlet p) + p] + [(? string? s) + (text s)])) + +(define (label-formlet-cross handler xexpr/labeled-formlets) + (cross (pure (λ (populate-hash!) + (define ht (make-hasheq)) + (populate-hash! ht) + (handler ht))) + (xexpr->label-formlet xexpr/labeled-formlets))) + +(struct #%#-mark (l)) +(define-syntax-rule (inner-#%# e ...) (#%#-mark (list e ...))) + +(define-syntax (formlet* stx) + (syntax-case stx () + [(_ q e) + (local [(define label->name (make-hash)) + (define (this-=>* stx) + (syntax-parse stx + #:literals (values) + [(=>* formlet:expr name:id) + #'(=>* formlet (values name))] + [(_ formlet:expr (values name:id ...)) + (define names (syntax->list #'(name ...))) + (define labels (map (compose gensym syntax->datum) names)) + (for ([label (in-list labels)] + [name (in-list names)]) + (hash-set! label->name label (replace-context #'e name))) + #`(label-formlet-answers '#,labels formlet)])) + (define q-raw + (local-expand #`(syntax-parameterize ([=>* #,this-=>*] + [#%# (make-rename-transformer #'inner-#%#)]) + q) + 'expression empty))] + (with-syntax ([((label . name) ...) + (for/list ([(k v) (in-hash label->name)]) + (cons k v))]) + (quasisyntax/loc stx + (label-formlet-cross (lambda (labeled) + (let ([name (hash-ref labeled 'label empty)] + ...) + e)) + #,q-raw))))])) + +(provide formlet* =>*) diff --git a/collects/web-server/formlets/syntax.rkt b/collects/web-server/formlets/syntax.rkt index ada5794ccb..bbe97c92fe 100644 --- a/collects/web-server/formlets/syntax.rkt +++ b/collects/web-server/formlets/syntax.rkt @@ -1,9 +1,12 @@ #lang racket -(require (for-syntax racket syntax/parse) +(require (for-syntax racket + syntax/parse) + racket/stxparam "lib.rkt" (for-syntax "lib.rkt")) -(define-syntax (#%# stx) (raise-syntax-error '#%# "Only allowed inside formlet" stx)) +(define-syntax-parameter #%# + (λ (stx) (raise-syntax-error '#%# "Only allowed inside formlet or formlet*" stx))) (define-for-syntax (cross-of stx) (syntax-parse @@ -56,22 +59,4 @@ (cross (pure (match-lambda [#,(cross-of #'q) e])) #,(circ-of #'q)))])) -(provide formlet #%#) - -(require "input.rkt") -(define date-formlet - (formlet - (div - "Month:" ,{input-int . => . month} - "Day:" ,{input-int . => . day}) - (values month day))) - -(define travel-formlet - (formlet - (div - "Name:" ,{input-string . => . name} - (div - "Arrive:" ,{date-formlet . => . (values arrive-m arrive-d)} - "Depart:" ,{date-formlet . => . (values depart-m depart-d)}) - ,@(list "1" "2" "3")) - (values name arrive-m arrive-d depart-m depart-d))) +(provide formlet #%#) \ No newline at end of file diff --git a/collects/web-server/scribblings/formlets.scrbl b/collects/web-server/scribblings/formlets.scrbl index 8a761db918..881ae52259 100644 --- a/collects/web-server/scribblings/formlets.scrbl +++ b/collects/web-server/scribblings/formlets.scrbl @@ -94,30 +94,93 @@ bindings for these names to @racket[formlet-process], the following list is retu The rest of the manual gives the details of @tech{formlet} usage and extension. -@section{Syntactic Shorthand} +@section{Static Syntactic Shorthand} @(require (for-label web-server/formlets/syntax)) @defmodule[web-server/formlets/syntax]{ Most users will want to use the syntactic shorthand for creating @tech{formlet}s. -@defform[(formlet rendering yields-expr)]{ - Constructs a @tech{formlet} with the specified @racket[rendering] and the processing - resulting in the @racket[yields-expr] expression. The @racket[rendering] form is a quasiquoted - @xexpr, with two special caveats: +@defform[(formlet rendering-xexpr yields-expr)]{ + Constructs a @tech{formlet} with the specified @racket[rendering-xexpr] and the processing + result is the evaluation of the @racket[yields-expr] expression. The @racket[rendering-xexpr] form is a quasiquoted + syntactic @xexpr, with three special caveats: @racket[,{_formlet-expr . => . _name}] embeds the - @tech{formlet} given by @racket[_formlet-expr]; the result of this processing this formlet is + @tech{formlet} given by @racket[_formlet-expr]; the result of processing this formlet is available in the @racket[yields-expr] as @racket[_name]. @racket[,{_formlet-expr . => . (values _name ...)}] embeds the - @tech{formlet} given by @racket[_formlet-expr]; the results of this processing this formlet is + @tech{formlet} given by @racket[_formlet-expr]; the results of processing this formlet is available in the @racket[yields-expr] as @racket[_name ...]. @racket[(#%# _xexpr ...)] renders an @xexpr forest. + + These forms @emph{may not} appear nested inside @racket[unquote] or @racket[unquote-splicing]. For example, this is illegal: + @racketblock[ + (formlet (div ,@(for/list ([i (in-range 10)]) + `(p ,(text-input . => . name)))) + name) + ] } -@defidform[#%#]{Only allowed inside @racket[formlet].} +@defidform[#%#]{Only allowed inside @racket[formlet] and @racket[formlet*].} + +} + +@section{Dynamic Syntactic Shorthand} + +@(require (for-label web-server/formlets/new-syntax)) +@defmodule[web-server/formlets/new-syntax]{ + +The @racket[formlet] syntax is too restrictive for some applications because it forces the @racket[_rendering] +to be @emph{syntactically} an @|xexpr|. You may discover you want to use a more "dynamic" shorthand. + +@defform[(formlet* rendering-expr yields-expr)]{ + Constructs a @tech{formlet} where @racket[rendering-expr] is evaluated (with caveats) to construct the rendering + and the processing result is the evaluation of the the @racket[yields-expr] expression. + The @racket[rendering-expr] should evaluate to an "@xexpr" that may embed the results of the following forms + that only have meaning within @racket[formlet*]: + + @racket[{_formlet-expr . =>* . _name}] embeds the + @tech{formlet} given by @racket[_formlet-expr]; the result of processing this formlet is + available in the @racket[yields-expr] as @racket[_name]. + + @racket[{_formlet-expr . =>* . (values _name ...)}] embeds the + @tech{formlet} given by @racket[_formlet-expr]; the results of processing this formlet is + available in the @racket[yields-expr] as @racket[_name ...]. + + @racket[(#%# _xexpr-expr ...)] renders an @xexpr forest. + + Each of these forms evaluates to an opaque value that @racket[rendering-expr] may not manipulate in any way, + but if it is returned to @racket[formlet*] as part of an "@xexpr" it will be rendered and the formlets processing + stages will be executed, etc. + + Because these forms @emph{may} appear anywhere in @racket[rendering-expr], they may be duplicated. Therefore, + the formlet may render (and be processed) multiple times. Thus, in @racket[yields-expr] the formlet result names are + bound to lists of results rather than single results as in @racket[formlet]. The result list is ordered according + to the order of the formlets in the result of @racket[rendering-expr]. For example, in + @racketblock[ + (formlet* `(div ,@(for/list ([i (in-range 1 10)]) + `(p ,(number->string i) + ,(text-input . =>* . name)))) + name) + ] + @racket[name] is bound to a list of strings, not a single string, where the first element is the string that + was inputted next to the string @litchar{1} on the Web page. + + In this example, it is clear that this is the desired behavior. However, sometimes the value of a formlet's + result may be surprising. For example, in + @racketblock[ + (formlet* `(div (p ,(text-input . =>* . name))) + name) + ] + @racket[name] is bound to a list of strings, because @racket[formlet*] cannot syntactically determine if + the formlet whose result is bound to @racket[name] is used many times. + +} + +@defidform[=>*]{Only allowed inside @racket[formlet*].} }