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
|
||||
(require web-server/formlets/formlets)
|
||||
(require web-server/formlets)
|
||||
|
||||
(define-struct date (month day))
|
||||
(define (date->xml d)
|
||||
|
@ -54,8 +54,6 @@
|
|||
(make-binding:form #"input_4" #"8"))
|
||||
#f "127.0.0.1" 80 "127.0.0.1"))
|
||||
|
||||
(require web-server/formlets/servlet)
|
||||
|
||||
(define (start request)
|
||||
(display-itinernary
|
||||
(send/formlet
|
||||
|
|
|
@ -48,5 +48,7 @@
|
|||
(cross (pure (match-lambda [#,(cross-of #'q) e]))
|
||||
#,(circ-of #'q)))]))
|
||||
|
||||
(provide (all-defined-out)
|
||||
(all-from-out "lib.ss"))
|
||||
(provide formlet
|
||||
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)])
|
||||
(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
|
||||
(define (formlet-display f)
|
||||
(let-values ([(x p i) (f 0)])
|
||||
|
@ -75,23 +67,6 @@
|
|||
(let-values ([(x p i) (f 0)])
|
||||
(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
|
||||
(define xexpr-forest/c
|
||||
(listof xexpr?))
|
||||
|
@ -119,8 +94,5 @@
|
|||
[xml-forest (xexpr-forest/c . -> . (formlet/c procedure?))]
|
||||
[text (string? . -> . (formlet/c procedure?))]
|
||||
[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-process ((formlet/c alpha) request? . -> . alpha)])
|
Loading…
Reference in New Issue
Block a user