Common Lisp : Weblocks がいい感じに仕上がってきています。

Common Lisp の継続ベース Web フレームワークである Weblocks がいい感じに仕上がってきています。
CLSQL を永続化のバックエンドとして使えるようになり、（簡単なものは）かなり簡単に書けるようになりました。
例のごとく簡単な TODO アプリケーションを作ってみます。

データベースは PostgreSQL を使います。あらかじめ PostgreSQL のユーザとデータベースを作成しておきます。テーブルの作成は必要ありません。
sudo -u postgres createuser -s -P ancient
CREATE DATABASE junk WITH ENCODING='UTF8' OWNER=ancient;

Weblocks 自体のインストールは依存するライブラリがたくさんあって大変ですが、がんばってインストールします。asdf-install を使うのが一番簡単だと思います。こちらのページを参考に。

TODO アプリケーションのコードは下に示しますが、だいたい次のような感じです。

1. CLSQL でテーブルに対応するクラス todo を定義。


2. todo クラスのグリッドビューとフォームビューを定義。scaffold というキーワードが出てきてますね。


3. PostgreSQL への接続定義。


4. Weblocks のアプリケーション定義。


5. エントリーポイントとなる init-user-session の定義。継続ベースだと入口が必要です。


6. Web サーバの開始と、テーブルの作成

やはり Common Lisp だとテーブルからクラスではなく、クラスからテーブルですね ;)

;;;;-*- mode: lisp; syntax: common-lisp; -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :weblocks)
  (require :clsql))

(defpackage #:todo
  (:use #:common-lisp #:weblocks #:clsql)
  (:export #:start))

(in-package :todo)

;;; CLSQL のビュークラス定義。モデル定義。
(def-view-class todo ()
  ((id :accessor id :db-kind :key :db-constraints (:not-null :unique)
       :type integer)
   (content :initarg :content :accessor content :db-constraints :not-null
            :type (varchar 80))
   (done :initarg :done :accessor done-p :type boolean)))

;;; Weblocks の Grid ビュー定義。
(defview todo-grid-view (:type grid :inherit-from '(:scaffold todo))
  (id :hidep t))

;;; Weblocks の Form ビュー定義。
(defview todo-form-view (:type form :inherit-from '(:scaffold todo))
  (id :hidep t))

;;; CLSQL への接続定義。Postgresql に接続する。
(defstore *sql-store* :clsql '("localhost" "junk" "ancient" "password")
          :database-type :postgresql)

;;; Weblocks のアプリケーション定義。
(defwebapp 'todo-application
    :description "簡単な TODO アプリケーションです。")

;;; Weblocks のいわばエントリポイント。
(defun init-user-session (comp)
  (setf (weblocks:composite-widgets comp)
        (make-instance 'gridedit
                       :name 'todo-grid
                       :data-class 'todo
                       :sort '(id . :asc)
                       :view 'todo-grid-view
                       :item-form-view 'todo-form-view)))

;;; Weblocks を開始して、TODO テーブルを作成する。
(defun start ()
  ;; Weblocks の開始。
  (start-weblocks :port 8080)
  (setf hunchentoot:*catch-errors-p* nil) ; エラー時はデバッガが起動するように
  ;; TODO テーブルの作成
  (ignore-errors (create-view-from-class 'todo)))

;;; TODO テーブルの削除
;;(drop-view-from-class 'todo)