I'm trying to define a new slot definition called :has-many
and the same time use the definitions provided by mito's metaclass mito:dao-table-class
. https://github.com/fukamachi/mito?tab=readme-ov-file#deftable-macro
For some reason, when I add the metaclass I created on a normal object, the slot definition for has-many
shows up as expected:
(defclass sample-class ()
((hello :has-many T))
(:metaclass oql-metaclass))
(inspect (closer-mop:class-direct-slots (find-class 'sample-class)))
Here's the slot definition code:
(defclass has-many-meta-class (closer-mop:standard-class) ())
(defclass has-many-standard-direct-slot-definition (c2mop:standard-direct-slot-definition)
((has-many :initform nil
:initarg :has-many
:accessor has-many-slot-value)))
(defclass has-many-standard-effective-slot-definition (closer-mop:standard-effective-slot-definition)
((has-many :initform nil
:initarg :has-many
:accessor has-many-slot-value)))
(closer-mop:defmethod direct-slot-definition-class ((class has-many-meta-class)
&rest initargs)
(find-class 'has-many-standard-direct-slot-definition))
(closer-mop:defmethod effective-slot-definition-class ((class has-many-meta-class)
&rest initargs)
(find-class 'has-many-standard-effective-slot-definition))
(closer-mop:defmethod validate-superclass ((class has-many-meta-class)
(superclass closer-mop:standard-class))
t)
;; (defclass oql-metaclass (mito:dao-table-class
;; has-many-meta-class)
;; ())
(defclass oql-metaclass (has-many-meta-class mito:dao-table-class)
())
However, when doing:
(defclass new-model ()
((author :has-many T :col-type :null))
(:metaclass oql-metaclass))
The class will either not compile if oql-metaclass
has the inheritance to be has-many-meta-class
first, saying that :col-type
is causing a problem, or if using (the commented out) order of mito's metaclass first in the inheritance list, the code compiles, but upon evaluating the class slots :has-many
is not there.
Why is this? How can I work with both of them?
Note I used these answers to get this far:
Thanks to @beach for the guidance to this answer.
The problem is that direct-slot-definition-class
is not specialized for oql-metaclass
. What happens then is that since oql-metaclass
inherits from two other classes, the CLOS will find the method that matches the most specialized super class of oql-metaclass
. That is why changing the order of the super classes affects the condition raised by the compiler.
The solution is then to further specialize the direct-slot-definition-class
method for oql-metaclass
to return the correct slot definitions we want. Then we realize that we need a new class for those definitions.
(defclass oql-standard-direct-slot-definition
(mito.dao.column:dao-table-column-class
has-many-standard-direct-slot-definition)
())
Notice that we are here extending mito.dao.column:dao-table-column-class
which is not the same class as the metaclass used for mito classes. That is because this is the direct slot definition class. I had to check the source code for mito to find it.
Here is the new specialized method for direct slot definitions:
(defmethod closer-mop:direct-slot-definition-class ((class oql-metaclass)
&rest initargs)
(find-class 'oql-standard-direct-slot-definition))
And now we can test it with
(defclass oql-class-2 ()
((a :ghost T :has-many T))
(:metaclass oql-metaclass))
(inspect (find-class 'oql-class-2))
(inspect (closer-mop:class-direct-slots (find-class 'oql-class-2)))
In the inspector you should be able to see:
CL-USER> (closer-mop:class-direct-slots (find-class 'oql-class-2))
(#<OQL-STANDARD-DIRECT-SLOT-DEFINITION COMMON-LISP-USER::A>)
CL-USER> (inspect (closer-mop:class-direct-slots (find-class 'oql-class-2)))
The object is a CONS.
0. CAR: #<OQL-STANDARD-DIRECT-SLOT-DEFINITION COMMON-LISP-USER::A>
1. CDR: NIL
> 0
The object is a STANDARD-OBJECT of type OQL-STANDARD-DIRECT-SLOT-DEFINITION.
0. SOURCE: #S(SB-C:DEFINITION-SOURCE-LOCATION :NAMESTRING NIL :INDICES 0)
1. NAME: A
2. INITFORM: NIL
3. INITFUNCTION: NIL
4. INITARGS: (:A)
5. %TYPE: T
6. %DOCUMENTATION: NIL
7. %CLASS: #<OQL-METACLASS COMMON-LISP-USER::OQL-CLASS-2>
8. READERS: NIL
9. WRITERS: NIL
10. ALLOCATION: :INSTANCE
11. ALLOCATION-CLASS: NIL
12. HAS-MANY: T
13. COL-TYPE: NIL
14. REFERENCES: NIL
15. PRIMARY-KEY: NIL
16. GHOST: T
17. INFLATE: #<unbound slot>
18. DEFLATE: #<unbound slot>
Which has both has-many
and col-type
.
I will further suggest, which is what I'm doing, to have the metaclass be a subclass of the mito metaclass in case there are other consequences of using that metaclass.
(defclass oql-metaclass (mito:dao-table-class)
())