82 lines
2.4 KiB
Racket
82 lines
2.4 KiB
Racket
#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?)))])
|