1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
#lang racket/base
(require web-server/servlet
racket/stxparam
racket/list
racket/contract
(for-syntax racket/base))
(define-syntax-parameter embed/url
(λ (stx) (raise-syntax-error stx 'embed/url "Used outside page")))
(define-syntax-rule (page e ...)
(send/suspend/dispatch
(λ (this-embed/url)
(syntax-parameterize ([embed/url (make-rename-transformer #'this-embed/url)])
e ...))))
(define current-request (make-parameter #f))
(define-syntax-rule (lambda/page formals e ...)
(lambda (req . formals)
(parameterize ([current-request req])
(page e ...))))
(define-syntax-rule (define/page (id . formals) e ...)
(define id
(lambda/page formals e ...)))
(define binding-id/c (or/c bytes? string? symbol?))
(define (binding-id->bytes id)
(cond [(bytes? id)
id]
[(string? id)
(string->bytes/utf-8 id)]
[(symbol? id)
(binding-id->bytes (symbol->string id))]))
(define binding-format/c (symbols 'string 'bytes 'file 'binding))
(define (convert-binding format b)
(case format
[(string)
(and (binding:form? b)
(with-handlers ([exn:fail? (λ (x) #f)])
(bytes->string/utf-8 (binding:form-value b))))]
[(bytes)
(and (binding:form? b)
(binding:form-value b))]
[(file)
(and (binding:file? b)
(binding:file-content b))]
[(binding)
b]))
(define (get-binding id [req (current-request)]
#:format [format 'string])
(convert-binding
format
(bindings-assq
(binding-id->bytes id)
(request-bindings/raw req))))
(define (get-bindings id [req (current-request)]
#:format [format 'string])
(define id-bs (binding-id->bytes id))
(filter-map
(λ (b)
(and (bytes=? id-bs (binding-id b))
(convert-binding format b)))
(request-bindings/raw req)))
(provide embed/url
page
lambda/page
define/page)
(provide/contract
[current-request (parameter/c (or/c false/c request?))]
[binding-id/c contract?]
[binding-format/c contract?]
[get-binding (->* (binding-id/c) (request? #:format binding-format/c)
(or/c false/c string? bytes? binding?))]
[get-bindings (->* (binding-id/c) (request? #:format binding-format/c)
(listof (or/c string? bytes? binding?)))])
|
