diff options
| author | Andy Wingo <wingo@pobox.com> | 2010-12-02 11:47:19 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2010-12-02 11:47:19 +0100 |
| commit | ee3a800f4661f656abf10e78b22f7f1452360714 (patch) | |
| tree | 3c367cdd899ffc0a2502f6c4a4e3d1570fa09fa7 /examples | |
| parent | a0ad8ad16c14adbf13e0ead3dafd833fb3c8f0d3 (diff) | |
| download | guile-ee3a800f4661f656abf10e78b22f7f1452360714.tar.gz | |
add simple web app examples
* examples/web/hello.scm:
* examples/web/debug-sxml.scm: New examples, for simple web
applications.
* examples/README:
* examples/Makefile.am: Add new files.
Diffstat (limited to 'examples')
| -rw-r--r-- | examples/Makefile.am | 6 | ||||
| -rw-r--r-- | examples/README | 2 | ||||
| -rw-r--r-- | examples/web/debug-sxml.scm | 59 | ||||
| -rw-r--r-- | examples/web/hello.scm | 29 |
4 files changed, 94 insertions, 2 deletions
diff --git a/examples/Makefile.am b/examples/Makefile.am index 99a0a905b..233eee95e 100644 --- a/examples/Makefile.am +++ b/examples/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc. +## Copyright (C) 2001, 2006, 2008, 2009, 2010 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -36,7 +36,9 @@ EXTRA_DIST = README ChangeLog-2008 check.test \ modules/README modules/module-0.scm modules/module-1.scm \ modules/module-2.scm modules/main \ \ - safe/README safe/safe safe/untrusted.scm safe/evil.scm + safe/README safe/safe safe/untrusted.scm safe/evil.scm \ + \ + web/hello.scm web/debug-sxml.scm AM_CFLAGS = `PATH=$(bindir)$(PATH_SEPARATOR)$$PATH PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config compile` AM_LIBS = `PATH=$(bindir)$(PATH_SEPARATOR)$$PATH PKG_CONFIG_PATH=$(libdir)/pkgconfig $(bindir)/guile-config link` diff --git a/examples/README b/examples/README index f6d645cec..1c6a95a3c 100644 --- a/examples/README +++ b/examples/README @@ -35,6 +35,8 @@ modules Examples for writing and using Guile modules. safe Examples for creating and using safe environments. +web Simple web servers. + compat autoconf code for making a Guile extension compatible with older versions of Guile. diff --git a/examples/web/debug-sxml.scm b/examples/web/debug-sxml.scm new file mode 100644 index 000000000..4e6afc271 --- /dev/null +++ b/examples/web/debug-sxml.scm @@ -0,0 +1,59 @@ +;;; Commentary: + +;;; A simple debugging server that responds to all responses with a +;;; table containing the headers given in the request. +;;; +;;; As a novelty, this server uses a little micro-framework to build up +;;; the response as SXML. Instead of a string, the `respond' helper +;;; returns a procedure for the body, which allows the `(web server)' +;;; machinery to collect the output as a bytevector in the desired +;;; encoding, instead of building an intermediate output string. +;;; +;;; In the future this will also allow for chunked transfer-encoding, +;;; for HTTP/1.1 clients. + +;;; Code: + +(use-modules (web server) + (web request) + (web response) + (sxml simple)) + +(define html5-doctype "<!DOCTYPE html>\n") +(define default-title "Hello hello!") + +(define* (templatize #:key (title "No title") (body '((p "No body")))) + `(html (head (title ,title)) + (body ,@body))) + +(define* (respond #:optional body #:key + (status 200) + (title default-title) + (doctype html5-doctype) + (content-type-params '(("charset" . "utf-8"))) + (content-type "text/html") + (extra-headers '()) + (sxml (and body (templatize #:title title #:body body)))) + (values (build-response + #:code status + #:headers `((content-type . (,content-type ,@content-type-params)) + ,@extra-headers)) + (lambda (port) + (if sxml + (begin + (if doctype (display doctype port)) + (sxml->xml sxml port)))))) + +(define (debug-page request body) + (respond `((h1 "hello world!") + (table + (tr (th "header") (th "value")) + ,@(map (lambda (pair) + `(tr (td (tt ,(with-output-to-string + (lambda () (display (car pair)))))) + (td (tt ,(with-output-to-string + (lambda () + (write (cdr pair)))))))) + (request-headers request)))))) + +(run-server debug-page) diff --git a/examples/web/hello.scm b/examples/web/hello.scm new file mode 100644 index 000000000..db17b9b5b --- /dev/null +++ b/examples/web/hello.scm @@ -0,0 +1,29 @@ +;;; Commentary: + +;;; A simple web server that responds to all requests with the eponymous +;;; string. Visit http://localhost:8080 to test. + +;;; Code: + +(use-modules (web server)) + +;; A handler receives two values as arguments: the request object, and +;; the request body. It returns two values also: the response object, +;; and the response body. +;; +;; In this simple example we don't actually access the request object, +;; but if we wanted to, we would use the procedures from the `(web +;; request)' module. If there is no body given in the request, the body +;; argument will be false. +;; +;; To create a response object, use the `build-response' procedure from +;; `(web response)'. Here we take advantage of a shortcut, in which we +;; return an alist of headers for the response instead of returning a +;; proper response object. In this case, a response object will be made +;; for us with a 200 OK status. +;; +(define (handler request body) + (values '((content-type . ("text/plain"))) + "Hello, World!")) + +(run-server handler) |