[Common Lisp] UCW で Arc Challenge
UCW で Arc Challenge を書いてみた。
Arc より短かいく書くのは無理なので、なるべく UCW っぽく書いてみたつもり。
UCW として今回必要だったものは次のとおり
- サーバ（standard-server）
- アプリケーション(arc-challenge-application)
- ウィンドウコンポーネント(arc-challenge-window)
- foo 入力コンポーネント(input-foo-component)
- リンク表示コンポーネント(click-here-component)
- foo 表示コンポーネント(you-said-component)
- エントリポイント(index.ucw)
また UCW はコンポーネント指向なので arc-challenge-window をウィンドウコンポーネントとして定義し、そのボディ部分としてinput-foo-component, click-here-component, you-said-componentの3つのコンポーネントを定義した。
また UCW は継続ベースなのでエントリポイントと言う入口（最初に表示するページ）を定義する。エントリポイントでは (call 'arc-challenge-window) によってarc-challenge-window を表示している。
arc-challenge-window は initialize-instance :after で input-foo-componentを設定しているので foo 入力コンポーネントが表示される。
input-foo-component のフォームの :action で、call-component で arc-challenge-window の body 部分を切り替えることで、リンクの表示と foo の入力の表示を行っている。このあたりが継続っぽいところだと思う。
#|
http://www.paulgraham.com/arcchallenge.html
(defop said req
(aform [w/link (pr "you said: " (arg _ "foo"))
(pr "click here")]
(input "foo")
(submit)))
|#
(eval-when (:compile-toplevel :load-toplevel :execute)
(require :ucw))
(in-package :ucw-user)
;; サーバのインスタンスを生成
(defvar *arc-challenge-server*
(make-instance 'standard-server
:backend (make-backend :httpd :port 9090)))
;; アプリケーションを定義
(defclass arc-challenge-application (standard-application
cookie-session-application-mixin)
()
(:default-initargs
:url-prefix "/arc-challenge/")) ; http://localhost:9090/arc-challenge/xxx
;; アプリケーションのインスタンスを生成
(defvar *arc-challenge-application* (make-instance 'arc-challenge-application))
;; サーバにアプリケーションを登録
(register-application *arc-challenge-server* *arc-challenge-application*)
;; ウィンドウコンポーネント
(defcomponent arc-challenge-window (standard-window-component)
()
(:default-initargs
:title "Arc Challenge"))
;; body の設定
(defmethod initialize-instance :after ((self arc-challenge-window) &rest rest)
(declare (ignore rest))
(with-slots (body) self
(setf body (make-instance 'input-foo-component :window self))))
;; ウィンドウの描画
(defmethod render ((self arc-challenge-window))
(<:h1 "Arc Challenge")
(call-next-method))
;; foo 入力コンポーネント
(defcomponent input-foo-component ()
((window :initarg :window)))
;; その描画
(defmethod render ((self input-foo-component))
(let ((foo ""))
(<ucw:form
:action (flet ((goto (&rest rest)
(with-slots (window) self
;; arc-challenge-window の body 部分を切り替える。
(call-component self (apply #'make-instance rest)))))
;; リンク表示コンポーネント
(goto 'click-here-component)
;; foo 表示コンポーネント
(goto 'you-said-component :foo foo))
"foo "
(<ucw:input :type "text" :accessor foo)
(<:submit))))
;; リンク表示コンポーネント
(defcomponent click-here-component () ())
;; その描画
(defmethod render ((self click-here-component))
(<ucw:a :action (answer)
"click here"))
;; foo 表示コンポーネント
(defcomponent you-said-component ()
((foo :initarg :foo)))
;; その描画
(defmethod render ((self you-said-component))
(<:div "you said: "
(<:as-html (slot-value self 'foo)))
(<ucw:a :action (answer) "ok"))
;; エントリポイントを定義
(defentry-point "index.ucw" (:application *arc-challenge-application*)
()
(call 'arc-challenge-window))
;; エラー発生時にデバッガを起動
(setf ucw-core:*debug-on-error* t)
;; サーバスタート
(defun start-arc-challenge ()
"http://localhost:9090/arc-challenge/index.ucw
にアクセスしてください。"
(startup-server *arc-challenge-server*))
