mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

add simple web app examples

Browse source 
* examples/web/hello.scm:
* examples/web/debug-sxml.scm: New examples, for simple web
  applications.

* examples/README:
* examples/Makefile.am: Add new files.
This commit is contained in:
Andy Wingo 2010-12-02 11:47:19 +01:00
parent a0ad8ad16c
commit ee3a800f46
4 changed files with 94 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

6
examples/Makefile.am
View file

@ -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`

2
examples/README
View file

@ -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.

59
examples/web/debug-sxml.scm Normal file
View file

@ -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)

29
examples/web/hello.scm Normal file
View file

@ -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)