How do you create and use many-to-many relationships? (with working example)

[vindarel]

How do you create and use many-to-many relationships?

I find them a bit finicky so any experience sharing will be appreciated.

At first, I had issues defining the intermediate table that references two tables, because the second one was not yet defined.
This doesn't always happen…

Then, getting the data of our many-to-many relationships is not automatic. We need to query the intermediate table with a helper function. Something more automatic or built-in would be nice.

For my example below, note that I always defined my own accessors, because I think Mito is supposed to create default accessors for the relations but they don't always work.

(defparameter *db-name* "scratch.db")

(defvar *db* nil)

;;;
;;; Create tables.
;;;

(defclass tag ()
  ((name
    :initarg :name
    :accessor name
    :initform nil
    :col-type (or :null (:varchar 128))))
  (:metaclass mito:dao-table-class)
  (:unique-keys name))

(defmethod print-object ((obj tag) stream)
  (print-unreadable-object (obj stream :type t)
    (with-slots (name) obj
      (format stream "~a" name))))

;; the many to many table:
(defclass book-tags ()
  ((book :initarg :book
         :accessor book
         :col-type book)
   (tag :initarg :tag
        :accessor tag
        :col-type tag))
  (:metaclass mito:dao-table-class))

(defclass book ()
  ((title
    :accessor title
    :initarg :title
    :initform nil
    :col-type (:varchar 128))

  ;; Do we even need this slot at all?
  ;; note that we can't have a slot without a col-type.
   (tags
    :initarg :tags
    :accessor tags
    :initform nil
    :col-type (or :null book-tags)
    :documentation "A book can have many tags, aka categories.")

  )
  (:metaclass mito:dao-table-class)
  (:documentation   "A book with many tags"))

(defmethod print-object ((obj book) stream)
  (print-unreadable-object (obj stream :type t)
    (format stream "~a" (mito:object-id obj))))

;;;
;;; Connect to the DB, migrate tables.
;;; 

(setf *db* (mito:connect-toplevel :sqlite3 :database-name *db-name*))

