Generate down migration files. (PostgreSQL and MySQL).

mito-core.asd

@@ -19,7 +19,7 @@
                 ((:file "dao" :depends-on ("dao-components"))
                  (:module "dao-components"
                   :pathname "dao"
-                  :depends-on ("connection" "class" "db" "logger" "util")
+                  :depends-on ("connection" "class" "db" "conversion" "logger" "util")
                   :components
                   ((:file "table" :depends-on ("column" "mixin" "view"))
                    (:file "view" :depends-on ("column"))
@@ -42,6 +42,7 @@
                   ((:file "mysql")
                    (:file "postgres")
                    (:file "sqlite3")))
+                 (:file "conversion")
                  (:file "logger")
                  (:file "error")
                  (:file "util")))))

src/core/conversion.lisp

@@ -0,0 +1,48 @@
+(defpackage mito.conversion
+  (:use :cl)
+  (:import-from :local-time)
+  (:export :convert-for-driver-type))
+(in-package :mito.conversion)
+
+(defvar *db-datetime-format*
+  '((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6) :gmt-offset-or-z))
+
+(defvar *db-datetime-format-without-timezone*
+  '((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6)))
+
+(defvar *db-date-format*
+  '((:year 4) #\- (:month 2) #\- (:day 2)))
+
+(defgeneric convert-for-driver-type (driver-type col-type value)
+  (:method (driver-type col-type value)
+    (declare (ignore driver-type col-type))
+    value)
+  (:method (driver-type col-type (value string))
+    (declare (ignore driver-type col-type))
+    value)
+  (:method ((driver-type (eql :mysql)) (col-type (eql :boolean)) value)
+    (ecase value
+      (t 1)
+      ('nil 0)))
+  (:method ((driver-type (eql :mysql)) (col-type (eql :datetime)) (value local-time:timestamp))
+    (local-time:format-timestring nil value
+                                  :format *db-datetime-format-without-timezone*))
+  (:method (driver-type (col-type (eql :datetime)) (value local-time:timestamp))
+    (local-time:format-timestring nil value
+                                  :format *db-datetime-format*
+                                  :timezone local-time:+gmt-zone+))
+  (:method (driver-type (col-type (eql :date)) (value local-time:timestamp))
+    (local-time:format-timestring nil value
+                                  :format *db-date-format*))
+  (:method (driver-type (col-type (eql :timestamp)) value)
+    (convert-for-driver-type driver-type :datetime value))
+  (:method (driver-type (col-type (eql :timestamptz)) value)
+    (convert-for-driver-type driver-type :datetime value))
+  (:method ((driver-type (eql :sqlite3)) (col-type (eql :boolean)) value)
+    (ecase value
+      (t 1)
+      ('nil 0)))
+  (:method ((driver-type (eql :postgres)) (col-type (eql :boolean)) value)
+    (ecase value
+      (t '(:raw "true"))
+      ('nil '(:raw "false")))))

src/core/dao.lisp

@@ -7,6 +7,8 @@
             #:mito.class)
       (:import-from #:mito.dao.column
                     #:dao-table-column-deflate)
+      (:import-from #:mito.conversion
+                    #:convert-for-driver-type)
       (:import-from #:mito.connection
                     #:*connection*
                     #:check-connected
@@ -39,8 +41,7 @@
                     #:ensure-list
                     #:once-only
                     #:with-gensyms)
-      (:export #:convert-for-driver-type
-               #:insert-dao
+      (:export #:insert-dao
                #:update-dao
                #:create-dao
                #:delete-dao
@@ -75,49 +76,6 @@
                 t)
         (values nil nil))))
 
-(defvar *db-datetime-format*
-  '((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6) :gmt-offset-or-z))
-
-(defvar *db-datetime-format-without-timezone*
-  '((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6)))
-
-(defvar *db-date-format*
-  '((:year 4) #\- (:month 2) #\- (:day 2)))
-
-(defgeneric convert-for-driver-type (driver-type col-type value)
-  (:method (driver-type col-type value)
-    (declare (ignore driver-type col-type))
-    value)
-  (:method (driver-type col-type (value string))
-    (declare (ignore driver-type col-type))
-    value)
-  (:method ((driver-type (eql :mysql)) (col-type (eql :boolean)) value)
-    (ecase value
-      (t 1)
-      ('nil 0)))
-  (:method ((driver-type (eql :mysql)) (col-type (eql :datetime)) (value local-time:timestamp))
-    (local-time:format-timestring nil value
-                                  :format *db-datetime-format-without-timezone*))
-  (:method (driver-type (col-type (eql :datetime)) (value local-time:timestamp))
-    (local-time:format-timestring nil value
-                                  :format *db-datetime-format*
-                                  :timezone local-time:+gmt-zone+))
-  (:method (driver-type (col-type (eql :date)) (value local-time:timestamp))
-    (local-time:format-timestring nil value
-                                  :format *db-date-format*))
-  (:method (driver-type (col-type (eql :timestamp)) value)
-    (convert-for-driver-type driver-type :datetime value))
-  (:method (driver-type (col-type (eql :timestamptz)) value)
-    (convert-for-driver-type driver-type :datetime value))
-  (:method ((driver-type (eql :sqlite3)) (col-type (eql :boolean)) value)
-    (ecase value
-      (t 1)
-      ('nil 0)))
-  (:method ((driver-type (eql :postgres)) (col-type (eql :boolean)) value)
-    (ecase value
-      (t '(:raw "true"))
-      ('nil '(:raw "false")))))
-
 (defun make-set-clause (obj)
   (let ((class (class-of obj)))
     (apply #'sxql:make-clause :set=

src/core/dao/column.lisp

@@ -4,9 +4,13 @@
         #:mito.util)
   (:import-from #:mito.class.column
                 #:table-column-class
-                #:table-column-type)
+                #:table-column-type
+                #:table-column-info)
+  (:import-from #:mito.conversion
+                #:convert-for-driver-type)
   (:import-from #:local-time)
   (:import-from #:cl-ppcre)
+  (:import-from #:closer-mop)
   (:export #:dao-table-column-class
            #:dao-table-column-inflate
            #:dao-table-column-deflate
@@ -141,3 +145,15 @@
     (deflate-for-col-type :datetime value))
   (:method ((col-type (eql :timestamptz)) value)
     (deflate-for-col-type :datetime value)))
+
+(defmethod table-column-info :around ((column dao-table-column-class) driver-type)
+  (let ((column-info (call-next-method)))
+    (when (and (null (getf (cdr column-info) :default))
+               (c2mop:slot-definition-initfunction column))
+      (setf (getf (cdr column-info) :default)
+            (convert-for-driver-type
+             driver-type
+             (table-column-type column)
+             (dao-table-column-deflate column
+                                       (funcall (c2mop:slot-definition-initfunction column))))))
+    column-info))

src/core/dao/view.lisp

@@ -38,6 +38,22 @@
             (sxql:yield (create-view-view-name statement))
             (create-view-as statement))))
 
+(defstruct (drop-view (:include sxql.sql-type:sql-statement (sxql.sql-type:name "DROP VIEW"))
+                      (:constructor make-drop-view (view-name &key if-exists)))
+  view-name
+  if-exists)
+
+(defmethod sxql:make-statement ((statement-name (eql :drop-view)) &rest args)
+  (destructuring-bind (view-name &key if-exists)
+      args
+    (make-drop-view (sxql.operator:detect-and-convert view-name) :if-exists if-exists)))
+
+(defmethod sxql:yield ((statement drop-view))
+  (sxql.sql-type:with-yield-binds
+      (format nil "DROP~:[~; IF EXISTS~] VIEW ~A"
+              (drop-view-if-exists statement)
+              (drop-view-view-name statement))))
+
 (defgeneric table-definition (class &key if-not-exists or-replace)
   (:method ((class symbol) &rest args &key if-not-exists or-replace)
     (declare (ignore if-not-exists or-replace))

src/core/db/mysql.lisp

@@ -71,7 +71,8 @@
                                    :auto-increment (string= (getf column :|Extra|) "auto_increment")
                                    :primary-key (string= (getf column :|Key|) "PRI")
                                    :not-null (or (string= (getf column :|Key|) "PRI")
-                                                 (string= (getf column :|Null|) "NO"))))))
+                                                 (string= (getf column :|Null|) "NO"))
+                                   :default (getf column :|Default|)))))
         ;; Set :primary-key NIL if there's a composite primary key.
         (if (< 1 (count-if (lambda (def)
                              (getf (cdr def) :primary-key))

src/core/db/postgres.lisp

@@ -58,10 +58,14 @@
                         ~%    CASE~
                         ~%        WHEN p.contype = 'p' THEN true~
                         ~%        ELSE false~
-                        ~%    END AS primary~
+                        ~%    END AS primary,~
+                        ~%    CASE~
+                        ~%        WHEN f.atthasdef THEN pg_get_expr(d.adbin, d.adrelid)~
+                        ~%    END AS default~
                         ~%FROM pg_attribute f~
                         ~%    JOIN pg_class c ON c.oid = f.attrelid~
                         ~%    LEFT JOIN pg_constraint p ON p.conrelid = f.attrelid AND f.attnum = ANY (p.conkey)~
+                        ~%    LEFT JOIN pg_attrdef d ON d.adrelid = c.oid~
                         ~%WHERE c.relkind = 'r'::char~
                         ~%    AND c.relname = '~A'~
                         ~%    AND f.attnum > 0~
@@ -73,14 +77,19 @@
                (loop with results = (dbi:execute query)
                      for column = (dbi:fetch results)
                      while column
-                     collect (list (getf column :|name|)
-                                   :type (getf column :|type|)
-                                   :auto-increment (not (null (member (getf column :|name|)
+                     collect (let ((auto-increment (not (null (member (getf column :|name|)
                                                                       serial-keys
-                                                                      :test #'string=)))
-                                   :primary-key (getf column :|primary|)
-                                   :not-null (or (getf column :|primary|)
-                                                 (getf column :|notnull|))))
+                                                                      :test #'string=)))))
+                               (list (getf column :|name|)
+                                     :type (getf column :|type|)
+                                     :auto-increment auto-increment
+                                     :primary-key (getf column :|primary|)
+                                     :not-null (or (getf column :|primary|)
+                                                   (getf column :|notnull|))
+                                     :default (if (or auto-increment
+                                                      (eq :null (getf column :|default|)))
+                                                  nil
+                                                  (getf column :|default|)))))
                :key #'car
                :test #'string=
                :from-end t)))