Refactoring API
svn: r11792
This commit is contained in:
parent
a454479345
commit
130be7b597
7
collects/web-server/formlets.ss
Normal file
7
collects/web-server/formlets.ss
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
#lang scheme
|
||||||
|
(require web-server/formlets/formlets
|
||||||
|
web-server/formlets/input
|
||||||
|
web-server/formlets/servlet)
|
||||||
|
(provide (all-from-out web-server/formlets/servlet)
|
||||||
|
(all-from-out web-server/formlets/input)
|
||||||
|
(all-from-out web-server/formlets/formlets))
|
|
@ -1,5 +1,5 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
(require web-server/formlets/formlets)
|
(require web-server/formlets)
|
||||||
|
|
||||||
(define-struct date (month day))
|
(define-struct date (month day))
|
||||||
(define (date->xml d)
|
(define (date->xml d)
|
||||||
|
@ -54,8 +54,6 @@
|
||||||
(make-binding:form #"input_4" #"8"))
|
(make-binding:form #"input_4" #"8"))
|
||||||
#f "127.0.0.1" 80 "127.0.0.1"))
|
#f "127.0.0.1" 80 "127.0.0.1"))
|
||||||
|
|
||||||
(require web-server/formlets/servlet)
|
|
||||||
|
|
||||||
(define (start request)
|
(define (start request)
|
||||||
(display-itinernary
|
(display-itinernary
|
||||||
(send/formlet
|
(send/formlet
|
||||||
|
|
|
@ -48,5 +48,7 @@
|
||||||
(cross (pure (match-lambda [#,(cross-of #'q) e]))
|
(cross (pure (match-lambda [#,(cross-of #'q) e]))
|
||||||
#,(circ-of #'q)))]))
|
#,(circ-of #'q)))]))
|
||||||
|
|
||||||
(provide (all-defined-out)
|
(provide formlet
|
||||||
(all-from-out "lib.ss"))
|
formlet/c
|
||||||
|
formlet-display
|
||||||
|
formlet-process)
|
32
collects/web-server/formlets/input.ss
Normal file
32
collects/web-server/formlets/input.ss
Normal file
|
@ -0,0 +1,32 @@
|
||||||
|
#lang scheme
|
||||||
|
(require web-server/private/request-structs
|
||||||
|
"lib.ss")
|
||||||
|
|
||||||
|
(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 input-string
|
||||||
|
(cross
|
||||||
|
(pure (lambda (bf)
|
||||||
|
(bytes->string/utf-8 (binding:form-value bf))))
|
||||||
|
input))
|
||||||
|
|
||||||
|
(define input-int
|
||||||
|
(cross
|
||||||
|
(pure string->number)
|
||||||
|
input-string))
|
||||||
|
|
||||||
|
(define input-symbol
|
||||||
|
(cross
|
||||||
|
(pure string->symbol)
|
||||||
|
input-string))
|
||||||
|
|
||||||
|
(provide/contract
|
||||||
|
[input-string (formlet/c string?)]
|
||||||
|
[input-int (formlet/c integer?)]
|
||||||
|
[input-symbol (formlet/c symbol?)])
|
|
@ -58,14 +58,6 @@
|
||||||
(let-values ([(x p i) (f i)])
|
(let-values ([(x p i) (f i)])
|
||||||
(values (list (list* t ats x)) p i))))
|
(values (list (list* t ats x)) p i))))
|
||||||
|
|
||||||
(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)))
|
|
||||||
|
|
||||||
; Helpers
|
; Helpers
|
||||||
(define (formlet-display f)
|
(define (formlet-display f)
|
||||||
(let-values ([(x p i) (f 0)])
|
(let-values ([(x p i) (f 0)])
|
||||||
|
@ -75,23 +67,6 @@
|
||||||
(let-values ([(x p i) (f 0)])
|
(let-values ([(x p i) (f 0)])
|
||||||
(p (request-bindings/raw r))))
|
(p (request-bindings/raw r))))
|
||||||
|
|
||||||
; Input Formlets
|
|
||||||
(define input-string
|
|
||||||
(cross
|
|
||||||
(pure (lambda (bf)
|
|
||||||
(bytes->string/utf-8 (binding:form-value bf))))
|
|
||||||
input))
|
|
||||||
|
|
||||||
(define input-int
|
|
||||||
(cross
|
|
||||||
(pure string->number)
|
|
||||||
input-string))
|
|
||||||
|
|
||||||
(define input-symbol
|
|
||||||
(cross
|
|
||||||
(pure string->symbol)
|
|
||||||
input-string))
|
|
||||||
|
|
||||||
; Contracts
|
; Contracts
|
||||||
(define xexpr-forest/c
|
(define xexpr-forest/c
|
||||||
(listof xexpr?))
|
(listof xexpr?))
|
||||||
|
@ -119,8 +94,5 @@
|
||||||
[xml-forest (xexpr-forest/c . -> . (formlet/c procedure?))]
|
[xml-forest (xexpr-forest/c . -> . (formlet/c procedure?))]
|
||||||
[text (string? . -> . (formlet/c procedure?))]
|
[text (string? . -> . (formlet/c procedure?))]
|
||||||
[tag-xexpr (symbol? (listof (list/c symbol? string?)) (formlet/c alpha) . -> . (formlet/c alpha))]
|
[tag-xexpr (symbol? (listof (list/c symbol? string?)) (formlet/c alpha) . -> . (formlet/c alpha))]
|
||||||
[input-string (formlet/c string?)]
|
|
||||||
[input-int (formlet/c integer?)]
|
|
||||||
[input-symbol (formlet/c symbol?)]
|
|
||||||
[formlet-display ((formlet/c alpha) . -> . xexpr-forest/c)]
|
[formlet-display ((formlet/c alpha) . -> . xexpr-forest/c)]
|
||||||
[formlet-process ((formlet/c alpha) request? . -> . alpha)])
|
[formlet-process ((formlet/c alpha) request? . -> . alpha)])
|
Loading…
Reference in New Issue
Block a user