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 ## 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. ## 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/README modules/module-0.scm modules/module-1.scm \
modules/module-2.scm modules/main \ 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_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` 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. safe Examples for creating and using safe environments.
web Simple web servers.
compat autoconf code for making a Guile extension compat autoconf code for making a Guile extension
compatible with older versions of Guile. 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)