Code Monkey home page Code Monkey logo

mito's Issues

feature request: mito:delete-dao by primary key value

In order to delete an object now I (think I) have to do mito:find-dao followed by mito:delete-dao. It seems like this could be made simpler by a method specialized on t that would get called if the method specialized on dao-class did not fire.

Test migration/sqlite3 fails

There may be a broken test with sqlite3.

Running a test file '/tmp/guix-build-sbcl-mito-0.1-1.d3b9e37.drv-0/source/t/migration/sqlite3.lisp'
While evaluating the form starting at line 16, column 0
  of #P"/tmp/guix-build-sbcl-mito-0.1-1.d3b9e37.drv-0/source/t/migration/sqlite3.lisp":
Unhandled DBI.ERROR:<DBI-DATABASE-ERROR> in thread #<SB-THREAD:THREAD "main thread" RUNNING
                                                      {10009F8083}>:
  DB Error: column index out of range (Code: RANGE)

Note that I've removed the "dao" component because I can't test mysql / postgresql in the context of packaging this for Guix.

`:deflate` slot option not being called when defining a relationship

When a column in table A references a row in table B, and when the primary key slot of B has a :deflate function, that function doesn't get called. In the example below, this causes SXQL to choke on a pathname when trying to insert an instance of the user class. Changing it from a pathname to a string and removing the :inflate and :deflate options in file fixes the problem, however it seems to me that those functions should be called transparently.

