Lisp on Rails 第4回 〜 has-many

こんにちは!! tahara です。 Lisp on Rails 第4回です!

今回は ActiveRecord の has_many アソシエーションもどきを実装したいと思います。 前回の belongs_to とほとんど同じです。 ar-has-many-direct-slot-definition と ar-has-many-effective-slot-definition を定義します。

(defclass ar-has-many-slot-mixin ()
  ((has-many :initarg :has-many
             :initform nil
             :accessor has-many)
   (class-symbol :initarg :class-symbol
                 :initform nil
                 :accessor class-symbol)))

(defmethod initialize-instance :after ((self ar-has-many-slot-mixin) &rest args)
  (declare (ignore args))
  (unless (class-symbol self)
    (setf (class-symbol self)
          (sym (singularize (has-many self))))))

(defclass ar-has-many-direct-slot-definition (ar-direct-slot-definition
                                              ar-has-many-slot-mixin)
  ())

(defclass ar-has-many-effective-slot-definition (ar-effective-slot-definition
                                                 ar-has-many-slot-mixin)
  ())

direct-slot-definition-class と effective-slot-definition-class と compute-effective-slot-definition でゴニョゴニョすると上記の slot-definition が使えるようになります。

slot-value-using-class と (setf slot-value-using-class) で関連テーブルの 取得と設定を行います。

(defmethod c2mop:slot-value-using-class
  ((class active-record-class)
   instance
   (slot-def ar-has-many-effective-slot-definition))
  (aif (call-next-method)
       it
       (setf (slot-value instance (has-many slot-def))
             (all (find-class (class-symbol slot-def))
                  :conditons (list (key-sym (class-name class) '-id)
                                   (%value-of instance :id))))))

(defmethod (setf c2mop:slot-value-using-class) :after
           (new-value
            (class active-record-class)
            instance
            (slot-def ar-has-many-effective-slot-definition))
  (loop with id = (%value-of instance :id)
        with column = (str (class-name class) "-id")
        for x in new-value
        do (setf (%value-of x column) id)))

で、だいたいこんな感じで使えるようになります。

(def-record comment
    (:belongs-to post))
(def-record post
    (:has-many comments))
(let* ((post (car (all post)))
       (comments (comments-of post)))
  (mapc #'describe comments))

以上、なんとなく has-many できました。 ソースはこちらから http://github.com/quek/lisp-on-rails

第5回につづきます