From 8f705ceaad5ed3ede6414831e37e3dcb648985dc Mon Sep 17 00:00:00 2001
From: Daniel Nussenbaum <daninus14@gmail.com>
Date: Sat, 2 Nov 2024 19:57:08 +0200
Subject: [PATCH] dao-table-class effective slot definitions now working,
 similar approach 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
---
 src/core/dao/column.lisp | 19 ++++++++++++++++---
 src/core/dao/mixin.lisp  |  5 +++++
 src/core/dao/table.lisp  | 10 ++++++++++
 src/core/dao/view.lisp   |  5 +++++
 4 files changed, 36 insertions(+), 3 deletions(-)

diff --git a/src/core/dao/column.lisp b/src/core/dao/column.lisp
index 8710525..ed71a2f 100644
--- a/src/core/dao/column.lisp
+++ b/src/core/dao/column.lisp
@@ -3,12 +3,14 @@
   (: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))
@@ -16,19 +18,30 @@
 
 (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
index c07bb10..67e442d 100644
--- 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
index 6bda2da..4d3aa7c 100644
--- 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
index 2d82058..77473e0 100644
--- 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