dao-table-class effective slot definitions now working, similar appro…

…ach taken to dao-table-view and dao-table-mixin. The actual definitions are in dao-table-column, named dao-table-column-standard-effective-slot-definitions
fukamachi · Nov 2, 2024 · 8f705ce · 8f705ce
1 parent 9c8e70e
commit 8f705ce
Show file tree

Hide file tree

Showing 4 changed files with 36 additions and 3 deletions.
diff --git a/src/core/dao/column.lisp b/src/core/dao/column.lisp
@@ -3,32 +3,45 @@
   (:use #:cl
         #:mito.util)
   (:import-from #:mito.class.column
+                #:column-standard-effective-slot-definitions
                 #:table-column-class
                 #:table-column-type)
   (:import-from #:local-time)
   (:import-from #:cl-ppcre)
   (:export #:dao-table-column-class
            #:dao-table-column-inflate
+           #:dao-table-column-standard-effective-slot-definitions
            #:dao-table-column-deflate
            #:inflate-for-col-type
            #:deflate-for-col-type))
 (in-package :mito.dao.column)
 
 (defparameter *conc-name* nil)
 
-(defclass dao-table-column-class (table-column-class)
+(defclass dao-table-column-slot-definitions ()
   ((inflate :type (or function null)
             :initarg :inflate)
    (deflate :type (or function null)
             :initarg :deflate)))
 
+(defclass dao-table-column-class (dao-table-column-slot-definitions table-column-class)
+  ())
+
+(defclass dao-table-column-standard-effective-slot-definitions
+    (dao-table-column-slot-definitions
+     ;; maybe here should be the table-column-class effective slot alternative?
+     column-standard-effective-slot-definitions
+     ;; c2mop:standard-effective-slot-definition
+     )
+  ())
+
 (defmethod initialize-instance :around ((object dao-table-column-class) &rest rest-initargs
                                         &key name readers writers inflate deflate
                                         &allow-other-keys)
   (when *conc-name*
     (let ((accessor (intern
-                      (format nil "~:@(~A~A~)" *conc-name* name)
-                      *package*)))
+                     (format nil "~:@(~A~A~)" *conc-name* name)
+                     *package*)))
       (unless readers
         (pushnew accessor readers)
         (setf (getf rest-initargs :readers) readers))

diff --git a/src/core/dao/mixin.lisp b/src/core/dao/mixin.lisp
@@ -15,6 +15,7 @@
                 #:table-column-name
                 #:table-column-references-column)
   (:import-from #:mito.dao.column
+                #:dao-table-column-standard-effective-slot-definitions
                 #:dao-table-column-class
                 #:dao-table-column-inflate
                 #:*conc-name*)
@@ -46,6 +47,10 @@
 (defmethod c2mop:direct-slot-definition-class ((class dao-table-mixin) &key)
   'dao-table-column-class)
 
+(defmethod c2mop:effective-slot-definition-class ((class dao-table-mixin) &rest initargs)
+  (declare (ignorable initargs))
+  (find-class 'mito.dao.column:dao-table-column-standard-effective-slot-definitions))
+
 (defgeneric make-dao-instance (class &rest initargs)
   (:method ((class-name symbol) &rest initargs)
     (apply #'make-dao-instance

diff --git a/src/core/dao/table.lisp b/src/core/dao/table.lisp
@@ -15,6 +15,7 @@
                 #:create-table-sxql)
   (:import-from #:mito.dao.column
                 #:dao-table-column-class
+                #:dao-table-column-standard-effective-slot-definitions
                 #:dao-table-column-inflate)
   (:import-from #:mito.dao.mixin
                 #:dao-table-mixin
@@ -36,6 +37,15 @@
 (defmethod c2mop:direct-slot-definition-class ((class dao-table-class) &key)
   'dao-table-column-class)
 
+(defmethod c2mop:effective-slot-definition-class ((class dao-table-class) &rest initargs)
+  (declare (ignorable initargs))
+  (find-class 'dao-table-column-standard-effective-slot-definitions)
+  ;; 'dao-table-column-class
+  )
+
+(defmethod c2mop:validate-superclass ((class dao-table-class) (super standard-class))
+  t)
+
 (defun initargs-enables-auto-pk (initargs)
   (first (or (getf initargs :auto-pk) '(:serial))))
 

diff --git a/src/core/dao/view.lisp b/src/core/dao/view.lisp
@@ -5,6 +5,7 @@
                 #:table-class
                 #:table-name)
   (:import-from #:mito.dao.column
+                #:dao-table-column-standard-effective-slot-definitions
                 #:dao-table-column-class)
   (:import-from #:sxql)
   (:export #:dao-table-view
@@ -20,6 +21,10 @@
 (defmethod c2mop:direct-slot-definition-class ((class dao-table-view) &key)
   'dao-table-column-class)
 
+(defmethod c2mop:effective-slot-definition-class ((class dao-table-view) &rest initargs)
+  (declare (ignorable initargs))
+  (find-class 'mito.dao.column:dao-table-column-standard-effective-slot-definitions))
+
 (defstruct (create-view (:include sxql.sql-type:sql-statement (sxql.sql-type:name "CREATE VIEW"))
                         (:constructor make-create-view (view-name &key or-replace as)))
   view-name