Fukamachiさんが開発されているMitoというORMのREADME訳です。元の文章は、Mito READMEをご参照ください。

Mito

Mitoは、Integralの後継として開発中のORMです。

MySQL, PostgreSQL, SQLite3をサポート
RubyのActiveRecordのように、デフォルトでid(シリアル値),created_at,updated_atを追加
マイグレーション
データベーススキーマのバージョン管理

注

このソフトは開発初期段階です。APIは変更する可能性が高いので、注意してください。

SBCLとClozure CLの処理系での動作を想定しており、MySQL, PostgreSQL, SQLite3で動作します。

利用方法

(mito:connect-toplevel :mysql :database-name "myapp" :username "fukamachi" :password "c0mon-1isp")
;=> #<DBD.MYSQL:<DBD-MYSQL-CONNECTION> {100691BFF3}>

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (or (:varchar 128) :null)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class))
;=> #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::USER>

(mito:table-definition 'user)
;=> (#<SXQL-STATEMENT: CREATE TABLE user (id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(64) NOT NULL, email VARCHAR(128))>)

(defclass tweet ()
  ((status :col-type :text
           :initarg :status
           :accessor tweet-status)
   (user :col-type user
         :initarg :user
         :accessor tweet-user))
  (:metaclass mito:dao-table-class))
;=> #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::TWEET>

(mito:table-definition 'tweet)
;=> (#<SXQL-STATEMENT: CREATE TABLE tweet (id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, status TEXT NOT NULL, user_id BIGINT UNSIGNED NOT NULL, created_at TIMESTAMP, updated_at TIMESTAMP)>)

データベースへの接続

Mitoは、 RDBMSへの接続を確立するために、connect-toplevel と disconnect-toplevelprovidesの関数を提供しています。connect-toplevelは、dbi:connectと同じ引数をとります。主に、ドライバーの種類、データベース名、ユーザ名とパスワードです。

(mito:connect-toplevel :mysql :database-name "myapp" :username "fukamachi" :password "c0mon-1isp")

connect-toplevel は*connection*に新たな接続を設定し返します。

レキシカルに接続を使うには、次のようにバインドしてください:

(let ((mito:*connection* (dbi:connect :sqlite3 :database-name #P"/tmp/myapp.db")))
  (unwind-protect (progn ...)
    ;; Ensure that the connection is closed.
    (dbi:disconnect mito:*connection*)))

クラス定義

Mitoでは、(:metaclass mito:dao-table-class)を明記することにより、データベースのテーブルに対応するクラスを定義することができます。

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (or (:varchar 128) :null)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class))

上では、通常のCommon Lispでするようなクラス定義ですが、追加オプションも許可している点が異なります。

(defclass {class-name} ()
  ({column-definition}*)
  (:metaclass mito:dao-table-class)
  [[class-option]])

column-definition ::= (slot-name [[column-option]])
column-option ::= {:col-type col-type} |
                  {:primary-key boolean} |
                  {:inflate inflation-function} |
                  {:deflate deflation-function} |
                  {:references {class-name | (class-name slot-name)}} |
                  {:ghost boolean}
col-type ::= { keyword |
              (keyword . args) |
              (or keyword :null) |
              (or :null keyword) }
class-option ::= {:primary-key symbol*} |
                 {:unique-keys {symbol | (symbol*)}*} |
                 {:keys {symbol | (symbol*)}*} |
                 {:table-name table-name}
                 {:auto-pk boolean}
                 {:record-timestamps boolean}

クラスが自動的にスロットを追加することに注目してください。つまり、主キーがない場合にはidという名前の主キー、また、タイムスタンプのためにcreated_at``updated_atが追加されます。これらの振る舞いを無効化するには、defclassで、:auto-pk nilか:record-timestamps nilと明記してください。

(mito.class:table-column-slots (find-class 'user))
;=> (#<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS MITO.DAO.MIXIN::ID>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS COMMON-LISP-USER::NAME>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS COMMON-LISP-USER::EMAIL>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS MITO.DAO.MIXIN::CREATED-AT>
;    #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS MITO.DAO.MIXIN::UPDATED-AT>)

クラスは、暗黙的に、mito:dao-classを継承します。

(find-class 'user)
;=> #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::USER>

(c2mop:class-direct-superclasses *)
;=> (#<STANDARD-CLASS MITO.DAO.TABLE:DAO-CLASS>)

これにより、全てのテーブルクラスに適用するメソッドを定義するときに便利になります。

テーブルの定義を生成する

(mito:table-definition 'user)
;=> (#<SXQL-STATEMENT: CREATE TABLE user (id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(64) NOT NULL, email VARCHAR(128), created_at TIMESTAMP, updated_at TIMESTAMP)>)

(sxql:yield *)
;=> "CREATE TABLE user (id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY, name VARCHAR(64) NOT NULL, email VARCHAR(128), created_at TIMESTAMP, updated_at TIMESTAMP)"
;   NIL

データベースのテーブルを作る

(mapc #'mito:execute-sql (mito:table-definition 'user))

(mito:ensure-table-exists 'user)

CRUD

(defvar me
  (make-instance 'user :name "Eitaro Fukamachi" :email "e.arrows@gmail.com"))
;=> USER

(mito:insert-dao me)
;-> ;; INSERT INTO `user` (`name`, `email`, `created_at`, `updated_at`) VALUES (?, ?, ?, ?) ("Eitaro Fukamachi", "e.arrows@gmail.com", "2016-02-04T19:55:16.365543Z", "2016-02-04T19:55:16.365543Z") [0 rows] | MITO.DAO:INSERT-DAO
;=> #<USER {10053C4453}>

;; 上と同じです
(mito:create-dao 'user :name "Eitaro Fukamachi" :email "e.arrows@gmail.com")

;; 主キーの値を取得する
(mito:object-id me)
;=> 1

;; DBでデータを検索
(mito:find-dao 'user :id 1)
;-> ;; SELECT * FROM `user` WHERE (`id` = ?) LIMIT 1 (1) [1 row] | MITO.DB:RETRIEVE-BY-SQL
;=> #<USER {10077C6073}>

;; 更新する
(setf (slot-value me 'name) "nitro_idiot")
;=> "nitro_idiot"

(mito:save-dao me)
;-> ;; UPDATE `user` SET `id` = ?, `name` = ?, `email` = ?, `created_at` = ?, `updated_at` = ? WHERE (`id` = ?) (2, "nitro_idiot", "e.arrows@gmail.com", "2016-02-04T19:56:11.408927Z", "2016-02-04T19:56:19.006020Z", 2) [0 rows] | MITO.DAO:UPDATE-DAO

;; 削除する
(mito:delete-dao me)
;-> ;; DELETE FROM `user` WHERE (`id` = ?) (1) [0 rows] | MITO.DAO:DELETE-DAO
(mito:delete-by-values 'user :id 1)
;-> ;; DELETE FROM `user` WHERE (`id` = ?) (1) [0 rows] | MITO.DAO:DELETE-DAO

関係(Relationship)

関係(Relationship)を定義するには、スロットで:referencesを使います:

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (or (:varchar 128) :null)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class))

(defclass tweet ()
  ((status :col-type :text
           :initarg :status
           :accessor tweet-status)
   ;; This slot refers to USER class
   (user-id :references (user id)
            :initarg :user-id
            :accessor tweet-user-id))
  (:metaclass mito:dao-table-class))

;; USER-IDカラムの:col-typeは、外部のクラスから検索されます
(table-definition (find-class 'tweet))
;=> (#<SXQL-STATEMENT: CREATE TABLE tweet (
;        id BIGSERIAL NOT NULL PRIMARY KEY,
;        status TEXT NOT NULL,
;        user_id BIGINT NOT NULL,
;        created_at TIMESTAMP,
;        updated_at TIMESTAMP
;    )>)

関係(Relationship)　を定義するために、:col-typeに別の外部クラスも特定できます。

(defclass tweet ()
  ((status :col-type :text
           :initarg :status
           :accessor tweet-status)
   ;; This slot refers to USER class
   (user :col-type user
         :initarg :user
         :accessor tweet-user))
  (:metaclass mito:dao-table-class))

(table-definition (find-class 'tweet))
;=> (#<SXQL-STATEMENT: CREATE TABLE tweet (
;        id BIGSERIAL NOT NULL PRIMARY KEY,
;        status TEXT NOT NULL,
;        user_id BIGINT NOT NULL,
;        created_at TIMESTAMP,
;        updated_at TIMESTAMP
;    )>)

;; :USER-IDの代わりに、:USER argを明記できます。
(defvar *user* (mito:create-dao 'user :name "Eitaro Fukamachi"))
(mito:create-dao 'tweet :user *user*)

(mito:find-dao 'tweet :user *user*)

例の後者では、USER-IDではなく、USERオブジェクトによって、TWEETを作成したり検索したりできます。

Mitoでは、テーブルを参照するのに外部キー制約を追加しません。その理由は、ORMを使うときに、問題になると確信できないからです。

InflationとDeflation

InflationとDeflationは、MitoとRDBMS間で値を変換する機能です。

(defclass user-report ()
  ((title :col-type (:varchar 100)
          :initarg :title
          :accessor report-title)
   (body :col-type :text
         :initarg :body
         :initform ""
         :accessor report-body)
   (reported-at :col-type :timestamp
                :initarg :reported-at
                :initform (local-time:now)
                :accessor report-reported-at
                :inflate #'local-time:universal-to-timestamp
                :deflate #'local-time:timestamp-to-universal))
  (:metaclass mito:dao-table-class))

Eager loading(事前にデータをロードする)

ORMを使うときの問題点として、N+1問題があります。

;; 悪い例

(use-package '(:mito :sxql))

(defvar *tweets-contain-japan*
  (select-dao 'tweet
    (where (:like :status "%Japan%"))))

;; Getting names of tweeted users.
(mapcar (lambda (tweet)
          (user-name (tweet-user tweet)))
        *tweets-contain-japan*)

この例では、"SELECT * FROM user WHERE id = ?" のように、クエリーを送ってユーザ情報を取得します。

このパフォーマンス上の問題が起きるのを防ぐために、includesをN個のクエリーではなく、単一のクエリを送る上のクエリにおきます。

;; GOOD EXAMPLE with eager loading

(use-package '(:mito :sxql))

(defvar *tweets-contain-japan*
  (select-dao 'tweet
    (includes 'user)
    (where (:like :status "%Japan%"))))
;-> ;; SELECT * FROM `tweet` WHERE (`status` LIKE ?) ("%Japan%") [3 row] | MITO.DB:RETRIEVE-BY-SQL
;-> ;; SELECT * FROM `user` WHERE (`id` IN (?, ?, ?)) (1, 3, 12) [3 row] | MITO.DB:RETRIEVE-BY-SQL
;=> (#<TWEET {1003513EC3}> #<TWEET {1007BABEF3}> #<TWEET {1007BB9D63}>)

;; No additional SQLs will be executed.
(tweet-user (first *))
;=> #<USER {100361E813}>

マイグレーション

(ensure-table-exists 'user)
;-> ;; CREATE TABLE IF NOT EXISTS "user" (
;       "id" BIGSERIAL NOT NULL PRIMARY KEY,
;       "name" VARCHAR(64) NOT NULL,
;       "email" VARCHAR(128),
;       "created_at" TIMESTAMP,
;       "updated_at" TIMESTAMP
;   ) () [0 rows] | MITO.DAO:ENSURE-TABLE-EXISTS

;; 変更がない場合
(mito:migration-expressions 'user)
;=> NIL

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (:varchar 128)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class)
  (:unique-keys email))

(mito:migration-expressions 'user)
;=> (#<SXQL-STATEMENT: ALTER TABLE user ALTER COLUMN email TYPE character varying(128), ALTER COLUMN email SET NOT NULL>
;    #<SXQL-STATEMENT: CREATE UNIQUE INDEX unique_user_email ON user (email)>)

(mito:migrate-table 'user)
;-> ;; ALTER TABLE "user" ALTER COLUMN "email" TYPE character varying(128), ALTER COLUMN "email" SET NOT NULL () [0 rows] | MITO.MIGRATION.TABLE:MIGRATE-TABLE
;   ;; CREATE UNIQUE INDEX "unique_user_email" ON "user" ("email") () [0 rows] | MITO.MIGRATION.TABLE:MIGRATE-TABLE
;-> (#<SXQL-STATEMENT: ALTER TABLE user ALTER COLUMN email TYPE character varying(128), ALTER COLUMN email SET NOT NULL>
;    #<SXQL-STATEMENT: CREATE UNIQUE INDEX unique_user_email ON user (email)>)

スキーマのバージョン管理

$ ros install mito
$ mito
利用法: mito コマンド [オプション...]

コマンド:
    generate-migrations
    migrate

オプション:
    -t, --type DRIVER-TYPE          DBI driver type (one of "mysql", "postgres" or "sqlite3")
    -d, --database DATABASE-NAME    Database name to use
    -u, --username USERNAME         Username for RDBMS
    -p, --password PASSWORD         Password for RDBMS
    -s, --system SYSTEM             ASDF system to load (several -s's allowed)
    -D, --directory DIRECTORY       Directory path to keep migration SQL files (default: "/Users/nitro_idiot/Programs/lib/mito/db/")
    --dry-run                       List SQL expressions to migrate

継承とミックスイン

DAO-CLASSのサブクラスは、継承されることができます。

このことは、似たようなカラムを持つクラスが必要なときに役に立ちます。

(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (:varchar 128)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class)
  (:unique-keys email))

(defclass temporary-user (user)
  ((registered-at :col-type :timestamp
                  :initarg :registered-at
                  :accessor temporary-user-registered-at))
  (:metaclass mito:dao-table-class))

(mito:table-definition 'temporary-user)
;=> (#<SXQL-STATEMENT: CREATE TABLE temporary_user (
;        id BIGSERIAL NOT NULL PRIMARY KEY,
;        name VARCHAR(64) NOT NULL,
;        email VARCHAR(128) NOT NULL,
;        registered_at TIMESTAMP NOT NULL,
;        created_at TIMESTAMP,
;        updated_at TIMESTAMP,
;        UNIQUE (email)
;    )>)

どのデータベースのテーブルにも関連しないテーブルのためにテンプレートが必要な場合は、DAO-TABLE-MIXINを使えます。

(defclass has-email ()
  ((email :col-type (:varchar 128)
          :initarg :email
          :accessor object-email))
  (:metaclass mito:dao-table-mixin)
  (:unique-keys email))
;=> #<MITO.DAO.MIXIN:DAO-TABLE-MIXIN COMMON-LISP-USER::HAS-EMAIL>

(defclass user (has-email)
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name))
  (:metaclass mito:dao-table-class))
;=> #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::USER>

(mito:table-definition 'user)
;=> (#<SXQL-STATEMENT: CREATE TABLE user (
;       id BIGSERIAL NOT NULL PRIMARY KEY,
;       name VARCHAR(64) NOT NULL,
;       email VARCHAR(128) NOT NULL,
;       created_at TIMESTAMP,
;       updated_at TIMESTAMP,
;       UNIQUE (email)
;   )>)

トリガー

insert-dao, update-dao delete-daoは総称関数として定義されているので、:before　:after　:aroundメソッドを定義できます。

(defmethod mito:insert-dao :before ((object user))
  (format t "~&Adding ~S...~%" (user-name object)))

(mito:create-dao 'user :name "Eitaro Fukamachi" :email "e.arrows@gmail.com")
;-> Adding "Eitaro Fukamachi"...
;   ;; INSERT INTO "user" ("name", "email", "created_at", "updated_at") VALUES (?, ?, ?, ?) ("Eitaro Fukamachi", "e.arrows@gmail.com", "2016-02-16 21:13:47", "2016-02-16 21:13:47") [0 rows] | MITO.DAO:INSERT-DAO
;=> #<USER {100835FB33}>

インストール方法

$ mkdir -p ~/common-lisp
$ cd ~/common-lisp
$ git clone https://github.com/fukamachi/mito
$ ros -L ~/common-lisp/mito/mito.asd install mito

(ql:quickload :mito)

参考

CL-DBI
SxQL

作者

Eitaro Fukamachi (e.arrows@gmail.com)

Copyright

License

Licensed under the LLGPL License.

t-cool

Mito, Common Lisp ORM - README 訳