(mapcar #'mito:ensure-table-exists '(tag book-tags book))
(mapcar #'mito:migrate-table '(tag book-tags book))


;;;
;;; Create records.
;;;

(mito:create-dao 'tag :name "tag1")
(mito:create-dao 'tag :name "tag2")

(mito:create-dao 'book :title "lisp book")

(mito:create-dao 'book-tags :book (mito:find-dao 'book) :tag (mito:find-dao 'tag))
(mito:create-dao 'book-tags :book (mito:find-dao 'book) :tag (mito:find-dao 'tag :id 2))

;; so far we didn't link the book and its tags, they are in the intermediate table.

(mito:find-dao 'book)
;; #<BOOK {1007D240D3}>

;; Accessing the tags with our accessor on the book doesn't get anything:
(describe (mito:find-dao 'book))
;; => TAGS is unbound,
(tags (mito:find-dao 'book))
;; => NIL

;; We need an helper function to get the tags:
(defun find-book-with-tags (&rest query)
  (let ((book (apply #'mito:find-dao (cons 'book query))))
    (when book
      (setf (tags book)
            (mito:select-dao 'book-tags
              (sxql:where (:= :book-id
                              (mito:object-id book)))))
      book)))

(find-book-with-tags :id 1)
;; #<BOOK 1>

(tags *)
;; (#<BOOK-TAGS {1005699463}> #<BOOK-TAGS {100569B073}>)

;; and these are the intermediate tables,
;; not the tags proper.

(mapcar #'tag *)
;; (#<TAG tag1> #<TAG tag2>)

[daninus14]

Hi, I meant to tell you defining is not an issue, see the repo, I justed pushed an example but here it is anyways for others to benefit

(ql:quickload "mito")
(setf mito:*auto-migration-mode* T)
(mito:connect-toplevel :sqlite3
                       :database-name ":memory:")

(defclass user ()
  ((name :col-type (or :null :text)))
  (:metaclass mito:dao-table-class))

(mito:ensure-table-exists 'user)

(defclass book ()
  ((name :col-type (or :null :text)))
  (:metaclass mito:dao-table-class))

(defclass user-book ()
  ((user :col-type (or :null user))
   (book :col-type (or :null book)))
  (:metaclass mito:dao-table-class))

(mito:ensure-table-exists 'book)
(mito:ensure-table-exists 'user-book)


(defvar *robert* (mito:insert-dao (make-instance 'user :name "robert ludlum")))
(defvar *supremacy* (mito:insert-dao (make-instance 'book :name "bourne supremacy")))
(defvar *ultimatum* (mito:insert-dao (make-instance 'book :name "bourne ultimatum")))
(defvar *r-s* (mito:insert-dao (make-instance 'user-book :user *robert* :book *supremacy*)))
(defvar *r-u* (mito:insert-dao (make-instance 'user-book :user *robert* :book *ultimatum*)))

and here's the output in the REPL with a many-to-one relationship. Mito doesn't support multiple joins though see here #128

CL-USER> *robert*
#<USER {10064D0D43}>
CL-USER> (inspect *)

The object is a STANDARD-OBJECT of type USER.
0. CREATED-AT: @2024-11-05T01:13:14.968071+02:00
1. UPDATED-AT: @2024-11-05T01:13:14.968071+02:00
2. SYNCED: T
3. ID: 1
4. NAME: "robert ludlum"
> q
; No values
CL-USER> *r-u*
#<USER-BOOK {10063B60D3}>
CL-USER> (inspect *)

The object is a STANDARD-OBJECT of type USER-BOOK.
0. CREATED-AT: @2024-11-05T01:13:55.738294+02:00
1. UPDATED-AT: @2024-11-05T01:13:55.738294+02:00
2. SYNCED: T
3. ID: 2
4. USER: #<USER {1008328003}>
5. USER-ID: #<unbound slot>
6. BOOK: #<BOOK {100833E623}>
7. BOOK-ID: #<unbound slot>
> q
; No values
CL-USER> (mito:select-dao 'user (includes 'user-book))
; in: MITO.DAO:SELECT-DAO 'USER
;     (INCLUDES 'USER-BOOK)
; 
; caught STYLE-WARNING:
;   undefined function: COMMON-LISP-USER::INCLUDES
; 
; compilation unit finished
;   Undefined function:
;     INCLUDES
;   caught 1 STYLE-WARNING condition
; Debugger entered on #<UNDEFINED-FUNCTION INCLUDES {100556E883}>
[1] CL-USER> 
; Evaluation aborted on #<UNDEFINED-FUNCTION INCLUDES {100556E883}>
CL-USER> (mito:select-dao 'user (mito:includes 'user-book))
; Debugger entered on #<SIMPLE-ERROR "~S is not related to ~S" {1007070463}>
[1] CL-USER> 
; Evaluation aborted on #<SIMPLE-ERROR "~S is not related to ~S" {1007070463}>
CL-USER> (mito:select-dao 'user-book (mito:includes 'user))
(#<USER-BOOK {100795B973}> #<USER-BOOK {100795BDA3}>)
#<SXQL-STATEMENT: SELECT * FROM user_book>
CL-USER> 

[daninus14]

The accessors are also created as part of the deftable macro, not the using defclass with a metaclass. I think it's in the docs

[daninus14]

The includes or multiple joins would be nice... I actually made a project around this because it's so important for me, but it's not possible to do a PR at the moment, it's too large of a project, thousands of lines with a much wider scope, so it's hard to only take that part out

[vindarel]

thanks that's helpful.

[mooseyboots]

auto accessors are mentioned in the readme, yeah: https://github.com/fukamachi/mito?tab=readme-ov-file#deftable-macro.

"It adds :metaclass mito:dao-table-class, and adds default accessors that start with - by default, like defstruct does.
...
The prefix for accessors can be changed with the :conc-name class option:"

[vindarel]

Also, we can override the tags method on a book:

(defmethod tags (obj)
  ;; null case
  nil)

(defmethod tags ((obj book))
  (let ((book-tags
            (mito:select-dao 'book-tags
                (sxql:where (:= :book-id
                                (mito:object-id obj))))))
    (when book-tags
     (mapcar #'tag book-tags))))

(tags (mito:find-dao 'book))
;; => (#<TAG tag1> #<TAG tag2>)

(tags (mito:find-dao 'book :id 2))
;; NIL

So how could we tell Mito to do that automatically?