Lisp on Rails 第5回 〜 has-one

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

今回は ActiveRecord の has_one アソシエーションもどきを実装したいと思います。 前回の has_many に瓜二つです。 ar-has-one-direct-slot-definition と ar-has-one-effective-slot-definition を定義します。

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

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

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

(defclass ar-has-one-effective-slot-definition (ar-effective-slot-definition
                                                ar-has-one-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-one-effective-slot-definition))
  (aif (call-next-method)
       it
       (setf (slot-value instance (has-one slot-def))
             (car (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-one-effective-slot-definition))
   (when new-value
     (setf (%value-of new-value (str (class-name class) "-id"))
           (%value-of instance :id))))

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

(def-record post
  (:has-many comments)
  (:has-one post-info))
(def-record post-info
  (:belongs-to post))
(let* ((post (car (all post)))
       (post-info (post-info-of post)))
  (describe post-info))

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

第6回につづきます。

すみません。 次回はコピペじゃないように頑張ります。