Skip to content

Commit e343c92

Browse files
fukamachifukamachi
committed
Generate down migration files. (PostgreSQL and MySQL).
1 parent aa8e679 commit e343c92

File tree

12 files changed

+369
-305
lines changed

12 files changed

+369
-305
lines changed

‎mito-core.asd

+2-1
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
((:file "dao" :depends-on ("dao-components"))
2020
(:module "dao-components"
2121
:pathname "dao"
22-
:depends-on ("connection" "class" "db" "logger" "util")
22+
:depends-on ("connection" "class" "db" "conversion" "logger" "util")
2323
:components
2424
((:file "table" :depends-on ("column" "mixin" "view"))
2525
(:file "view" :depends-on ("column"))
@@ -42,6 +42,7 @@
4242
((:file "mysql")
4343
(:file "postgres")
4444
(:file "sqlite3")))
45+
(:file "conversion")
4546
(:file "logger")
4647
(:file "error")
4748
(:file "util")))))

‎src/core/conversion.lisp

+48
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
(defpackage mito.conversion
2+
(:use :cl)
3+
(:import-from :local-time)
4+
(:export :convert-for-driver-type))
5+
(in-package :mito.conversion)
6+
7+
(defvar *db-datetime-format*
8+
'((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6) :gmt-offset-or-z))
9+
10+
(defvar *db-datetime-format-without-timezone*
11+
'((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6)))
12+
13+
(defvar *db-date-format*
14+
'((:year 4) #\- (:month 2) #\- (:day 2)))
15+
16+
(defgeneric convert-for-driver-type (driver-type col-type value)
17+
(:method (driver-type col-type value)
18+
(declare (ignore driver-type col-type))
19+
value)
20+
(:method (driver-type col-type (value string))
21+
(declare (ignore driver-type col-type))
22+
value)
23+
(:method ((driver-type (eql :mysql)) (col-type (eql :boolean)) value)
24+
(ecase value
25+
(t 1)
26+
('nil 0)))
27+
(:method ((driver-type (eql :mysql)) (col-type (eql :datetime)) (value local-time:timestamp))
28+
(local-time:format-timestring nil value
29+
:format *db-datetime-format-without-timezone*))
30+
(:method (driver-type (col-type (eql :datetime)) (value local-time:timestamp))
31+
(local-time:format-timestring nil value
32+
:format *db-datetime-format*
33+
:timezone local-time:+gmt-zone+))
34+
(:method (driver-type (col-type (eql :date)) (value local-time:timestamp))
35+
(local-time:format-timestring nil value
36+
:format *db-date-format*))
37+
(:method (driver-type (col-type (eql :timestamp)) value)
38+
(convert-for-driver-type driver-type :datetime value))
39+
(:method (driver-type (col-type (eql :timestamptz)) value)
40+
(convert-for-driver-type driver-type :datetime value))
41+
(:method ((driver-type (eql :sqlite3)) (col-type (eql :boolean)) value)
42+
(ecase value
43+
(t 1)
44+
('nil 0)))
45+
(:method ((driver-type (eql :postgres)) (col-type (eql :boolean)) value)
46+
(ecase value
47+
(t '(:raw "true"))
48+
('nil '(:raw "false")))))

‎src/core/dao.lisp

+3-45
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@
77
#:mito.class)
88
(:import-from #:mito.dao.column
99
#:dao-table-column-deflate)
10+
(:import-from #:mito.conversion
11+
#:convert-for-driver-type)
1012
(:import-from #:mito.connection
1113
#:*connection*
1214
#:check-connected
@@ -39,8 +41,7 @@
3941
#:ensure-list
4042
#:once-only
4143
#:with-gensyms)
42-
(:export #:convert-for-driver-type
43-
#:insert-dao
44+
(:export #:insert-dao
4445
#:update-dao
4546
#:create-dao
4647
#:delete-dao
@@ -75,49 +76,6 @@
7576
t)
7677
(values nil nil))))
7778

78-
(defvar *db-datetime-format*
79-
'((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6) :gmt-offset-or-z))
80-
81-
(defvar *db-datetime-format-without-timezone*
82-
'((:year 4) #\- (:month 2) #\- (:day 2) #\Space (:hour 2) #\: (:min 2) #\: (:sec 2) #\. (:usec 6)))
83-
84-
(defvar *db-date-format*
85-
'((:year 4) #\- (:month 2) #\- (:day 2)))
86-
87-
(defgeneric convert-for-driver-type (driver-type col-type value)
88-
(:method (driver-type col-type value)
89-
(declare (ignore driver-type col-type))
90-
value)
91-
(:method (driver-type col-type (value string))
92-
(declare (ignore driver-type col-type))
93-
value)
94-
(:method ((driver-type (eql :mysql)) (col-type (eql :boolean)) value)
95-
(ecase value
96-
(t 1)
97-
('nil 0)))
98-
(:method ((driver-type (eql :mysql)) (col-type (eql :datetime)) (value local-time:timestamp))
99-
(local-time:format-timestring nil value
100-
:format *db-datetime-format-without-timezone*))
101-
(:method (driver-type (col-type (eql :datetime)) (value local-time:timestamp))
102-
(local-time:format-timestring nil value
103-
:format *db-datetime-format*
104-
:timezone local-time:+gmt-zone+))
105-
(:method (driver-type (col-type (eql :date)) (value local-time:timestamp))
106-
(local-time:format-timestring nil value
107-
:format *db-date-format*))
108-
(:method (driver-type (col-type (eql :timestamp)) value)
109-
(convert-for-driver-type driver-type :datetime value))
110-
(:method (driver-type (col-type (eql :timestamptz)) value)
111-
(convert-for-driver-type driver-type :datetime value))
112-
(:method ((driver-type (eql :sqlite3)) (col-type (eql :boolean)) value)
113-
(ecase value
114-
(t 1)
115-
('nil 0)))
116-
(:method ((driver-type (eql :postgres)) (col-type (eql :boolean)) value)
117-
(ecase value
118-
(t '(:raw "true"))
119-
('nil '(:raw "false")))))
120-
12179
(defun make-set-clause (obj)
12280
(let ((class (class-of obj)))
12381
(apply #'sxql:make-clause :set=

‎src/core/dao/column.lisp

+17-1
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,13 @@
44
#:mito.util)
55
(:import-from #:mito.class.column
66
#:table-column-class
7-
#:table-column-type)
7+
#:table-column-type
8+
#:table-column-info)
9+
(:import-from #:mito.conversion
10+
#:convert-for-driver-type)
811
(:import-from #:local-time)
912
(:import-from #:cl-ppcre)
13+
(:import-from #:closer-mop)
1014
(:export #:dao-table-column-class
1115
#:dao-table-column-inflate
1216
#:dao-table-column-deflate
@@ -141,3 +145,15 @@
141145
(deflate-for-col-type :datetime value))
142146
(:method ((col-type (eql :timestamptz)) value)
143147
(deflate-for-col-type :datetime value)))
148+
149+
(defmethod table-column-info :around ((column dao-table-column-class) driver-type)
150+
(let ((column-info (call-next-method)))
151+
(when (and (null (getf (cdr column-info) :default))
152+
(c2mop:slot-definition-initfunction column))
153+
(setf (getf (cdr column-info) :default)
154+
(convert-for-driver-type
155+
driver-type
156+
(table-column-type column)
157+
(dao-table-column-deflate column
158+
(funcall (c2mop:slot-definition-initfunction column))))))
159+
column-info))

‎src/core/dao/view.lisp

+16
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,22 @@
3838
(sxql:yield (create-view-view-name statement))
3939
(create-view-as statement))))
4040

41+
(defstruct (drop-view (:include sxql.sql-type:sql-statement (sxql.sql-type:name "DROP VIEW"))
42+
(:constructor make-drop-view (view-name &key if-exists)))
43+
view-name
44+
if-exists)
45+
46+
(defmethod sxql:make-statement ((statement-name (eql :drop-view)) &rest args)
47+
(destructuring-bind (view-name &key if-exists)
48+
args
49+
(make-drop-view (sxql.operator:detect-and-convert view-name) :if-exists if-exists)))
50+
51+
(defmethod sxql:yield ((statement drop-view))
52+
(sxql.sql-type:with-yield-binds
53+
(format nil "DROP~:[~; IF EXISTS~] VIEW ~A"
54+
(drop-view-if-exists statement)
55+
(drop-view-view-name statement))))
56+
4157
(defgeneric table-definition (class &key if-not-exists or-replace)
4258
(:method ((class symbol) &rest args &key if-not-exists or-replace)
4359
(declare (ignore if-not-exists or-replace))

‎src/core/db/mysql.lisp

+2-1
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,8 @@
7171
:auto-increment (string= (getf column :|Extra|) "auto_increment")
7272
:primary-key (string= (getf column :|Key|) "PRI")
7373
:not-null (or (string= (getf column :|Key|) "PRI")
74-
(string= (getf column :|Null|) "NO"))))))
74+
(string= (getf column :|Null|) "NO"))
75+
:default (getf column :|Default|)))))
7576
;; Set :primary-key NIL if there's a composite primary key.
7677
(if (< 1 (count-if (lambda (def)
7778
(getf (cdr def) :primary-key))

‎src/core/db/postgres.lisp

+17-8
Original file line numberDiff line numberDiff line change
@@ -58,10 +58,14 @@
5858
~% CASE~
5959
~% WHEN p.contype = 'p' THEN true~
6060
~% ELSE false~
61-
~% END AS primary~
61+
~% END AS primary,~
62+
~% CASE~
63+
~% WHEN f.atthasdef THEN pg_get_expr(d.adbin, d.adrelid)~
64+
~% END AS default~
6265
~%FROM pg_attribute f~
6366
~% JOIN pg_class c ON c.oid = f.attrelid~
6467
~% LEFT JOIN pg_constraint p ON p.conrelid = f.attrelid AND f.attnum = ANY (p.conkey)~
68+
~% LEFT JOIN pg_attrdef d ON d.adrelid = c.oid~
6569
~%WHERE c.relkind = 'r'::char~
6670
~% AND c.relname = '~A'~
6771
~% AND f.attnum > 0~
@@ -73,14 +77,19 @@
7377
(loop with results = (dbi:execute query)
7478
for column = (dbi:fetch results)
7579
while column
76-
collect (list (getf column :|name|)
77-
:type (getf column :|type|)
78-
:auto-increment (not (null (member (getf column :|name|)
80+
collect (let ((auto-increment (not (null (member (getf column :|name|)
7981
serial-keys
80-
:test #'string=)))
81-
:primary-key (getf column :|primary|)
82-
:not-null (or (getf column :|primary|)
83-
(getf column :|notnull|))))
82+
:test #'string=)))))
83+
(list (getf column :|name|)
84+
:type (getf column :|type|)
85+
:auto-increment auto-increment
86+
:primary-key (getf column :|primary|)
87+
:not-null (or (getf column :|primary|)
88+
(getf column :|notnull|))
89+
:default (if (or auto-increment
90+
(eq :null (getf column :|default|)))
91+
nil
92+
(getf column :|default|)))))
8493
:key #'car
8594
:test #'string=
8695
:from-end t)))

0 commit comments

Comments
 (0)