[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*))