closures.scm
#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))

;; returns the key
(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))