(defpackage :webutils.relations (:use :cl :webutils.simple-serialized-classes)
            (:export :define-object-relations))
(in-package :webutils.relations)
(webutils::export-all :webutils.relations)

;; Define a relation between objects. one-to-one and one-to-many
;; relations are supported, but many-to-many relations are not.

(defmacro define-object-relations
    (from-class &body relations)
  (let (registered-actions deleted-actions)
    `(progn
      ,@(loop for relation in relations
              appending
              (destructuring-bind (from-accessor to-accessor &key (type :one-to-one))
                  relation
                (push
                 `(let ((value (funcall #',from-accessor a)))
                    (when value
                      ,(ecase type
                              (:one-to-one
                               `(funcall #'(setf ,to-accessor) a value))
                              (:one-to-many
                               `(funcall #'(setf ,to-accessor)
                                         (cons a (funcall #',to-accessor value))
                                         value)))
                      (when (typep value 'webutils.simple-serialized-classes:simple-serialized-class)
                          (serialize-instance value)))) registered-actions)
                (push
                 `(let ((value (funcall #',from-accessor a)))
                    (when value
                      ,(ecase type
                              (:one-to-one
                               `(funcall #'(setf ,to-accessor) nil value))
                              (:one-to-many
                               `(funcall #'(setf ,to-accessor)
                                         (remove a (funcall #',to-accessor value))
                                         value)))
                      (when (typep value 'webutils.simple-serialized-classes:simple-serialized-class)
                          (serialize-instance value)))) deleted-actions)
                `((defmethod (setf ,from-accessor) :before (b (a ,from-class))
                    (declare (ignore b))
                    (let ((old-value (funcall #',from-accessor a)))
                      (when old-value
                        ,(ecase type
                                (:one-to-one
                                 `(funcall #'(setf ,to-accessor) nil old-value))
                                (:one-to-many
                                 `(funcall #'(setf ,to-accessor)
                                           (remove a (funcall #',to-accessor old-value))
                                   old-value)))
                        (when (typep old-value 'webutils.simple-serialized-classes:simple-serialized-class)
                          (serialize-instance old-value)))))
                  (defmethod (setf ,from-accessor) :after (new-value (a ,from-class))
                    (when new-value
                      ,(ecase type
                              (:one-to-one
                               `(funcall #'(setf ,to-accessor) a new-value))
                              (:one-to-many
                               `(funcall #'(setf ,to-accessor)
                                         (cons a (funcall #',to-accessor new-value))
                                 new-value)))
                      (when (typep new-value 'webutils.simple-serialized-classes:simple-serialized-class)
                          (serialize-instance new-value)))))))
      (defmethod note-registered-instance ((a ,from-class))
        ,@registered-actions)
      (defmethod note-deleted-instance ((a ,from-class))
        ,@deleted-actions))))