[tbnl-devel] New macro: create-groups-bind-regex-dispatcher

[Alceste Scalas]

Hello,

first of all, congratulations for TBNL :-)

Here's a small macro (with a big ugly name) for TBNL, that allows to
bind portions of a request URI to arguments passed to dispatch
functions. (see attachment)

I'm using it to create RESTful [1] URIs and web APIs for a web
application I'm playing with.  For example, let's say I want to publish
a news archive.  The "usual" way for accessing the news for August 27th,
2005 would be an URI like:

    http://www.news.tld/archive?year=2005&month=08&day=27

The proposed add-on allows to easily (well, actually *more* easily)
manage URIs like this:

    http://www.news.tld/archive/2005/08/27/

The task is performed by a macro called
create-groups-bind-regex-dispatcher, which takes three arguments:

    1. a CL-PPCRE regex (a string, an s-expression or a scanner)
       with one or more register groups.  It will be matched against
       the request URI;

    2. a list of variable names that will be bound to the register
       groups above iff the regex matches;

    3. a dispatch function that accepts keyword arguments named like
       the variables above.

A code sample for the news archive:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(defun archive-page (&key year month day)
  "Archive page"
  (format nil "Year: ~A; Month: ~A; Day: ~A" year month day))

(setq *dispatch-table*
      (list
        (create-groups-bind-regex-dispatcher
	   "^\\/archive\\/(\\d{4})\\/(\\d{1,2})\\/(\\d{1,2})\\/?$"
	   (year month day) archive-page)
        #'default-dispatcher))
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Under the hood, the list of variables provided to
create-groups-bind-regex-dispatcher is used with
cl-ppcre:register-groups-bind --- so you can apply some voodoo to the
matched variables:
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(defun archive-page (&key year month day)
  "Archive page with integer keyword parameters"
  (format nil "(+ year month day) => ~D" (+ year month day)))

(setq *dispatch-table*
      (list
        (create-groups-bind-regex-dispatcher
	   "^\\/archive\\/(\\d{4})\\/(\\d{1,2})\\/(\\d{1,2})\\/?$"
	   ((#'parse-integer year month day)) archive-page)
        #'default-dispatcher))
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

That's all.  I hope it will be useful for you as well...

Comments are welcome (please don't be too rude, it's one of my first
attempts with CL :-)

Regards,

alceste

  References:
    [1] http://www.ics.uci.edu/~fielding/pubs/dissertation/top.htm
-- 
Alceste Scalas <alceste.scalas at gmx.net>
-------------- next part --------------
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: TBNL; Base: 10 -*-
;;; $Id$

;;; Copyright (c) 2005, Alceste Scalas. All rights reserved.

;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:

;;;   * Redistributions of source code must retain the above copyright
;;;     notice, this list of conditions and the following disclaimer.

;;;   * Redistributions in binary form must reproduce the above
;;;     copyright notice, this list of conditions and the following
;;;     disclaimer in the documentation and/or other materials
;;;     provided with the distribution.

;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-package #:tbnl)

(defmacro create-groups-bind-regex-dispatcher (regex var-list page-function)
  "Works like CREATE-REGEX-DISPATCHER, but PAGE-FUNCTION will be
called with the variables in VAR-LIST used as additional keyword
arguments bound to the corresponding register groups of REGEX.
Note: VAR-LIST has the same format of its omonymous in
CL-PPCRE:REGISTER-GROUPS-BIND, so you can apply some magic here."
  `(let ((scanner (cl-ppcre:create-scanner ,regex)))
     (lambda (request)
       (cl-ppcre:register-groups-bind
	   ,var-list
	   (scanner (script-name request))
	 ;; Iff the regex matches, we return a closure that calls the
	 ;; dispatch function with the proper keyword arguments
	 (lambda () (,page-function ,@(build-keyword-list var-list)))))))

(defun build-keyword-list (var-list)
  "Utility function for CREATE-GROUPS-BIND-REGEX-DISPATCHER.
Build a keyword list out of the var-list, ready to be used to
invoke the dispatcher function"
  (mapcan (lambda (var)
	    (list (intern (symbol-name var) :keyword) var))
	  (cleanup-var-list var-list)))

(defun cleanup-var-list (var-list)
  "Flatten all the \(FUNCTION VAR) entries in VAR-LIST, leaving
only variable names."
  (loop for element in var-list
        if (consp element)
          nconc (loop for var in (rest element)
                      collect var)
        else
          collect element))
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 189 bytes
Desc: Questa parte del messaggio ? firmata
URL: <https://mailman.common-lisp.net/pipermail/tbnl-devel/attachments/20050827/2d7272e8/attachment.sig>