ずっと停滞している Common Lisp の Web フレームワーク作り

何年も前から作りかけなんだよね。

継続使えるといろいろ楽だったりもするけど、ステートレスの方を選択したい。

@ で始まる変数でリクエストパラメータやセッション変数にアクセスできる。

• @foo リクエストパラメータ
• s@foo セッション変数
• c@foo クッキー

(setf s@foo "bar") みたいなこともしたい。

ビューは S 式だけど、(list (make-instance 'html :content (list (make-instance 'header ...) ...))) みたいなのに変換して User-Agent によって出力を変えるとかもしてみたい。

(defmacro with-default-template ((&key (title "ブログ")) &body body)
  `(html (:html
           (:head
            (:meta :charset "UTF-8")
            (:title ,title)
            (:script :type "text/javascript"
                     :src "http://ajax.googleapis.com/ajax/libs/jquery/1.4.4/jquery.min.js"))
           (:body
            (:div (get-universal-time))
            ,@body))))

(defaction index.html ()
  (with-default-template ()
    (:h1 "ブログ")
    (:a :href (path-for 'new-entry) "投稿")
    (collect (#M(^ html
                   (:h3 (:a :href (path-for 'entry :id (id _)) #"""#,(title _) <#,(id _)>"""))
                   (:div :class :content (content _)))
                (scan (clsql:select 'entry :flatp t :refresh t :order-by '(([created-at] :desc))))))))

(defaction new-entry (:route "entry/new")
  (with-default-template ()
    (:h1 "投稿")
    (:form :action (path-for 'create-entry) :method :post
           (:div "タイトル" (:text :name :title))
           (:textarea :name :content :rows 5 :cols 40)
           (:submit :value "投稿"))
    (:a :href (path-for 'index.html) "戻る")))

(defaction create-entry ()
  ;; TODO redirect で throw するので無駄に新しいトランザクションを作る
  (with-db
    (clsql:update-records-from-instance
     (make-instance 'entry :title @title :content @content)))
  (redirect (path-for 'index.html)))

(defaction entry (:route "entry/:id")
  (let ((entry (car (clsql:select 'entry :where [= [id] @id] :flatp t))))
    (with-default-template ()
      (:h1 (title entry))
      (:div (content entry))
      (:div (:a :href (path-for 'index.html) "戻る")))))

いつか完成するかな。