#lang scheme/base
(require (file "util.scm")
(planet "web.scm" ("soegaard" "web.plt" 2 1))
(file "web-support.scm")
(file "settings.scm"))
(provide add-closure!
call-closure
body-as-closure-key
body-as-url
handle-closure-in-req
)
(declare-setting *WEB_APP_URL* "http://example.com")
(declare-setting *CLOSURE_URL_KEY* 'function)
(define-syntax body-as-closure-key
(syntax-rules (=>)
((_ req-identifier => body ...)
(add-closure! (lambda (req-identifier) body ...)))))
(define-syntax body-as-url
(syntax-rules (=>)
((_ req-identifier => body ...)
(with-defaults
(format "~A?~A=~A"
(setting *WEB_APP_URL*)
(setting *CLOSURE_URL_KEY*)
(body-as-closure-key req-identifier => body ...))))))
(define-syntax handle-closure-in-req
(syntax-rules ()
((_ req no-closure-body ...)
(let ((url-key (setting *CLOSURE_URL_KEY*))
(binds (request-bindings req)))
(if (exists-binding? url-key binds)
(call-closure (extract-binding/single url-key binds) req)
(begin no-closure-body ...))))))
(define CLOSURES (make-hash-table 'equal))
(define (add-closure! clos)
(let ((key (random-key-string 20)))
(hash-table-put! CLOSURES key clos)
key))
(define (call-closure key req)
((hash-table-get CLOSURES key (lambda () (e "Expired or missing closure '~A'." key)))
req))