Weblocks

以前にもブログに書いたけど、また書く。

Weblocks は Common Lisp で書かれた Web フレームワーク。継続と AJAX を使うのが特徴。

たいして根拠はないのだけど Common Lisp 界では Weblocks が一番いい Web フレームワークのような気がする。

インストールは Weblocks: Installation に書かれているとおり clbuild を使うのが一番いいみたい。ただ moptilities と closer-mop とのバージョン関係に少々問題があるようなので次のとおり moptilities.asd をちょこっと修正する。

diff -rN old-moptilities/moptilities.asd new-moptilities/moptilities.asd
35c35,36
<   :depends-on ((:version :closer-mop "0.55")))
---
>   ;;:depends-on ((:version :closer-mop "0.55")))
>   :depends-on (:closer-mop))

それはともかく asdf で依存ライブラリのバージョン指定なんてできたんですね。

(require :weblocks-demo)
(weblocks-demo:start-weblocks-demo :port 3455)

何故か次のようなメッセージが表示されが無視して http://localhost:3455/weblocks-demo にアクセスすればデモが動いているのを確認できる。

WARNING:
   An instance of WEBLOCKS-DEMO with name weblocks-demo is already running, ignoring start request

このデモのデータストレージには CL-PREVALENCE を使っている。 CLSQL を使うのと Elephant を使うデモもある。

以下、記憶にない覚え書き。

flash は次のアクションで消える。

nil をセットする項目は :type (or null (varchar 30))

必須項目は :db-constraints :not-null

id 以外をキーにする場合 (defmethod class-id-slot-name ((W_来店者 (eql (class-name (find-class 'W_来店者)))))

'来店者番号)

今度なんか作ってみよう。

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)

[Common Lisp] Weblocks

Weblocks は Common Lisp の Web フレームワークです。
ちょっと触った感じでは、簡単に色々のことをやってくれそうです。
また、後でいじってみますが、まずは最初のページが表示されるところまで

;; darcs get http://common-lisp.net/project/cl-weblocks/darcs/cl-weblocks
;;(require :asdf-install)
;;(loop for i in '(:closer-mop :metatilities :hunchentoot :cl-who :cl-ppcre :cl-json :puri :rt :tinaa :md5 :cl-fad :fare-matcher) do (asdf-install:install i))

(eval-when (:load-toplevel :compile-toplevel :execute)
  (loop for path in '(#p"scripts/" #p"src/" #p"test/")
     do (pushnew (merge-pathnames
                  path #p"/Users/ancient/letter/lisp/weblocks/cl-weblocks/")
                 asdf:*central-registry* :test #'equal))
  (require :weblocks))

(weblocks:start-weblocks)

(weblocks:defwebapp 'our-application)

(defun init-user-session (comp)
  (setf (weblocks:composite-widgets comp)
        (list "あいう")))

(weblocks:reset-sessions)

asdf:*central-registry* へのパス追加も eval-when の中でやらなければだめでした。