(require 'mito)

(defclass file ()
  ((path :initarg :path :col-type :text :primary-key t
         :inflate #'pathname :deflate #'namestring)
   (desc :initarg :desc :col-type :text))
  (:metaclass mito:dao-table-class)
  (:unique-keys path)
  (:conc-name file-)
  (:documentation "Record a list of files and their descriptions."))

(defclass user ()
  ((name :initarg :name :col-type :text :primary-key t)
   (file :initarg :file :col-type file))
  (:metaclass mito:dao-table-class)
  (:conc-name user-)
  (:documentation "Record which users own which files."))

(defvar f (make-instance 'file :path #P"/tmp/mito_bug.txt" :desc "some file"))
(defvar u (make-instance 'user :name "Eva Lu Ator" :file f))

(mito:connect-toplevel :sqlite3 :database-name #P"/tmp/mito_bug.db")
(mapcar #'mito:ensure-table-exists '(file user))
;; CREATE TABLE "file" (
;;     "path" TEXT NOT NULL PRIMARY KEY,
;;     "desc" TEXT NOT NULL,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP,
;;     UNIQUE ("path")
;; ) () [0 rows] | (MITO.DAO:ENSURE-TABLE-EXISTS 'FILE)
;; CREATE TABLE "file" (
;;     "path" TEXT NOT NULL PRIMARY KEY,
;;     "desc" TEXT NOT NULL,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP,
;;     UNIQUE ("path")
;; ) () [0 rows] | (MITO.DAO:ENSURE-TABLE-EXISTS 'FILE)
;; CREATE TABLE "user" (
;;     "name" TEXT NOT NULL PRIMARY KEY,
;;     "file_path" TEXT NOT NULL,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP
;; ) () [0 rows] | (MITO.DAO:ENSURE-TABLE-EXISTS 'USER)
;; CREATE TABLE "user" (
;;     "name" TEXT NOT NULL PRIMARY KEY,
;;     "file_path" TEXT NOT NULL,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP
;; ) () [0 rows] | (MITO.DAO:ENSURE-TABLE-EXISTS 'USER)

(mito:insert-dao f)
(mito:insert-dao u)
;; There is no applicable method for the generic function
;;   #<STANDARD-GENERIC-FUNCTION SXQL.OPERATOR:CONVERT-FOR-SQL (9)>
;; when called with arguments
;;   (#P"/tmp/mito_bug.txt").
;;    [Condition of type SB-PCL::NO-APPLICABLE-METHOD-ERROR]

DB Error: database table is locked (Code: LOCKED) in sqlite3 when running generate-migrations

I'm trying to use Mito with SQLite3 database, but encounter the problem. I unable to generate migrations when there is a table in the database.

I receive DB Error: database table is locked (Code: LOCKED) error when trying to generate migration. This is not issue of the command line utility, it can be reproduced in the REPL as well.

I've created a test system and instruction how to reproduce the bug:

https://github.com/svetlyak40wt/mito-migrations

Tested under CCL, SBCL both on OSX and Ubuntu.

get_column_real_type does not exist warning

When launching my app that uses mito these days, I seem to get the following warning:

WARNING:
PostgreSQL warning: table "get_column_real_type" does not exist, skipping

I can dig up more details, but I thought I'd check to see if this was a known issue first.

not valid mysql create table sql

CL-USER> (mito:connect-toplevel :mysql :database-name "v****" :username "****" :password "********")
#<DBD.MYSQL: {1007644EA3}>
CL-USER> (mito:deftable user() ((name :col-type (:varchar 64)) (email :col-type (or (:varchar 128) :null))))
#<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::USER>
CL-USER> (mito:table-definition 'user)
(#<SXQL-STATEMENT: CREATE TABLE user (
id BIGINT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
name VARCHAR(64) NOT NULL,
email VARCHAR(128),
created_at TIMESTAMP,
updated_at TIMESTAMP
)>)
CL-USER> (mapc #'mito:execute-sql (mito:table-definition 'user))
; Debugger entered on #<DBI.ERROR: {1005254273}>
[1] CL-USER>
DB Error: Invalid default value for 'updated_at' (Code: 1067)
[Condition of type DBI.ERROR:]

Restarts:
0: [RETRY] Retry SLY mREPL evaluation request.
1: [*ABORT] Return to SLY's top level.
2: [ABORT] abort thread (#<THREAD "sly-channel-1-mrepl-remote-1" RUNNING {1002773FF3}>)

Backtrace:
0: ((:METHOD DBI.DRIVER:EXECUTE-USING-CONNECTION (DBD.MYSQL: DBD.MYSQL: T)) #<DBD.MYSQL: {1001897A23}> #<DBD.MYSQL: {10052530..
1: ((:METHOD DBI.DRIVER:DO-SQL (DBI.DRIVER: STRING)) # # # #) [fast-method,more]
2: ((:METHOD MITO.DB:EXECUTE-SQL (SXQL.SQL-TYPE:SQL-STATEMENT)) #<SXQL-STATEMENT: CREATE TABLE user ( ..) [fast-method]
3: ((SB-PCL::EMF MITO.DB:EXECUTE-SQL) # # #<SXQL-STATEMENT: CREATE TABLE user ( ..)
4: (SB-IMPL::MAP1 #<STANDARD-GENERIC-FUNCTION MITO.DB:EXECUTE-SQL (3)> (NIL) NIL T)
5: (MAPC #<STANDARD-GENERIC-FUNCTION MITO.DB:EXECUTE-SQL (3)> (#<SXQL-STATEMENT: CREATE TABLE user ( ..)
6: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MAPC (FUNCTION MITO.DB:EXECUTE-SQL) (MITO.DAO.VIEW:TABLE-DEFINITION (QUOTE USER))) #)
7: (EVAL (MAPC (FUNCTION MITO.DB:EXECUTE-SQL) (MITO.DAO.VIEW:TABLE-DEFINITION (QUOTE USER))))
8: ((LAMBDA NIL :IN SLYNK-MREPL::MREPL-EVAL-1))
--more--

Feature: migration, not null constraint failed: provide default?

Hi,

Say I add a field to my model:

(due-date
    :col-type :timestamp
    :initform (local-time:timestamp+ (local-time:now) 60 :days)
    :accessor due-date)

When I run Mito's migrations, I get

Error while resetting an sqlite statement.
Code CONSTRAINT: NOT NULL constraint failed: contact_copies.due_date.
Database: /home/vince/projets/openbookstore/openbookstore/db.db
SQL: INSERT INTO "contact_copies" ("book_id", "contact_id", "created_at", "id", "max_time", "quantity", "updated_at") SELECT "book_id", "contact_id", "created_at", "id", "max_time", "quantity", "updated_at" FROM "contact_copies1414"

Solution 1: I could change the col type and make it be (or :null :timestamp).

Wouldn't it be nice if we had a restart that asked for a default, or maybe even use the initform as a default?

col-type on references does not recognize the slots in the parents

Minimal failure case:

(ql:quickload '(:mito) :silent t)

(defpackage :ros.script.plot
  (:use :cl :mito :sxql :dbi))

(in-package :ros.script.plot)

(setf *auto-migration-mode* t)

(defun my-connect (&optional (name "test.sqlite"))
  (declare (ignorable name))
  (connect-toplevel :sqlite3 :database-name name))
(defun reset (&optional (name "test.sqlite"))
  (ignore-errors (disconnect-toplevel))
  (delete-file name))

(reset)
(my-connect)
(defclass user () ()
  (:metaclass mito:dao-table-class))

;; CREATE TABLE "user" (
;;     "id" INTEGER PRIMARY KEY AUTOINCREMENT,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP
;; ) () [0 rows] | EXECUTE-SQL

(defclass tweet ()
  ((user :col-type user
         :initarg :user
         :accessor tweet-user))
  (:metaclass mito:dao-table-class))

;; CREATE TABLE "tweet" (
;;     "id" INTEGER PRIMARY KEY AUTOINCREMENT,
;;     "user_id" INTEGER NOT NULL,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP
;; ) () [0 rows] | EXECUTE-SQL

(defparameter me
              (mito.logger:with-sql-logging
                (create-dao 'user)))
;; INSERT INTO "user" ("created_at", "updated_at") VALUES (?, ?) ("2016-07-01 20:21:12", "2016-07-01 20:21:12") [0 rows] | INSERT-DAO

(defparameter tw
              (mito.logger:with-sql-logging
                (mito:create-dao 'tweet :user me)))
;; INSERT INTO "tweet" ("user_id", "created_at", "updated_at") VALUES (?, ?, ?) (1, "2016-07-01 20:21:31", "2016-07-01 20:21:31") [0 rows] | INSERT-DAO

(defclass tweet2 (tweet)
  ()
  (:metaclass mito:dao-table-class))
;; CREATE TABLE "tweet2" (
;;     "id" INTEGER PRIMARY KEY AUTOINCREMENT,
;;     "user_id" INTEGER NOT NULL,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP
;; ) () [0 rows] | EXECUTE-SQL

(defparameter tw2
              (mito.logger:with-sql-logging
                (mito:create-dao 'tweet2 :user me)))
;; INSERT INTO "tweet2" ("created_at", "updated_at") VALUES (?, ?) ("2016-07-01 20:10:58", "2016-07-01 20:10:58") [0 rows] | INSERT-DAO
                         ^^^^^^^^^^^^^^^^^^^^^^^^^^-- user_id is not recognized
;; --> DB Error: NOT NULL constraint failed: tweet2.user_id (Code: CONSTRAINT)

As for the test, I also checked if the inheritance itself is harmful, or the direct slots matters.

(defclass tweet3 ()
  ()
  (:metaclass mito:dao-table-class))
;;  CREATE TABLE "tweet3" (
;;     "id" INTEGER PRIMARY KEY AUTOINCREMENT,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP
;; ) () [0 rows] | EXECUTE-SQL

(defclass tweet4 (tweet3)
  ((user :col-type user
         :initarg :user
         :accessor tweet-user))
  (:metaclass mito:dao-table-class))
;;  CREATE TABLE "tweet4" (
;;     "id" INTEGER PRIMARY KEY AUTOINCREMENT,
;;     "user_id" INTEGER NOT NULL,
;;     "created_at" TIMESTAMP,
;;     "updated_at" TIMESTAMP
;; ) () [0 rows] | EXECUTE-SQL

(defparameter tw4
              (mito.logger:with-sql-logging
                (mito:create-dao 'tweet4 :user me)))
;;  INSERT INTO "tweet4" ("user_id", "created_at", "updated_at") VALUES (?, ?, ?) (1, "2016-07-01 20:25:00", "2016-07-01 20:25:00") [0 rows] | INSERT-DAO
;;                        ^^^^^^^^^---recognized

Therefore, the reason is not the inheritance itself, but the position of the slots.

Machine: Linux 3.19.0-64-generic
Lisp: SBCL 1.3.5
ASDF: 3.1.7
Quicklisp: 2016-04-21 (update available)

The accessor created by deftable cannot access dao.

$ createdb mito-example
(ql:quickload :mito)

(mito:deftable parent ()
  ())

(mito:deftable child ()
  ((parent :col-type parent)))

(mito:connect-toplevel :postgres :database-name "mito-example")

(mapc #'mito:execute-sql (mapcan #'mito:table-definition '(parent child)))

(mito:create-dao 'child :parent (mito:create-dao 'parent))

(child-parent (mito:find-dao 'child)) ;; The slot PARENT is unbound in the object

;; Specify the accessor explicitly
(mito:deftable child ()
  ((parent :col-type parent :accessor child-parent)))

(child-parent (mito:find-dao 'child)) ;; => #<PARENT {1005BD41D3}>

Self referencing col-type

Any posibility to make something like this work?

(defclass category ()
  ((parent :col-type category
	   :initarg :parent
	   :accessor parent))
  (:metaclass mito:dao-table-class))

"#<STANDARD-CLASS MITO.DAO.TABLE:DAO-CLASS> has no slot named MITO.CLASS.TABLE::PARENT-COLUMN-MAP" error

This error happens when you have a reference to another table in the class, having metclass = dao-table-mixin.

Here is a full example to reproduce this problem:

(defpackage #:mito-test
  (:use #:cl))
(in-package mito-test)

(defclass project ()
  ((name :col-type :text))
  (:metaclass mito:dao-table-class))

(defclass with-link-to-project-mixin ()
  ((project :col-type project))
  (:metaclass mito:dao-table-mixin))

(defclass action (with-link-to-project-mixin)
  ()
  (:metaclass mito:dao-table-class))

After these classes were defined, try:

MITO-TEST> (mito:save-dao (make-instance 'action))

This is a full stack trace from the Emacs:

;; #<STANDARD-CLASS MITO.DAO.TABLE:DAO-CLASS> has no slot named MITO.CLASS.TABLE::PARENT-COLUMN-MAP.
;;    [Condition of type SIMPLE-ERROR]

;; Restarts:
;;  0: [RETRY] Retry SLY mREPL evaluation request.
;;  1: [*ABORT] Return to SLY's top level.
;;  2: [ABORT-BREAK] Reset this thread
;;  3: [ABORT] Kill this thread

;; Backtrace:
;;  0: (#<CCL::STANDARD-KERNEL-METHOD SLOT-MISSING (T T T T)> #<STANDARD-CLASS STANDARD-CLASS> #<STANDARD-CLASS MITO.DAO.TABLE:DAO-CLASS> MITO.CLASS.TABLE::PARENT-COLUMN-MAP SLOT-VALUE NIL)
;;  1: (CCL::%SLOT-ID-REF-MISSING #<STANDARD-CLASS MITO.DAO.TABLE:DAO-CLASS> #<SLOT-ID for MITO.CLASS.TABLE::PARENT-COLUMN-MAP/1863 #x3020042934FD>)
;;  2: ((:INTERNAL MITO.CLASS.TABLE::REC MITO.CLASS.TABLE:FIND-PARENT-COLUMN))
;;  3: ((:INTERNAL MITO.CLASS.TABLE::REC MITO.CLASS.TABLE:FIND-PARENT-COLUMN))
;;  4: ((:INTERNAL MITO.CLASS.TABLE::REC MITO.CLASS.TABLE:FIND-PARENT-COLUMN))
;;  5: (MITO.CLASS.TABLE:FIND-PARENT-COLUMN #<MITO.DAO.TABLE:DAO-TABLE-CLASS ACTION2> #<DAO-TABLE-COLUMN-CLASS for instance slot PROJECT-ID #x30200716D12D>)
;;  6: (MITO.DAO::FOREIGN-VALUE #<ACTION2 #x30200739E03D> #<DAO-TABLE-COLUMN-CLASS for instance slot PROJECT-ID #x30200716D12D>)
;;  7: ((:INTERNAL MITO.DAO::MAKE-SET-CLAUSE) #<DAO-TABLE-COLUMN-CLASS for instance slot PROJECT-ID #x30200716D12D>)
;;  8: (CCL::MAP1 #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL MITO.DAO::MAKE-SET-CLAUSE) #x30200739D7BF> ((#<DAO-TABLE-COLUMN-CLASS for instance slot MITO.DAO.MIXIN::ID #x3020042C56FD> ..)))) :NCONC T)
;;  9: (MAPCAN #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL MITO.DAO::MAKE-SET-CLAUSE) #x30200739D7BF> (#<DAO-TABLE-COLUMN-CLASS for instance slot MITO.DAO.MIXIN::ID #x3020042C56FD> ..)))
;; 10: (MITO.DAO::MAKE-SET-CLAUSE #<ACTION2 #x30200739E03D>)
;; 11: (#<STANDARD-METHOD MITO.DAO:INSERT-DAO (MITO.DAO.TABLE:DAO-CLASS)> #<ACTION2 #x30200739E03D>)
;; 12: (CCL::%%STANDARD-COMBINED-METHOD-DCODE ((#<STANDARD-METHOD MITO.DAO:INSERT-DAO :BEFORE (MITO.DAO.MIXIN:RECORD-TIMESTAMPS-MIXIN)>) NIL ..) 17581893521117)
;; 13: (NIL #<Unknown Arguments>)
;; 14: (#<STANDARD-METHOD MITO.DAO:SAVE-DAO (MITO.DAO.TABLE:DAO-CLASS)> #<ACTION2 #x30200739E03D>)
;; 15: (CCL::CALL-CHECK-REGS MITO.DAO:SAVE-DAO #<ACTION2 #x30200739E03D>)
;; 16: (CCL::CHEAP-EVAL (MITO.DAO:SAVE-DAO (MAKE-INSTANCE 'ACTION2)))

Inconsistent use of timezone when setting dao creation and update times

Creation and update timestamps sometimes differ from the intended values, probably by multiples of the local timezone. Using the sample user class from README.markdown:
(tests were run around 2016-04-02T19:05-03:00)

Machine: Linux 3.11-2-amd64
Lisp: SBCL 1.1.15.debian
ASDF: 3.1.7
Quicklisp: 2016-03-18 (latest)

CL-USER> (ql:quickload :mito)
To load "mito":
  Load 1 ASDF system:
    mito
; Loading "mito"
......
(:MITO)
CL-USER> (mito.connection:connect-toplevel :sqlite3 :database-name #P"/tmp/test.db3")
#<DBD.SQLITE3:<DBD-SQLITE3-CONNECTION> {10059B6DE3}>
CL-USER> (defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (or (:varchar 128) :null)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class))
#<MITO.DAO.TABLE:DAO-TABLE-CLASS USER>
CL-USER> (mito.dao:ensure-table-exists 'user)
;; CREATE TABLE "user" (
    "id" INTEGER PRIMARY KEY AUTOINCREMENT,
    "name" VARCHAR(64) NOT NULL,
    "email" VARCHAR(128),
    "created_at" TIMESTAMP,
    "updated_at" TIMESTAMP
) () [0 rows] | MITO.DB:EXECUTE-SQL
(#<SXQL-STATEMENT: CREATE TABLE user (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    name VARCHAR(64) NOT NULL,
    email VARCHAR(128),
    created_at TIMESTAMP,
    updated_at TIMESTAMP
)>)
CL-USER> (mito.dao:create-dao 'user :name "fchurca") ; This happened around 19:33, timezone -3:00
#<USER {1005ACE613}>
CL-USER> (defparameter *me* (mito.dao:find-dao 'user :name "fchurca"))
*ME*
CL-USER> (inspect *me*)

The object is a STANDARD-OBJECT of type USER.
0. CREATED-AT: @2016-04-02T16:33:45.000000-03:00 ; Creation and update times off by 3h
1. UPDATED-AT: @2016-04-02T16:33:45.000000-03:00
2. SYNCED: T
3. ID: 5
4. NAME: "fchurca"
5. EMAIL: NIL
> q
; No value
CL-USER> (setf (user-email *me*) "[email protected]")
"[email protected]"
CL-USER> (mito.dao:save-dao *me*)
; No value
CL-USER> (inspect *me*) 

The object is a STANDARD-OBJECT of type USER.
0. CREATED-AT: @2016-04-02T16:33:45.000000-03:00
1. UPDATED-AT: @2016-04-02T19:36:53.100683-03:00 ; Update time is now correct
2. SYNCED: T
3. ID: 5
4. NAME: "fchurca"
5. EMAIL: "[email protected]"
>

References and col-type behaves different way with includes

Somewhat related to #1

First some setup:

(ql:quickload 'mito)
(mito:connect-toplevel :sqlite3 :database-name "/tmp/testme.db")
(defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name))
  (:metaclass mito:dao-table-class))

(defclass tweet ()
  ((user-id :references (user id)
            :initarg :user-id
            :accessor tweet-user-id))
  (:metaclass mito:dao-table-class))

(defclass tweet2 ()
  ((user    :col-type user
            :initarg :user
            :accessor tweet-user))
  (:metaclass mito:dao-table-class))

(mito:ensure-table-exists 'user)
(mito:ensure-table-exists 'tweet)
(mito:ensure-table-exists 'tweet2)

(mito:create-dao 'tweet :user-id 1)
(defparameter *user* (mito:create-dao 'user  :name "Lucas"))
(mito:create-dao 'tweet2 :user *user*)

Then

CL-USER> (mito:select-dao 'tweet2 (mito:includes 'user))
(#<TWEET2 {10087C4043}>)
CL-USER> (mito:select-dao 'tweet (mito:includes 'user))
When attempting to
set the slot's value to #<USER {10088A71C3}> (SETF of SLOT-VALUE),
the slot NIL is missing from the object #<TWEET {100889E273}>.
   [Condition of type SIMPLE-ERROR]

Relationship queries fail when (setf *print-case* :downcase)

If *print-case* is not :UPCASE, it seems that Mito fails to retrieve relationship fields via accessors. Example:

(setf *print-case* :downcase)

(deftable user ()
  ((name :col-type (:varchar 512)))))

(deftable tweet ()
  ((status :col-type (:varchar 512))))
  ((user  :col-type user)))
  

(let* ((user (create-dao 'user :name "foo"))
       (tweet (create-dao 'tweet :status "bar" :user user)))
  (user tweet))

The last expression returns nil, while it should return some #<USER {...}> object.

Pass object to inflate/deflate functions

Right now it's not possible to inflate/deflate depending on values from other fields.
If the inflate/deflate would get an optional OBJECT parameter, we could access all the fields.

:references not working

Using latest mito:

CL-USER> (ql:quickload 'mito)
To load "mito":
  Load 1 ASDF system:
    mito
; Loading "mito"
....
(MITO)
CL-USER> (mito:connect-toplevel :sqlite3 :database-name "/tmp/testme.db")
To load "dbd-sqlite3":
  Load 1 ASDF system:
    dbd-sqlite3
; Loading "dbd-sqlite3"
.........
#<DBD.SQLITE3:<DBD-SQLITE3-CONNECTION> {1005A04063}>
CL-USER> (defclass user ()
  ((name :col-type (:varchar 64)
         :initarg :name
         :accessor user-name)
   (email :col-type (or (:varchar 128) :null)
          :initarg :email
          :accessor user-email))
  (:metaclass mito:dao-table-class))

(defclass tweet ()
  ((status :col-type :text
           :initarg :status
           :accessor tweet-status)
   ;; This slot refers to USER class
   (user-id :references (user id)
            :initarg :user-id
            :accessor tweet-user-id))
  (:metaclass mito:dao-table-class))
#<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::TWEET>
CL-USER> (mito:ensure-table-exists 'user)
;; CREATE TABLE "user" ("id" INTEGER PRIMARY KEY AUTOINCREMENT, "name" VARCHAR(64) NOT NULL, "email" VARCHAR(128), "created_at" TIMESTAMP, "updated_at" TIMESTAMP) () [0 rows] | MITO.DAO:ENSURE-TABLE-EXISTS
(#<SXQL-STATEMENT: CREATE TABLE user (id INTEGER PRIMARY KEY AUTOINCREMENT, name VARCHAR(64) NOT NULL, email VARCHAR(128), created_at TIMESTAMP, updated_at TIMESTAMP)>)
CL-USER> (mito:ensure-table-exists 'tweet)
;; CREATE TABLE "tweet" ("id" INTEGER PRIMARY KEY AUTOINCREMENT, "status" TEXT NOT NULL, "user_id" INTEGER NOT NULL, "created_at" TIMESTAMP, "updated_at" TIMESTAMP) () [0 rows] | MITO.DAO:ENSURE-TABLE-EXISTS
(#<SXQL-STATEMENT: CREATE TABLE tweet (id INTEGER PRIMARY KEY AUTOINCREMENT, status TEXT NOT NULL, user_id INTEGER NOT NULL, created_at TIMESTAMP, updated_at TIMESTAMP)>)
CL-USER> (mito:create-dao 'tweet :user-id 1)

When attempting to
test to see whether slot is bound (SLOT-BOUNDP), the slot NIL is
missing from the object #<TWEET {100863C5E3}>.
   [Condition of type SIMPLE-ERROR]

Seems like parent-column-map is an empty hash when find-parent-column is called from mito.dao::foreign-value.
I think the problem lies in mito.dao.table::initialize-initargs (which initializes parent-column-map). When :col-type is a not-null, not-keyword symbol a new entry is added to parent-column-map, but when :references is used alone no entry is added.

Setup a regular (weekly) builds on Travis

The world is changing and it will be useful to check Mito against it by using "cron" builds on Travis.

For example, this pull request's check has failed:

https://travis-ci.org/fukamachi/mito/jobs/473517349

but by looking at error:

Running a test file '/home/travis/build/fukamachi/mito/t/db/sqlite3.lisp'
> Error: Unbound variable: DBD.SQLITE3::PREPARED
> While executing: #<STANDARD-METHOD DO-SQL (DBD.SQLITE3:<DBD-SQLITE3-CONNECTION> STRING)>, in process listener(1).
> Type :GO to continue, :POP to abort, :R for a list of available restarts.
> If continued: Skip evaluation of (ros:run '((:eval"(ros:quicklisp)")(:script "/home/travis/.roswell/bin/run-prove""mito-test.asd")(:quit ())))
> Type :? for other options.
1 > 

I can confidently say that this error can't be caused by the pull. Obviously, something in cl-dbi has changed since last successful Mito's build which happened 3 months ago.

Support a thread pool for parallel access to database

I didn't found an example how to use thread-pool from cl-dbi with mito, just want to admit that connect-top-level is not thread safe.

Here is what happens when you are trying to select data from Postgres database:

CL-USER> (defparameter *lock* (bt:make-lock))
CL-USER> (defparameter *items* nil)
CL-USER> (loop for thread-id from 1 upto 10
               do (let ((thread-name (format nil "thread-~A" thread-id)))
                    (bt:make-thread
                     (lambda ()
                       (loop for i from 1 upto 1000
                             for item = (first (mito:select-dao 'some-model))
                             do (bt:with-lock-held (*lock*)
                                       (push (cons thread-name item) *items*))))
                     :name thread-name)))
DB Error: This connection is still processing another query. (Code: NIL)
   [Condition of type DBI.ERROR:<DBI-DATABASE-ERROR>]

Restarts:
 0: [ABORT-BREAK] Reset this thread
 1: [ABORT] Kill this thread

Backtrace:
 0: (#<STANDARD-METHOD DBI.DRIVER:PREPARE (DBD.POSTGRES:<DBD-POSTGRES-CONNECTION> STRING)> #<DBD.POSTGRES:<DBD-POSTGRES-CONNECTION> #x30200758240D> "SELECT * FROM \"version\" WHERE (\"built_at\" IS NULL)"..
 1: (CCL::%%CHECK-KEYWORDS #(2 #(:QUERY-CLASS) #<METHOD-FUNCTION DBI.DRIVER:PREPARE (DBD.POSTGRES:<DBD-POSTGRES-CONNECTION> STRING)>) 84252511)
 2: (NIL #<Unknown Arguments>)
 3: (#<STANDARD-METHOD MITO.DB:RETRIEVE-BY-SQL (STRING)> "SELECT * FROM \"version\" WHERE (\"built_at\" IS NULL)" :BINDS NIL)
 4: (CCL::%%STANDARD-COMBINED-METHOD-DCODE ((#<STANDARD-METHOD MITO.DB:RETRIEVE-BY-SQL :BEFORE (T)>) NIL #<STANDARD-METHOD MITO.DB:RETRIEVE-BY-SQL (STRING)>) 84252535)
 5: (NIL #<Unknown Arguments>)
 6: (CCL::%%CHECK-KEYWORDS #(1 #(:BINDS) #<Combined-Method MITO.DB:RETRIEVE-BY-SQL #x302005E333DF>) 84252551)
 7: (NIL #<Unknown Arguments>)
 8: (#<STANDARD-METHOD MITO.DB:RETRIEVE-BY-SQL (SXQL.SQL-TYPE:SQL-STATEMENT)> #<SXQL-STATEMENT: SELECT * FROM "version" WHERE ("built_at" IS NULL)> :BINDS NIL)
 9: (CCL::%%STANDARD-COMBINED-METHOD-DCODE ((#<STANDARD-METHOD MITO.DB:RETRIEVE-BY-SQL :BEFORE (T)>) NIL #<STANDARD-METHOD MITO.DB:RETRIEVE-BY-SQL (SXQL.SQL-TYPE:SQL-STATEMENT)>) 84252577)
10: (NIL #<Unknown Arguments>)
11: (CCL::%%CHECK-KEYWORDS #(1 #(:BINDS) #<Combined-Method MITO.DB:RETRIEVE-BY-SQL #x302005E3542F>) 84252590)
12: (NIL #<Unknown Arguments>)
13: (MITO.DAO::SELECT-BY-SQL #<MITO.DAO.TABLE:DAO-TABLE-CLASS ULTRALISP/MODELS/VERSION:VERSION> #<SXQL-STATEMENT: SELECT * FROM "version" WHERE ("built_at" IS NULL)>)
14: (ULTRALISP/MODELS/VERSION:GET-PENDING-VERSION)
15: (#<Anonymous Function #x30200767826F>)

What is the best way to use connect-cached?

Does not load (LispWorks 6.0.1 on Windows)

To load "mito":
Load 1 ASDF system:
mito
; Loading "mito"
..................................................
........

[package mito.dao.mixin].

**++++ Error in (DEFCLASS MITO.DAO.MIXIN:AUTO-PK-MIXIN):
#<STANDARD-GENERIC-FUNCTION CLOS:DIRECT-SLOT-DEFINITION-CLASS 20A63A02> is called with keyword :NAME among the arguments (#<DAO-TABLE-MIXIN AUTO-PK-MIXIN 230498FB> :NAME ID :READERS (OBJECT-ID) :INITARGS (:ID) :PRIMARY-KEY T :COL-TYPE :BIGSERIAL) when no keywords are allowed.

**++++ Error in (DEFCLASS MITO.DAO.MIXIN:RECORD-TIMESTAMPS-MIXIN):
#<STANDARD-GENERIC-FUNCTION CLOS:DIRECT-SLOT-DEFINITION-CLASS 20A63A02> is called with keyword :NAME among the arguments (#<DAO-TABLE-MIXIN RECORD-TIMESTAMPS-MIXIN 200BBCDB> :NAME CREATED-AT :READERS (OBJECT-CREATED-AT) :WRITERS ((SETF OBJECT-CREATED-AT)) :INITARGS (:CREATED-AT) :COL-TYPE (OR :DATETIME :NULL)) when no keywords are allowed.
; *** 2 errors detected, no fasl file produced.

(:MITO)

migrate-table fails on datetime fields with postgres

I'm a bit confused as to how this ever worked (or if I just overlooked the fact that it didn't), but migrate-table calls fail for dao-table-class in postgres instances because of the created-at and updated-at fields. These are defined as being of col-type (or :datetime :null) and the code in table-column-info-for-create-table was converting the column type from :datetime to :time. It seems to me that this should be done in table-column-info instead of table-column-info-for-create-table. See soon-to-be-pending pull request.

Function parse-statements unable to separate statements in some cases

Here is the minimal example to reproduce this issue:

CL-USER> (length (mito.migration.sql-parse::parse-statements
                      "
CREATE TABLE test_dist (id INTEGER, quicklisp_version TEXT NOT NULL DEFAULT '');

CREATE TABLE any_other_table_o_more (id INTEGER);

INSERT INTO test_dist (id, quicklisp_version) VALUES (0, 'some version');
"))
1

Expected value is 3.

However, when I replace '' default value with NULL, everything works!

CL-USER> (length (mito.migration.sql-parse::parse-statements
                      "
CREATE TABLE test_dist (id INTEGER, quicklisp_version TEXT NOT NULL DEFAULT NULL);

CREATE TABLE any_other_table_o_more (id INTEGER);

INSERT INTO test_dist (id, quicklisp_version) VALUES (0, 'some version');
"))
3

Also works with nonempty default string:

(length (mito.migration.sql-parse::parse-statements
                      "
CREATE TABLE test_dist (id INTEGER, quicklisp_version TEXT NOT NULL DEFAULT 'blah');

CREATE TABLE any_other_table_o_more (id INTEGER);

INSERT INTO test_dist (id, quicklisp_version) VALUES (0, 'some version');
"))
3

Tested on the latest Mito from the repository. Commit c51e647.

underscores break slot names

I had trouble retrieving data via mito:select-dao and kept getting results with unbound slots, so i dug a bit deeper and found that mito currently can't retrieve data from tables where the slots of the table definition includes underscores.

(ql:quickload :mito)

(mito:connect-toplevel :mysql
                       :database-name "testDB"
                       :username username
                       :password passphrase
                       :host host)

(mito:deftable table1 ()
  ((entry_name :col-type (:varchar 100))))

(mito:deftable table2 ()
  ((entry-name :col-type (:varchar 100))))

(mapcar #'mito:ensure-table-exists '(table1 table2))

(mito:create-dao 'table1 :entry_name "entry1")
(mito:create-dao 'table2 :entry-name "entry2")

(setf table1-result (mito:select-dao 'table1))
(setf table2-result (mito:select-dao 'table2))

This works as expected with the table2, I can access the values of the returned object without problem:

(table2-entry-name (car table2-result))
;=> "entry2"

but with table1, it throws an error because the slot entry_name is unbound.

(table1-entry_name (car table1-result))
;=> ; Evaluation aborted on #<UNBOUND-SLOT ENTRY_NAME {10028CA253}>.
;     The slot COMMON-LISP-USER::ENTRY_NAME is unbound in the object
;     #<TABLE1 {1006110F73}>.

I've traced the problem back to retrieve-by-sql which produces the same output for both tables, i.e. at some point in that function the underscore in the slot name gets turned into a dash.

(mito:retrieve-by-sql (sxql:select :*
                        (sxql:from :table1)))
;=> ((:ID 1 :ENTRY-NAME "entry1" :CREATED-AT 3872237193 :UPDATED-AT 3872237193))

(mito:retrieve-by-sql (sxql:select :*
                        (sxql:from :table2)))
;=> ((:ID 1 :ENTRY-NAME "entry2" :CREATED-AT 3872237193 :UPDATED-AT 3872237193))

and sure enough retrieve-by-sql calls lispify which replaces all underscores with dashes

mito/src/core/util.lisp

Lines 89 to 93 in fcc8003

(defun lispify (object)
(etypecase object
(symbol (intern (lispify (string-upcase object))
(symbol-package object)))
(string (substitute #\- #\_ object))))

So right now if you define a table with slot names that contain underscores it's impossible to retrieve data from that table/slot with mito functions, i don't think that's expected behavior.

As far as i can tell this behavior is a correlate to mito turning all dashes in slot names into underscores when creating table definitions. I think Mito should either check whether the user defined class uses underscores before changing them, or it should not allow to use underscores in the table definition in the first place and clearly document that it reverses the sql standard to only allow - where the former only allows _.

col-type don't work with mixins

When :col-type is used through a mixin, the table generator screws up

(ql:quickload 'mito)
(mito:connect-toplevel :sqlite3 :database-name "/tmp/testme.db")

(defclass some-thing ()
  ((field :col-type :text))
  (:metaclass mito:dao-table-class))

(defclass my-mixin ()
  ((name  :col-type :text)
   (some-thing :col-type some-thing
               :initarg :some-thing))
  (:metaclass mito:dao-table-mixin))

(defclass another-table (my-mixin)
  ()
  (:metaclass mito:dao-table-class))

Then, create the tables

(mito:ensure-table-exists 'some-thing)
;; CREATE TABLE "some_thing" (
    "id" INTEGER PRIMARY KEY AUTOINCREMENT,
    "field" TEXT NOT NULL,
    "created_at" TIMESTAMP,
    "updated_at" TIMESTAMP
) () [0 rows] | MITO.DAO:ENSURE-TABLE-EXISTS
(mito:ensure-table-exists 'another-table)
;; CREATE TABLE "another_table" (
    "id" INTEGER PRIMARY KEY AUTOINCREMENT,
    "name" TEXT NOT NULL,
    "some_thing" SOME-THING NOT NULL,
    "created_at" TIMESTAMP,
    "updated_at" TIMESTAMP
) () [0 rows] | MITO.DAO:ENSURE-TABLE-EXISTS
DB Error: near "-": syntax error (Code: ERROR)
   [Condition of type DBI.ERROR:<DBI-PROGRAMMING-ERROR>]

When :references is used, the table creation works

(defclass my-mixin ()
  ((name  :col-type :text)
   (some-thing-id :references (some-thing id)
                  :initarg :some-thing-id))
  (:metaclass mito:dao-table-mixin))
(mito:ensure-table-exists 'another-table)
;; CREATE TABLE "another_table" (
    "id" INTEGER PRIMARY KEY AUTOINCREMENT,
    "name" TEXT NOT NULL,
    "some_thing_id" INTEGER NOT NULL,
    "created_at" TIMESTAMP,
    "updated_at" TIMESTAMP
) () [0 rows] | MITO.DAO:ENSURE-TABLE-EXISTS

Unbound slot error

Hi,

I have created 3 tables.
users, courses and user-courses to implement a many-to-many relationship between the users and courses.
When I try to access the user or courses object via the user-courses entry, which I got with find-dao from the database, I get an unbound slot error. Since I'm pretty new to Lisp (this is my first real application), I don't know if this behaviour is intended or actually a bug?

Simplified code to reproduce:

(defparameter *connection*
  (mito:connect-toplevel :sqlite3 :database-name "mitotest.db"))

(mito:deftable users ()
  ((name :col-type (:varchar 64))
   (email-address :col-type (:varchar 128))))

(mito:deftable courses ()
  ((name :col-type (:varchar 128))))

(mito:deftable user-courses ()
  ((user :col-type users)
   (course :col-type courses)
   (selected :col-type :bytea)))

(mapcar #'mito:ensure-table-exists '(users courses user-courses))


(let* ((user (make-instance 'users :name "Me" :email-address "[email protected]"))
       (course (make-instance 'courses :name "Test Course"))
       (user-course (make-instance 'user-courses :user user :course course :selected 0)))
  (mapcar #'mito:insert-dao (list user course user-course)))


(defvar *my-course* (user-courses-course (mito:find-dao 'user-courses :id 1)))

Results in a unbound-slot error when trying to access the course from the user-courses object.

Calling the function mito:table-exists-p results in an error

$ createdb mito-test
(ql:quickload :mito)

(mito:deftable hoge () ())

(mito:connect-toplevel :postgres :database-name "mito-test")

(mito.db:table-exists-p mito:*connection* 'hoge)
;; => DB Error: column "hoge" does not exist (Code: 42703)

https://github.com/fukamachi/cl-dbi/blob/7ba050dea8d137c1f85b7e704d4fc945104bf283/src/dbd/postgres.lisp#L94

The value of the variable SQL at this point
"SELECT 1 FROM information_schema.tables WHERE ((table_schema = $1) AND (table_name = hoge)) LIMIT 1"

(:= :table_name table-name)))

If the table-name here is a string literal, it works correctly.

diff --git a/src/core/db.lisp b/src/core/db.lisp
index 9352ee5..46bb671 100644
--- a/src/core/db.lisp
+++ b/src/core/db.lisp
@@ -98,7 +98,7 @@ Note that DBI:PREPARE-CACHED is added CL-DBI v0.9.5.")
           (sxql:select :1
             (sxql:from :information_schema.tables)
             (sxql:where (:and (:= :table_schema "public")
-                              (:= :table_name table-name)))
+                              (:= :table_name "hoge")))
             (sxql:limit 1)))
          (:sqlite3
           (sxql:select :1

Boolean values aren't inflated/deflated correctly

Honestly, I'm not sure if this is a mito or sxql problem, but I have a column defined with :col-type :boolean and when the lisp slot is nil, it is written to the database as NULL.

I solved it for myself by writing inflation and deflation functions for boolean, but maybe this should be part of mito by default, since it's such a basic type.

This is my code:

(defun inflate-boolean (db-val)
  (string-equal db-val "true"))

(defun deflate-boolean (lisp-val)
  (if lisp-val "TRUE" "FALSE"))

I would be happy to submit a PR for this, but there doesn't seem to be a general way to define inflation/deflation for types. Maybe it's worth taking a page out of crane's book and allowing inflation and deflation functions to be defined per-type instead of per-slot.

As it is, it seems like this code has new instances of the inflation/deflation functions being created for every object instance, which seems wasteful unless the compiler is smart enough to identify those lambdas as constants.

Let me know what you think so I can try to help in the way you think best.

The value of CL-POSTGRES::PARAMETERS is 2327607654652096140, which is not of type LIST

MITO.DB.POSTGRES:ACQUIRE-ADVISORY-LOCK function signals this error when I try to apply migrations.

Probably that is because this function passes parameter as is instead of list:

(defun acquire-advisory-lock (conn id)
  (dbi:do-sql conn "SELECT pg_advisory_lock(?)" id)
  (values))

In this commit CL-DBI's DO-SQL was changed to accept parameters as lists.

After I've changed these functions like this, migration was applied successfully:

(defun acquire-advisory-lock (conn id)
  (dbi:do-sql conn "SELECT pg_advisory_lock(?)" (list id))
  (values))

(defun release-advisory-lock (conn id)
  (dbi:do-sql conn "SELECT pg_advisory_unlock(?)" (list id))
  (values))

Environment

Mito on fcc8003 commit (latest for now).

CL-DBI was installed from Ultralisp.org. Release number 20210831151553.

Deflate function does not applied to arguments of find-dao

For example, if I have a model like that:

(defclass social-profile ()
  ((user :col-type user
         :initarg :user
         :accessor get-user)
   (service :col-type (:text)
            :initarg :service
            :reader get-service
            :inflate (lambda (text)
                       (make-keyword (string-upcase text))))
  (:documentation "Represents a User's link to a social service.
                   User can be bound to multiple social services.")
  (:metaclass mito:dao-table-class))

then I can do:

(mito:find-dao 'social-profile :service :github)

Mito thinks that :github is a column name and Postgres throws an error:

DB Error: column "github" does not exist (Code: 42703)
   [Condition of type DBI.ERROR:<DBI-PROGRAMMING-ERROR>]

Restarts:
 0: [RETRY] Retry SLY mREPL evaluation request.
 1: [*ABORT] Return to SLY's top level.
 2: [ABORT] abort thread (#<THREAD "sly-channel-1-mrepl-remote-1" RUNNING {1012AF06B3}>)

Backtrace:
 0: ((:METHOD DBI.DRIVER:PREPARE (DBD.POSTGRES:<DBD-POSTGRES-CONNECTION> STRING)) #<DBD.POSTGRES:<DBD-POSTGRES-CONNECTION> {100E99AB73}> "SELECT * FROM \"social_profile\" WHERE (\"service\" = \"github\") ..
 1: ((:METHOD MITO.DB:RETRIEVE-BY-SQL (STRING)) "SELECT * FROM \"social_profile\" WHERE (\"service\" = \"github\") LIMIT 1" :BINDS NIL) [fast-method]
 2: ((SB-PCL::EMF MITO.DB:RETRIEVE-BY-SQL) #<unused argument> #<unused argument> "SELECT * FROM \"social_profile\" WHERE (\"service\" = \"github\") LIMIT 1" :BINDS NIL)
 3: ((:METHOD MITO.DB:RETRIEVE-BY-SQL (SXQL.SQL-TYPE:SQL-STATEMENT)) #<SXQL-STATEMENT: SELECT * FROM "social_profile" WHERE ("service" = "github") LIMIT 1> :BINDS #<unused argument>) [fast-method]
 4: ((SB-PCL::EMF MITO.DB:RETRIEVE-BY-SQL) #<unused argument> #<unused argument> #<SXQL-STATEMENT: SELECT * FROM "social_profile" WHERE ("service" = "github") LIMIT 1>)
 5: (MITO.DAO::SELECT-BY-SQL #<MITO.DAO.TABLE:DAO-TABLE-CLASS WEBLOCKS-AUTH/MODELS::SOCIAL-PROFILE> #<SXQL-STATEMENT: SELECT * FROM "social_profile" WHERE ("service" = "github") LIMIT 1>)
 6: (MITO.DAO:FIND-DAO #<MITO.DAO.TABLE:DAO-TABLE-CLASS WEBLOCKS-AUTH/MODELS::SOCIAL-PROFILE> :SERVICE :GITHUB)
 7: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MITO.DAO:FIND-DAO (QUOTE SOCIAL-PROFILE) :SERVICE :GITHUB) #<NULL-LEXENV>)
 8: (EVAL (MITO.DAO:FIND-DAO (QUOTE SOCIAL-PROFILE) :SERVICE :GITHUB))

I expected Mito will apply deflate automatically, making "GITHUB" string from the :github symbol.

Should this be considered a bug?

Won't use col-type when retrieve-dao for inherted table

Sample

(deftable file ()
  ((file-name :col-type (:varchar 260)
	      :initarg :file-name
	      :accessor file-name)))

(deftable foo ()
  ((file-dao :col-type file
	     :initarg :file-dao
	     :accessor file-dao)))

(deftable foo-1 (foo)
  ())

(mapc #'ensure-table-exists
      (list 'file 'foo 'foo-1))

(create-dao 'file :file-name "test-1")
(create-dao 'file :file-name "test-2")

;;foo
(create-dao 'foo :file-dao (find-dao 'file :file-name "test-1"))
(create-dao 'foo :file-dao (find-dao 'file :file-name "test-2"))

(retrieve-dao 'foo :file-dao (find-dao 'file :file-name "test-2"))
==>(#<FOO {10063CB2E3}>), #<SXQL-STATEMENT: SELECT * FROM foo WHERE (file_dao_id = 2)>

;;foo-1
(create-dao 'foo-1 :file-dao (find-dao 'file :file-name "test-1"))
(create-dao 'foo-1 :file-dao (find-dao 'file :file-name "test-2"))

(retrieve-dao 'foo-1 :file-dao (find-dao 'file :file-name "test-2"))
==> (#<FOO-1 {10055EB723}> #<FOO-1 {10055EC7E3}>), #<SXQL-STATEMENT: SELECT * FROM foo_1>

as you can see, retrieve-dao for foo and foo-1 is different.
I want foo-1 to work like foo, how to achieve this?
Please.

join queries with mito

I have a table schemas like the below:

(mito:deftable warehouses ()
  ((location :col-type (:varchar 50))
   (capacity :col-type (:integer))))

(mito:deftable boxes ()
  ((contents :col-type (:varchar 10))
   (value :col-type (:integer))
   (warehouse :col-type warehouses :references warehouses)))

How can I fetch the list of boxes along with their warehouse names, it is pretty straigthforward with sql or sxql, but I want to know how can we do this with mito?

select contents, value, location from boxes inner join warehouses where boxes.warehouse = warehouse.id

Generating unnecessary ALTER migrations for :primary-key class option on PostgreSQL

Reported by @masatoi in person.

Need to reproduce with a minimum example. It could also happen with other RDBMS, but there's no information.

(defclass abc ()
  ((token :col-type (:varchar 32)
          :initarg :token
          :initform ""
          :accessor abc-token))
  (:primary-key token)
  (:metaclass mito:dao-table-class))

Workaround

Use a slot option instead of a class option.

(defclass abc ()
  ((token :col-type (:varchar 32)
          :primary-key t
          :initarg :token
          :initform ""
          :accessor abc-token))
  (:metaclass mito:dao-table-class))

Environment

  • PostgreSQL 10.10

mito:migrate-table fails

$ createdb mito-example
(ql:quickload '(:mito :uuid))

(defclass uuid-pk-mixin ()
  ((uuid :col-type (:varchar 36)
         :initform (uuid:make-v4-uuid)
         :accessor object-uuid
         :primary-key t))
  (:metaclass mito:dao-table-mixin))

(mito:deftable hoge (uuid-pk-mixin)
  ())

(mito:connect-toplevel :postgres :database-name "mito-example")

(mapc #'mito:execute-sql (mito:table-definition 'hoge))
(ql:quickload '(:mito))

(defclass hoge () ()
  (:auto-pk :uuid))

(mito:connect-toplevel :postgres :database-name "mito-example")

(mito:migrate-table 'hoge)

;;; DB Error: there is no parameter $1 (Code: 42P02)

stack trace

  0: ((:METHOD DBI.DRIVER:EXECUTE-USING-CONNECTION (DBD.POSTGRES:DBD-POSTGRES-CONNECTION DBD.POSTGRES:DBD-POSTGRES-QUERY T)) #<DBD.POSTGRES:DBD-POSTGRES-CONNECTION {100535CF73}> #<DBD.POSTGRES:DBD-POSTGRES..
       Locals:
         DBD.POSTGRES::CONN = #<DBD.POSTGRES:DBD-POSTGRES-CONNECTION {100535CF73}>
         DBD.POSTGRES::PARAMS = NIL
         DBD.POSTGRES::QUERY = #<DBD.POSTGRES:DBD-POSTGRES-QUERY {1003C60773}>
  1: (MITO.UTIL:EXECUTE-WITH-RETRY #<DBD.POSTGRES:DBD-POSTGRES-QUERY {1003C60773}> NIL)
       Locals:
         BINDS = NIL
         QUERY = #<DBD.POSTGRES:DBD-POSTGRES-QUERY {1003C60773}>
         RETRIED = NIL
  2: ((LAMBDA (MITO.DB::QUERY) :IN MITO.DB:EXECUTE-SQL) #<unavailable argument>)
       [No Locals]
  3: (MITO.UTIL::CALL-WITH-PREPARED-QUERY #<DBD.POSTGRES:DBD-POSTGRES-CONNECTION {100535CF73}> "ALTER TABLE \"hoge\" ADD COLUMN \"id\" character varying(36) NOT NULL DEFAULT ? PRIMARY KEY" #<FUNCTION (LAMB..
       Locals:
         CONN = #<DBD.POSTGRES:DBD-POSTGRES-CONNECTION {100535CF73}>
         QUERY = #<DBD.POSTGRES:DBD-POSTGRES-QUERY {1003C60773}>
         SQL = "ALTER TABLE \"hoge\" ADD COLUMN \"id\" character varying(36) NOT NULL DEFAULT ? PRIMARY KEY"
         THUNK = #<FUNCTION (LAMBDA (MITO.DB::QUERY) :IN MITO.DB:EXECUTE-SQL) {1003C6030B}>
         USE-PREPARE-CACHED = NIL
  4: ((:METHOD MITO.DB:EXECUTE-SQL (STRING)) "ALTER TABLE \"hoge\" ADD COLUMN \"id\" character varying(36) NOT NULL DEFAULT ? PRIMARY KEY" NIL) [fast-method]
       Locals:
         MITO.DB::BINDS = NIL
         MITO.DB::SQL = "ALTER TABLE \"hoge\" ADD COLUMN \"id\" character varying(36) NOT NULL DEFAULT ? PRIMARY KEY"
  5: ((SB-PCL::EMF MITO.DB:EXECUTE-SQL) #<unused argument> #<unused argument> "ALTER TABLE \"hoge\" ADD COLUMN \"id\" character varying(36) NOT NULL DEFAULT ? PRIMARY KEY" NIL)
       Locals:
         SB-PCL::.ARG0. = "ALTER TABLE \"hoge\" ADD COLUMN \"id\" character varying(36) NOT NULL DEFAULT ? PRIMARY KEY"
         SB-DEBUG::MORE = (NIL)
  6: ((:METHOD MITO.DB:EXECUTE-SQL (SXQL.SQL-TYPE:SQL-STATEMENT)) #<SXQL-STATEMENT: ALTER TABLE "hoge" ADD COLUMN "id" character varying(36) NOT NULL DEFAULT '55bcace9-0f0b-4267-925c-4b6c9581eff4' PRIMARY ..
       Locals:
         MITO.DB::SQL = #<SXQL-STATEMENT: ALTER TABLE "hoge" ADD COLUMN "id" character varying(36) NOT NULL DEFAULT '55bcace9-0f0b-4267-925c-4b6c9581eff4' PRIMARY KEY>
  7: ((SB-PCL::EMF MITO.DB:EXECUTE-SQL) #<unused argument> #<unused argument> #<SXQL-STATEMENT: ALTER TABLE "hoge" ADD COLUMN "id" character varying(36) NOT NULL DEFAULT '55bcace9-0f0b-4267-925c-4b6c9581ef..
       Locals:
         SB-PCL::.ARG0. = #<SXQL-STATEMENT: ALTER TABLE "hoge" ADD COLUMN "id" character varying(36) NOT NULL DEFAULT '55bcace9-0f0b-4267-925c-4b6c9581eff4' PRIMARY KEY>
         SB-DEBUG::MORE = NIL
  8: ((:METHOD MITO.MIGRATION.TABLE:MIGRATE-TABLE (MITO.DAO.TABLE:DAO-TABLE-CLASS)) #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::HOGE>) [fast-method]
       Locals:
         CLASS = #<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::HOGE>

inspect

#<DBD.POSTGRES:DBD-POSTGRES-QUERY {1003C60773}>
--------------------
Class: #<STANDARD-CLASS DBD.POSTGRES:DBD-POSTGRES-QUERY>
--------------------
 Group slots by inheritance [ ]
 Sort slots alphabetically  [X]

All Slots:
[ ]  CACHED     = NIL
[ ]  CONNECTION = #<DBD.POSTGRES:DBD-POSTGRES-CONNECTION {100535CF73}>
[ ]  FREEDP     = NIL
[ ]  NAME       = "PREPARED-STATEMENT862"
[ ]  PREPARED   = NIL
[ ]  RESULTS    = #<unbound>
[ ]  ROW-COUNT  = NIL
[ ]  SQL        = "ALTER TABLE \"hoge\" ADD COLUMN \"id\" character varying(36) NOT NULL DEFAULT $1 PRIMARY KEY"

Error when retrieving a View from the database

Here is my view definition:

(defclass top-item ()
  ((subject-type :initarg :subject-type
                 :col-type :text
                 :reader subject-type)
   (subject-id :initarg :subject-id
               :col-type :integer
               :reader subject-id)
   (rating :initarg :rating
           :col-type :integer
           :reader rating))
  (:as "select subject_type, subject_id, count(*) as rating from rating.vote group by subject_type, subject_id")
  (:metaclass mito:dao-table-view))

When I'm trying to do a select:

RATING/VOTE/API> (with-connection ()
                       (retrieve-dao 'top-item
                                 :subject-type "user"))

I'm getting this error:

There is no applicable method for the generic function
  #<STANDARD-GENERIC-FUNCTION (COMMON-LISP:SETF MITO.DAO.MIXIN:DAO-SYNCED) (1)>
when called with arguments
  (T #<TOP-ITEM {100E485A53}>).
   [Condition of type SB-PCL::NO-APPLICABLE-METHOD-ERROR]

Restarts:
 0: [RETRY] Retry calling the generic function.
 1: [RETRY] Retry SLY mREPL evaluation request.
 2: [*ABORT] Return to SLY's top level.
 3: [ABORT] abort thread (#<THREAD "sly-channel-1-mrepl-remote-1" RUNNING {10010C0003}>)

Backtrace:
 0: ((:METHOD NO-APPLICABLE-METHOD (T)) #<STANDARD-GENERIC-FUNCTION (COMMON-LISP:SETF MITO.DAO.MIXIN:DAO-SYNCED) (1)> T #<TOP-ITEM {10$
 1: (SB-PCL::CALL-NO-APPLICABLE-METHOD #<STANDARD-GENERIC-FUNCTION (COMMON-LISP:SETF MITO.DAO.MIXIN:DAO-SYNCED) (1)> (T #<TOP-ITEM {10$
 2: ((:METHOD MITO.DAO.MIXIN:MAKE-DAO-INSTANCE (MITO.CLASS.TABLE:TABLE-CLASS)) #<MITO.DAO.VIEW:DAO-TABLE-VIEW RATING/VOTE/MODEL::TOP-I$
 3: (SELECT-BY-SQL #<MITO.DAO.VIEW:DAO-TABLE-VIEW RATING/VOTE/MODEL::TOP-ITEM> #<SXQL-STATEMENT: SELECT * FROM #1=rating#1#.#1#top_ite$
 4: (RETRIEVE-DAO #<MITO.DAO.VIEW:DAO-TABLE-VIEW RATING/VOTE/MODEL::TOP-ITEM> :SUBJECT-TYPE "user")
 5: ((FLET "CONNECTED-FUNC3001"))
 6: (COMMON/DB::CALL-WITH-TRANSACTION #<FUNCTION (FLET "CONNECTED-FUNC3001") {5412086B}>)
 7: (COMMON/DB::CALL-WITH-CONNECTION #<FUNCTION (FLET "CONNECTED-FUNC3001") {5412086B}>)
 8: ((LAMBDA ()))

This is because for dao-table-class mito inserts dao-class to direct-superclasses:

(defmethod initialize-instance :around ((class dao-table-class) &rest initargs
                                                                &key direct-superclasses &allow-other-keys)
  (append-record-timestamp-mixin-to-direct-superclasses-if-needed initargs direct-superclasses)
  (unless (contains-class-or-subclasses 'dao-class direct-superclasses)
    (push (find-class 'dao-class) (getf initargs :direct-superclasses)))
  (append-auto-pk-class-to-direct-superclasses-if-needed initargs direct-superclasses)
  (apply #'call-next-method class initargs))

but for dao-table-view there is no such thing.

Right not this workaround works for me:

(defmethod initialize-instance :around ((class mito:dao-table-view) &rest initargs
                                        &key direct-superclasses &allow-other-keys)
  (unless (mito.util:contains-class-or-subclasses 'mito:dao-class direct-superclasses)
    (push (find-class 'mito:dao-class) (getf initargs :direct-superclasses)))
  (apply #'call-next-method class initargs))

(ql:quickload :mito) was broken in Quicklisp from 2018-04-30

The problem was introduced in commit 81c3cce line: https://github.com/fukamachi/mito/blame/master/src/core/dao/view.lisp#L23

The traceback:

SXQL.SQL-TYPE:SQL-STATEMENT has no NAME slot, in (:INCLUDE
                                                  SXQL.SQL-TYPE:SQL-STATEMENT
                                                  (NAME
                                                   "CREATE VIEW"))
   [Condition of type SIMPLE-ERROR]

Restarts:
 0: [RETRY-COMPILE-FILE] Retry compiling #P"/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp"
 1: [SKIP-COMPILE-FILE] Skip compiling #P"/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp"
 2: [RETRY] Retry compiling #<CL-SOURCE-FILE "mito-core" "core-components" "dao-components" "view">.
 3: [ACCEPT] Continue, treating compiling #<CL-SOURCE-FILE "mito-core" "core-components" "dao-components" "view"> as having been successful.
 4: [RETRY] #<error printing RESTART #x2415648D>
 5: [CLEAR-CONFIGURATION-AND-RETRY] #<error printing RESTART #x241564DD>
 --more--

Backtrace:
  0: (DEFSTRUCT (DEFSTRUCT (CREATE-VIEW (:INCLUDE SXQL.SQL-TYPE:SQL-STATEMENT (NAME "CREATE VIEW")) (:CONSTRUCTOR MAKE-CREATE-VIEW (VIEW-NAME &KEY OR-REPLACE AS))) VIEW-NAME OR-REPLACE AS) #<CCL::LEXICAL-E..
  1: (FUNCALL #<Compiled-function DEFSTRUCT Macroexpander #x3000009CBEBF> (DEFSTRUCT (CREATE-VIEW (:INCLUDE SXQL.SQL-TYPE:SQL-STATEMENT (NAME "CREATE VIEW")) ..)) #<CCL::LEXICAL-ENVIRONMENT #x302001CA23AD>..
  2: (MACROEXPAND-1 (DEFSTRUCT (CREATE-VIEW (:INCLUDE SXQL.SQL-TYPE:SQL-STATEMENT (NAME "CREATE VIEW")) (:CONSTRUCTOR MAKE-CREATE-VIEW (VIEW-NAME &KEY OR-REPLACE AS))) VIEW-NAME OR-REPLACE AS) #<CCL::LEXIC..
  3: (CCL::FCOMP-MACROEXPAND-1 (DEFSTRUCT (CREATE-VIEW (:INCLUDE SXQL.SQL-TYPE:SQL-STATEMENT (NAME "CREATE VIEW")) (:CONSTRUCTOR MAKE-CREATE-VIEW (VIEW-NAME &KEY OR-REPLACE AS))) VIEW-NAME OR-REPLACE AS) #..
  4: (CCL::FCOMP-FORM-1 (DEFSTRUCT (CREATE-VIEW (:INCLUDE SXQL.SQL-TYPE:SQL-STATEMENT (NAME "CREATE VIEW")) (:CONSTRUCTOR MAKE-CREATE-VIEW (VIEW-NAME &KEY OR-REPLACE AS))) VIEW-NAME OR-REPLACE AS) #<CCL::L..
  5: (CCL::FCOMP-FORM (DEFSTRUCT (CREATE-VIEW (:INCLUDE SXQL.SQL-TYPE:SQL-STATEMENT (NAME "CREATE VIEW")) (:CONSTRUCTOR MAKE-CREATE-VIEW (VIEW-NAME &KEY OR-REPLACE AS))) VIEW-NAME OR-REPLACE AS) #<CCL::LEX..
  6: (CCL::FCOMP-READ-LOOP "/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp" "home:projects;lisp;skazkorama;quicklisp;dists;quicklisp;softwar..
  7: (CCL::FCOMP-FILE "/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp" "home:projects;lisp;skazkorama;quicklisp;dists;quicklisp;software;mit..
  8: (CCL::%COMPILE-FILE "/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp" "/Users/art/.cache/common-lisp/ccl-1.11-f96-macosx-x64/Users/art/p..
  9: (COMPILE-FILE #P"/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp" :OUTPUT-FILE #P"/Users/art/.cache/common-lisp/ccl-1.11-f96-macosx-x64/..
 10: (UIOP/UTILITY:CALL-WITH-MUFFLED-CONDITIONS #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL UIOP/LISP-BUILD:COMPILE-FILE*) #x302001CA2E8F> NIL)
 11: (UIOP/PATHNAME:CALL-WITH-ENOUGH-PATHNAME #P"/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp" NIL #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERN..
 12: (UIOP/LISP-BUILD:COMPILE-FILE* #P"/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/mito-20180430-git/src/core/dao/view.lisp" :OUTPUT-FILE #P"/Users/art/.cache/common-lisp/ccl-1.1..
 13: (FUNCALL #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL ASDF/LISP-ACTION:PERFORM-LISP-COMPILATION) #x302001C9B8BF>)
 14: (ASDF/LISP-ACTION:PERFORM-LISP-COMPILATION #<COMPILE-OP> #<CL-SOURCE-FILE "mito-core" "core-components" "dao-components" "view">)
 15: (CCL::%%BEFORE-AND-AFTER-COMBINED-METHOD-DCODE ((NIL) #<STANDARD-METHOD ASDF/ACTION:PERFORM (ASDF/LISP-ACTION:COMPILE-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)> #<COMPILE-OP> ..))
 16: (CCL::%CALL-NEXT-METHOD ((NIL) #<STANDARD-METHOD ASDF/ACTION:PERFORM (ASDF/LISP-ACTION:COMPILE-OP ASDF/LISP-ACTION:CL-SOURCE-FILE)> #<COMPILE-OP> ..))
 17: ((:INTERNAL ASDF/ACTION:CALL-WHILE-VISITING-ACTION))
 18: (CCL::%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD ASDF/ACTION:PERFORM :AROUND (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)> (#<STANDARD-METHOD ASDF/ACTION:PERFORM :BEFORE #>) ..)) 75523..
 19: (NIL #<Unknown Arguments>)
 20: (CCL::%CALL-NEXT-METHOD (NIL #<STANDARD-METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (T T)> . 75523886))
 21: (#<STANDARD-METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)> #<COMPILE-OP> #<CL-SOURCE-FILE "mito-core" "core-components" "dao-components" "view">)
 22: (CCL::%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS :AROUND (T T)> #<STANDARD-METHOD ASDF/ACTION:PERFORM-WITH-RESTARTS (T T)>) 75523886)
 23: (NIL #<Unknown Arguments>)
 24: (#<STANDARD-METHOD ASDF/PLAN:PERFORM-PLAN (T)> #<ASDF/PLAN:SEQUENTIAL-PLAN #x3020012FE3FD>)
 25: (CCL::%CALL-NEXT-METHOD (NIL #<STANDARD-METHOD ASDF/PLAN:PERFORM-PLAN (T)> . 75523950))
 26: (CCL::CALL-WITH-COMPILATION-UNIT #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::WITH-COMPILATION-UNIT-BODY (ASDF/PLAN:PERFORM-PLAN :AROUND (T))) #x24155EBF> :OVERRIDE NIL)
 27: (#<STANDARD-METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)> #<ASDF/PLAN:SEQUENTIAL-PLAN #x3020012FE3FD>)
 28: (CCL::%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD ASDF/PLAN:PERFORM-PLAN :AROUND (T)> #<STANDARD-METHOD ASDF/PLAN:PERFORM-PLAN (T)>) 75523950)
 29: (NIL #<Unknown Arguments>)
 30: (CCL::%%CHECK-KEYWORDS #(1 #() #<Combined-Method ASDF/PLAN:PERFORM-PLAN #x302000CD8A2F>) 75523963)
 31: (NIL #<Unknown Arguments>)
 32: (#<STANDARD-METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)> #<LOAD-OP> #<SYSTEM "mito"> :PLAN-CLASS NIL :PLAN-OPTIONS NIL)
 33: (CCL::%CALL-NEXT-METHOD ((NIL) #<STANDARD-METHOD ASDF/OPERATE:OPERATE (ASDF/OPERATION:OPERATION ASDF/COMPONENT:COMPONENT)> #<LOAD-OP> #<SYSTEM "mito"> :VERBOSE NIL))
 34: ((:INTERNAL (ASDF/OPERATE:OPERATE :AROUND (T T))))
 35: (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :AROUND (T T)> #<LOAD-OP> #<SYSTEM "mito"> :VERBOSE NIL)
 36: (CCL::%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :AROUND (T T)> (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :BEFORE #> #<#>) NIL ..))) 75524045)
 37: (NIL #<Unknown Arguments>)
 38: (CCL::%CALL-NEXT-METHOD ((NIL) #<STANDARD-METHOD ASDF/OPERATE:OPERATE (SYMBOL T)> ASDF/LISP-ACTION:LOAD-OP "mito" :VERBOSE NIL))
 39: ((:INTERNAL (ASDF/OPERATE:OPERATE :AROUND (T T))))
 40: (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :AROUND (T T)> ASDF/LISP-ACTION:LOAD-OP "mito" :VERBOSE NIL)
 41: (CCL::%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :AROUND (T T)> (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :BEFORE #>) NIL ..) 75524121)
 42: (NIL #<Unknown Arguments>)
 43: (ASDF/SESSION:CALL-WITH-ASDF-SESSION #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL (ASDF/OPERATE:OPERATE :AROUND (T T))) #x3020012EBEBF> :OVERRIDE T :KEY NIL :OVERRIDE-CACHE T :OVERRIDE-FORCING NIL)
 44: ((:INTERNAL (ASDF/OPERATE:OPERATE :AROUND (T T))))
 45: (ASDF/SESSION:CALL-WITH-ASDF-SESSION #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL (ASDF/OPERATE:OPERATE :AROUND (T T))) #x3020012EB76F> :OVERRIDE NIL :KEY NIL :OVERRIDE-CACHE NIL :OVERRIDE-FORCING NIL)
 46: (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :AROUND (T T)> ASDF/LISP-ACTION:LOAD-OP "mito" :VERBOSE NIL)
 47: (CCL::%%STANDARD-COMBINED-METHOD-DCODE (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :AROUND (T T)> (#<STANDARD-METHOD ASDF/OPERATE:OPERATE :BEFORE #>) NIL ..) 75524215)
 48: (NIL #<Unknown Arguments>)
 49: (ASDF/OPERATE:LOAD-SYSTEM "mito" :VERBOSE NIL)

This is with sxql version from 2017-08-30:

CL-USER> (ql:where-is-system :sxql)
#P"/Users/art/projects/lisp/skazkorama/quicklisp/dists/quicklisp/software/sxql-20170830-git/"

":NULL fell through ETYPECASE expression" for nullable column

Seems with commit be0ea57 we broke a selection of the nullable columns

How to reproduce

Create a class like this:

(defclass test-project ()
  ((processed-at :col-type (or :timestamptz :null)
                        :initarg :processed-at
                        :initform nil
                        :accessor get-processed-at
                        :documentation "Date and time a check was finished at."))
  (:metaclass dao-table-class))

Then execute:

(mito:count-dao 'test-project :processed-at :null)

It should produce a following error:

:NULL fell through ETYPECASE expression.
Wanted one of (INTEGER LOCAL-TIME:TIMESTAMP STRING NULL).
   [Condition of type SB-KERNEL:CASE-FAILURE]

Restarts:
 0: [RETRY] Retry SLY mREPL evaluation request.
 1: [*ABORT] Return to SLY's top level.
 2: [ABORT] abort thread (#<THREAD "sly-channel-1-mrepl-remote-1" RUNNING {100BE7EAD3}>)

Backtrace:
 0: ((:METHOD MITO.DAO.COLUMN:DEFLATE-FOR-COL-TYPE ((EQL :DATETIME) T)) #<unused argument> :NULL) [fast-method]
 1: (MITO.DAO::WHERE-AND (:PROCESSED-AT :NULL) #<DAO-TABLE-CLASS ULTRALISP/MODELS/CHECK::TEST-PROJECT>)
 2: (MITO.DAO:COUNT-DAO #<DAO-TABLE-CLASS ULTRALISP/MODELS/CHECK::TEST-PROJECT> :PROCESSED-AT :NULL)
 3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MITO.DAO:COUNT-DAO (QUOTE TEST-PROJECT) :PROCESSED-AT :NULL) #<NULL-LEXENV>)
 4: (EVAL (MITO.DAO:COUNT-DAO (QUOTE TEST-PROJECT) :PROCESSED-AT :NULL))
 5: ((LAMBDA NIL :IN SLYNK-MREPL::MREPL-EVAL-1))

It worked before the be0ea57 commit.

Trying to call with nil instead of :null does not work either:

(mito:count-dao 'test-project :processed-at nil)

however error is different:

There is no primary method for the generic function
  #<STANDARD-GENERIC-FUNCTION SXQL.SQL-TYPE:YIELD (58)>
when called with arguments
  (NIL).
   [Condition of type SB-PCL::NO-PRIMARY-METHOD-ERROR]

Restarts:
 0: [RETRY] Retry calling the generic function.
 1: [RETRY] Retry SLY mREPL evaluation request.
 2: [*ABORT] Return to SLY's top level.
 3: [ABORT] abort thread (#<THREAD "sly-channel-1-mrepl-remote-1" RUNNING {100BE7EAD3}>)

Backtrace:
 0: ((:METHOD SB-PCL::NO-PRIMARY-METHOD (T)) #<STANDARD-GENERIC-FUNCTION SXQL.SQL-TYPE:YIELD (58)> NIL) [fast-method]
 1: ((LAMBDA (SB-PCL::.ARG0. SB-INT:&MORE SB-PCL::.DFUN-MORE-CONTEXT. SB-PCL::.DFUN-MORE-COUNT.) :IN "/root/.cache/common-lisp/sbcl-1.4.11-linux-x64/app/quicklisp/dists/ultralisp/software/fukamachi-mito-2..
 2: (SB-PCL::CALL-NO-PRIMARY-METHOD #<STANDARD-GENERIC-FUNCTION SXQL.SQL-TYPE:YIELD (58)> (NIL))
 3: ((FLET SB-PCL::%NO-PRIMARY-METHOD) #<STANDARD-GENERIC-FUNCTION SXQL.SQL-TYPE:YIELD (58)> (NIL))
 4: ((SB-PCL::EMF SXQL.SQL-TYPE:YIELD) #<unused argument> #<unused argument> NIL)
 5: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:INFIX-OP)) #<error printing object>) [fast-method]
 6: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
 7: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:CONJUNCTIVE-OP)) #<error printing object>) [fast-method]
 8: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
 9: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:CONJUNCTIVE-OP)) #<error printing object>) [fast-method]
10: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
11: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:EXPRESSION-CLAUSE)) #<error printing object>) [fast-method]
12: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
13: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:SQL-COMPOSED-STATEMENT)) #<error printing object>) [fast-method]
14: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.STATEMENT:SELECT-STATEMENT)) #<error printing object>) [fast-method]
15: ((SB-PCL::EMF SXQL.SQL-TYPE:YIELD) #<error printing object>)
16: ((:METHOD MITO.DB:RETRIEVE-BY-SQL (SXQL.SQL-TYPE:SQL-STATEMENT)) #<error printing object>) [fast-method]
17: ((SB-PCL::EMF MITO.DB:RETRIEVE-BY-SQL) #<error printing object>)
18: (MITO.DAO:COUNT-DAO #<DAO-TABLE-CLASS ULTRALISP/MODELS/CHECK::TEST-PROJECT> :PROCESSED-AT NIL)

The same problem with retrieve-dao and find-dao.

Don't know how to solve this problem.

transactions and rollbacks.

Does mito exposes a way to explicitly handle transactions?
I have a use case in which I would like to update a object along with objects related to it, i.e. an album and it's songs, I'm not aware of a way to update nested objects with mito, I can do it in an iterative way though. The thing is I would like the transaction to rollback if an operation with an object related to the main object fails or if I explicitly raise a condition, is there a way to do it in mito?

Does not load on ABCL 1.8.0 on Windows

When trying to load mito using quicklisp I receive the following error:

There is no applicable method for the generic function #<STANDARD-GENERIC-FUNCTION MOP:SLOT-BOUNDP-USING-CLASS {67BC38A7}> when called with arguments (#<BUILT-IN-CLASS SYMBOL {44F2CAE5}>
:ALLOCATION-CLASS
NIL).
[Condition of type SIMPLE-ERROR]

Backtrace:
0: (INVOKE-DEBUGGER #<SIMPLE-ERROR {78874F63}>)
1: (ERROR "There is no applicable method for the generic function ~S when called with arguments ~S." #<STANDARD-GENERIC-FUNCTION MOP:SLOT-BOUNDP-USING-CLASS {67BC38A7}> (#<BUILT-IN-CLASS SYMBOL {44F2CAE5..
2: (NO-APPLICABLE-METHOD #<STANDARD-GENERIC-FUNCTION MOP:SLOT-BOUNDP-USING-CLASS {67BC38A7}> #<BUILT-IN-CLASS SYMBOL {44F2CAE5}> :ALLOCATION-CLASS NIL)
3: (APPLY #<LOCAL-FUNCTION NO-APPLICABLE-METHOD IN METHOD MAKE-LOAD-FORM NIL (T) {7F528E64}> #<STANDARD-GENERIC-FUNCTION MOP:SLOT-BOUNDP-USING-CLASS {67BC38A7}> (#<BUILT-IN-CLASS SYMBOL {44F2CAE5}> ..))
4: (MOP:SLOT-BOUNDP-USING-CLASS #<BUILT-IN-CLASS SYMBOL {44F2CAE5}> :ALLOCATION-CLASS NIL)
5: (SLOT-BOUNDP :ALLOCATION-CLASS MITO.CLASS.COLUMN::COL-TYPE)
6: (#<LOCAL-FUNCTION IN METHOD INITIALIZE-INSTANCE (AROUND) (TABLE-COLUMN-CLASS) {3529C3A4}> #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS {13AF8DF3}> :ALLOCATION-CLASS #<MITO.DAO.MIXIN:DAO-TABLE-MIXIN MITO.D..
7: (APPLY #<LOCAL-FUNCTION IN METHOD INITIALIZE-INSTANCE (AROUND) (TABLE-COLUMN-CLASS) {3529C3A4}> (#<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS {13AF8DF3}> :ALLOCATION-CLASS ..))
8: (#<LOCAL-FUNCTION IN GENERATE-EMF-LAMBDA {6195A2D4}> (#<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS {13AF8DF3}> :ALLOCATION-CLASS ..))
9: (#<LOCAL-FUNCTION IN METHOD INITIALIZE-INSTANCE (AROUND) (DAO-TABLE-COLUMN-CLASS) {1A5A79A1}> #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS {13AF8DF3}> :ALLOCATION-CLASS #<MITO.DAO.MIXIN:DAO-TABLE-MIXIN MI..
10: (APPLY #<LOCAL-FUNCTION IN METHOD INITIALIZE-INSTANCE (AROUND) (DAO-TABLE-COLUMN-CLASS) {1A5A79A1}> #<MITO.DAO.COLUMN:DAO-TABLE-COLUMN-CLASS {13AF8DF3}> (:ALLOCATION-CLASS ..))

results of (lisp-implementation-version):
1.8.0
OpenJDK_64-Bit_Server_VM-Red_Hat,_Inc.-11.0.11+9-LTS
amd64-Windows_10-10.0

Table-definition does not work if field is specified

When I'm trying this code from README:

(mito:deftable user ()
  ((name :col-type (:varchar 64))
   (email :col-type (or (:varchar 128) :null))))

(mito:deftable tweet ()
  ((status :col-type :text)
   ;; This slot refers to USER class
   (user-id :references (user id))))

(mito:table-definition (find-class 'tweet))

it raises this error:

NIL can't be destructured against the lambda list (TYPE
                                                   &OPTIONAL
                                                   SXQL.CLAUSE::ARGS
                                                   &REST
                                                   SXQL.CLAUSE::ATTRS), because it does not contain at least 1 elements.
   [Condition of type CCL::SIMPLE-PROGRAM-ERROR]

Restarts:
 0: [RETRY] Retry SLY mREPL evaluation request.
 1: [*ABORT] Return to SLY's top level.
 2: [ABORT-BREAK] Reset this thread
 3: [ABORT] Kill this thread

Backtrace:
 0: (CCL::PREPARE-TO-DESTRUCTURE NIL (TYPE &OPTIONAL SXQL.CLAUSE::ARGS &REST SXQL.CLAUSE::ATTRS) 1 NIL)
 1: (SXQL.CLAUSE::MAKE-SQL-COLUMN-TYPE-FROM-LIST NIL)
 2: (SXQL.CLAUSE:MAKE-COLUMN-DEFINITION-CLAUSE #S(SXQL.SQL-TYPE:SQL-SYMBOL :NAME "user_id") :TYPE NIL :AUTO-INCREMENT NIL :PRIMARY-KEY NIL :NOT-NULL T)
 3: (#<STANDARD-METHOD SXQL.STATEMENT:MAKE-STATEMENT ((EQL :CREATE-TABLE))> :CREATE-TABLE (#S(SXQL.SQL-TYPE:SQL-SYMBOL :NAME "tweet") :IF-NOT-EXISTS NIL) ((#S(SXQL.SQL-TYPE:SQL-SYMBOL :NAME "id") ..))))))
 4: (NIL #<Unknown Arguments>)
 5: (#<STANDARD-METHOD MITO.CLASS:CREATE-TABLE-SXQL (T T)> #<MITO.DAO.TABLE:DAO-TABLE-CLASS TWEET> :POSTGRES :IF-NOT-EXISTS NIL)
 6: (CCL::%%CHECK-KEYWORDS #(2 #(:IF-NOT-EXISTS) #<CCL:METHOD-FUNCTION MITO.CLASS:CREATE-TABLE-SXQL (T T)>) 75524340)
 7: (NIL #<Unknown Arguments>)
 8: (CCL::CALL-CHECK-REGS MITO.DAO.VIEW:TABLE-DEFINITION #<MITO.DAO.TABLE:DAO-TABLE-CLASS TWEET>)
 9: (CCL::CHEAP-EVAL (MITO.DAO.VIEW:TABLE-DEFINITION (FIND-CLASS 'TWEET)))

However, when I specify only a type, then everything works as expected:

(mito:deftable tweet ()
  ((status :col-type :text)
   ;; This slot refers to USER class
   (user-id :references user)))

(mito:table-definition (find-class 'tweet))
(#<SXQL-STATEMENT: CREATE TABLE tweet (
    id BIGSERIAL NOT NULL PRIMARY KEY,
    status TEXT NOT NULL,
    user_id BIGINT NOT NULL,
    created_at TIMESTAMPTZ,
    updated_at TIMESTAMPTZ
)>)

What is wrong?

LIST column type and automatically handling many-to-many relations

The proposal is to add a column type like (list :integer) which will create a separate table to store list items. List items are all eagerly fetched. Also, handle types like (list person) to create many-to-many relations with optional eager loading (with includes).

Do you think it's a good fit for mito or is it too far from plain SQL?

Proposal to check early for null values (on `find-dao` and friends)

Hi,

When I call find-dao 'my-model :my-slot (get-data) but (get-data) is buggy and returns NIL instead of a value, I get a large stacktrace which goes down to SXQL:

There is no primary method for the generic function
  #<STANDARD-GENERIC-FUNCTION SXQL.SQL-TYPE:YIELD (58)>
when called with arguments
  (NIL).
   [Condition of type SB-PCL::NO-PRIMARY-METHOD-ERROR]
See also:
  Common Lisp Hyperspec, 7.6.6.2 [:section]

Restarts:
 0: [RETRY] Retry calling the generic function.
 1: [RETRY] Retry SLIME REPL evaluation request.
 2: [*ABORT] Return to SLIME's top level.
 3: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {1005F41B63}>)

Backtrace:
  0: ((:METHOD SB-PCL::NO-PRIMARY-METHOD (T)) #<STANDARD-GENERIC-FUNCTION SXQL.SQL-TYPE:YIELD (58)> NIL) [fast-method]
  1: (SB-PCL::CALL-NO-PRIMARY-METHOD #<STANDARD-GENERIC-FUNCTION SXQL.SQL-TYPE:YIELD (58)> (NIL))
  2: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:INFIX-OP)) #<error printing object>) [fast-method]
  3: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
  4: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:CONJUNCTIVE-OP)) #<error printing object>) [fast-method]
  5: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
  6: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:CONJUNCTIVE-OP)) #<error printing object>) [fast-method]
  7: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
  8: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:EXPRESSION-CLAUSE)) #<error printing object>) [fast-method]
  9: ((:METHOD SXQL.SQL-TYPE:YIELD :AROUND (T)) #<error printing object>) [fast-method]
 10: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.SQL-TYPE:SQL-COMPOSED-STATEMENT)) #<error printing object>) [fast-method]
 11: ((:METHOD SXQL.SQL-TYPE:YIELD (SXQL.STATEMENT:SELECT-STATEMENT)) #<error printing object>) [fast-method]
 12: ((SB-PCL::EMF SXQL.SQL-TYPE:YIELD) #<error printing object>)
 13: ((:METHOD MITO.DB:RETRIEVE-BY-SQL (SXQL.SQL-TYPE:SQL-STATEMENT)) #<error printing object>) [fast-method]
 14: ((SB-PCL::EMF MITO.DB:RETRIEVE-BY-SQL) #<error printing object>)
 15: (MITO.DAO:SELECT-BY-SQL #<error printing object>)
 16: (MITO.DAO:FIND-DAO #<MITO.DAO.TABLE:DAO-TABLE-CLASS FEL/MODELS::AUTHOR> :ISNI NIL)
 17: (MAKE-CARD-FROM-DICT #<HASH-TABLE :TEST EQUAL :COUNT 31 {1002316D93}> :DB-SAVE NIL :FORCE T)
 18: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MAKE-CARD-FROM-DICT *CARD* :FORCE T) #<NULL-LEXENV>)

I propose to check early for null values in find-dao (and friends) to get a smaller stacktrace like this one:

The value for the slot :ISNI should not be null (NIL)
   [Condition of type SIMPLE-ERROR]

Restarts:
 0: [RETRY] Retry SLIME REPL evaluation request.
 1: [*ABORT] Return to SLIME's top level.
 2: [ABORT] abort thread (#<THREAD "repl-thread" RUNNING {1005F41B63}>)

Backtrace:
  0: (MITO.DAO::WHERE-AND (:ISNI NIL) #<MITO.DAO.TABLE:DAO-TABLE-CLASS FEL/MODELS::AUTHOR>)
  1: (MITO.DAO:FIND-DAO #<MITO.DAO.TABLE:DAO-TABLE-CLASS FEL/MODELS::AUTHOR> :ISNI NIL)
  2: (MAKE-CARD-FROM-DICT #<HASH-TABLE :TEST EQUAL :COUNT 31 {1002316D93}> :DB-SAVE NIL :FORCE T)
  3: (SB-INT:SIMPLE-EVAL-IN-LEXENV (MAKE-CARD-FROM-DICT *CARD* :FORCE T) #<NULL-LEXENV>)

I got this by adding this check in the where-and function:

                    unless slot
                      do (error "Class ~S does not have a slot named ~S" class field)
                    unless value  ;; <-- added
                      do (error "The value for the slot ~S should not be null (~S)" field value)

What do you think and how to check this in select-dao (it doesn't use where-and)?

Best,

Unique keys on reference columns generate incorrect table definitions

Defining a class like so:

(defclass tweet ()
  ((user :col-type user :references user)
   (content :col-type :text))
  (:metaclass mito:dao-table-class)
  (:unique-keys user))

Causes a table definition with (mito:table-definition 'tweet) of

CREATE TABLE tweet (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    content TEXT NOT NULL,
    user_id INTEGER NOT NULL,
    created_at TIMESTAMP,
    updated_at TIMESTAMP,
    UNIQUE (user),
    UNIQUE (user_id)
)

where the UNIQUE (user) is invalid because the real column name is user_id. It seems like this is because mito.dao.table::expand-relational-keys expands they unique-keys slot on the table definition to be

CL-USER> (slot-value (find-class 'tweet) 'mito.class.table::unique-keys)
(USER USER-ID)

even though it looks like that function is trying to filter out ghost slots. Using sqlite, I get this <dbi-programming-error>:

DB Error: expressions prohibited in PRIMARY KEY and UNIQUE constraints (Code: ERROR)
   [Condition of type DBI.ERROR:<DBI-PROGRAMMING-ERROR>]

DB Error: NOT NULL constraint failed: content.user_id (Code: CONSTRAINT)

CL-USER> (ql:quickload :mito)
CL-USER> (mito:connect-toplevel sqlite3 :database-name "mito-test.db")
CL-USER> (mito:deftable user ()
((user :col-type :text
:initarg :user
:accessor username)))
CL-USER> (mito:ensure-table-exists 'user)
;; CREATE TABLE "user" (
;; "id" INTEGER PRIMARY KEY AUTOINCREMENT,
;; "user" TEXT NOT NULL,
;; "created_at" TIMESTAMP,
;; "updated_at" TIMESTAMP
;; ) () [0 rows] | MITO.DB:EXECUTE-SQL
(#<SXQL-STATEMENT: CREATE TABLE user (
id INTEGER PRIMARY KEY AUTOINCREMENT,
user TEXT NOT NULL,
created_at TIMESTAMP,
updated_at TIMESTAMP
)>)
CL-USER> (mito:deftable content ()
((body :col-type :text
:initarg :body
:accessor :content-body)
(user :col-type user)))
#<MITO.DAO.TABLE:DAO-TABLE-CLASS COMMON-LISP-USER::CONTENT>
CL-USER> (mito:ensure-table-exists 'content)
;; CREATE TABLE "content" (
;; "id" INTEGER PRIMARY KEY AUTOINCREMENT,
;; "body" TEXT NOT NULL,
;; "user_id" INTEGER NOT NULL,
;; "created_at" TIMESTAMP,
;; "updated_at" TIMESTAMP
;; ) () [0 rows] | MITO.DB:EXECUTE-SQL
(#<SXQL-STATEMENT: CREATE TABLE content (
id INTEGER PRIMARY KEY AUTOINCREMENT,
body TEXT NOT NULL,
user_id INTEGER NOT NULL,
created_at TIMESTAMP,
updated_at TIMESTAMP
)>)
CL-USER> (defvar test-user (mito:create-dao 'user :user "rnfn"))
CL-USER> (mito:create-dao 'content :body "test content" :user test-user)

I follow the relationship tutorial, but i always get "DB Error: NOT NULL constraint failed: content.user_id (Code: CONSTRAINT)" when inserting table. Database is sqlite3.

Implicit dynamic system loading is EVIL

During the investigation of this issue: roswell/roswell#404

I found that mito calling (ql:quickload) in the Lisp code.

In my humble opinion it is not a good practice to do so, for the following reason:

  1. As you can see, it makes core dump not working.
  2. This enforces the user to use QuickLisp for no reason.

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    ๐Ÿ–– Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. ๐Ÿ“Š๐Ÿ“ˆ๐ŸŽ‰

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google โค๏ธ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.