[Common Lisp] Web フレームワークを作る。CLSQL

CLSQL を使えるようにしよう。

S 式で SQL を書けるようにしようかと思ったけどやめた。難しかったから(w SQL 文そのまんま文字列でいいんじゃないかなと。また後で SQL のパラメータの渡し方は考える。今回は検索結果の参照を実装。

SQL 文の select から from の間を CL-PPCRE で強引にパースして CLSQL の do-query マクロに展開するマクロを書いた。

(defmacro with-db (var &body body)
  `(clsql:with-database (,var *connection-spec*
                              :database-type *database-type*
                              :if-exists :new
                              :pool t
                              :make-default nil)
     ,@body))


(let ((scanner (cl-ppcre:create-scanner #"""select\s+(.*?)\s+from\b"""
                                        :case-insensitive-mode t
                                        :single-line-mode t)))
  (defun select-columns (query)
    (let (result)
      (cl-ppcre:register-groups-bind (columns) (scanner (string+ query " from"))
        (cl-ppcre:do-register-groups (column)
            (#"""(\w+)\s*,""" (string+ columns #\,))
          (push (string-upcase column) result)))
      (nreverse result))))

(defmacro loop-query (query &body body)
  `(clsql:do-query (,(mapcar #'intern (select-columns query)) ,query)
     ,@body))

(defmacro! with-query (query &body body)
  `(block ,g!block
      (clsql:do-query (,(mapcar #'intern (select-columns query)) ,query)
        (return-from ,g!block ,@body))))

HUNCHENTOOT のディスパッチャ部分で with-db する。

(defgeneric dispatch ()
  (:method ()
    (ppcre:register-groups-bind (package symbol-name)
        ((format nil "~a([^/]+)/([^?/]+)" *url-prefix*)
         (hunchentoot:request-uri))
      (with-output-to-string (*standard-output*)
        (with-db clsql-sys:*default-database*
          (call-action-by-symbol
           (find-symbol (string-upcase symbol-name)
                        (intern (string-upcase package) :keyword))))))))

使うときはこんな感じになる。

(defaction todo ()
  (default-template (:title "TODO リスト")
    (html (:h1 "TODO リスト")
          (:table :border 1
                  (loop-query "select id as no, content, done from todo"
                    (html (:tr (:td no)
                               (:td content)
                               (:td done))))))))

うぅん、やっぱり S 式で SQL 書かないと何かと不便かなぁ。。。