From e999daa87176a732586fdbd79d2e1a1d5fae0842 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Fri, 26 Nov 2010 16:50:37 -0500
Subject: [PATCH] Adding page and get-binding

---
 collects/web-server/page/page.rkt | 77 +++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 collects/web-server/page/page.rkt

diff --git a/collects/web-server/page/page.rkt b/collects/web-server/page/page.rkt
new file mode 100644
index 0000000000..011c34e4ab
--- /dev/null
+++ b/collects/web-server/page/page.rkt
@@ -0,0 +1,77 @@
+#lang racket/base
+(require web-server/servlet
+         racket/stxparam
+         (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 #:format [format 'string])
+  (convert-binding
+   format
+   (bindings-assq 
+    (binding-id->bytes id) 
+    (request-bindings/raw (current-request)))))
+
+(define (get-bindings id #: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 (current-request))))
+             
+(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) (#:format binding-format/c)
+                   (or/c false/c string? bytes? binding?))]
+ [get-bindings (->* (binding-id/c) (#:format binding-format/c)
+                    (listof (or/c string? bytes? binding?)))])
\ No newline at end of file