Add dao-table-view for DB view support (currently works only on Postg…

…reSQL).

mito-core.asd

@@ -20,7 +20,8 @@
                   :pathname "dao"
                   :depends-on ("connection" "class" "db" "logger" "util")
                   :components
-                  ((:file "table" :depends-on ("column" "mixin"))
+                  ((:file "table" :depends-on ("column" "mixin" "view"))
+                   (:file "view" :depends-on ("column"))
                    (:file "mixin" :depends-on ("column"))
                    (:file "column")))
                  (:file "class" :depends-on ("class-components"))

src/core/dao.lisp

@@ -56,6 +56,7 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (cl-reexport:reexport-from :mito.dao.mixin)
+  (cl-reexport:reexport-from :mito.dao.view)
   (cl-reexport:reexport-from :mito.dao.table))
 
 (defun foreign-value (obj slot)

src/core/dao/table.lisp

@@ -3,6 +3,8 @@
   (:use #:cl
         #:mito.util
         #:mito.error)
+  (:import-from #:mito.dao.view
+                #:table-definition)
   (:import-from #:mito.connection
                 #:driver-type)
   (:import-from #:mito.class
@@ -28,7 +30,6 @@
            #:dao-synced
 
            #:make-dao-instance
-           #:table-definition
 
            #:depending-table-classes))
 (in-package :mito.dao.table)
@@ -74,7 +75,7 @@
   (setf class (ensure-class class))
 
   (assert (and class
-               (typep class 'dao-table-class)))
+               (typep class 'table-class)))
 
   (let* ((list (loop for (k v) on initargs by #'cddr
                     for column = (find-if (lambda (initargs)
@@ -222,8 +223,6 @@
           (cons (find-class 'dao-class) direct-superclasses)))
   (apply #'call-next-method class name keys))
 
-(defun table-definition (class &key if-not-exists)
-  (setf class (ensure-class class))
-  (check-type class table-class)
+(defmethod table-definition ((class dao-table-class) &key if-not-exists &allow-other-keys)
   (create-table-sxql class (driver-type)
                      :if-not-exists if-not-exists))

src/core/dao/view.lisp

@@ -0,0 +1,50 @@
+(in-package #:cl-user)
+(defpackage #:mito.dao.view
+  (:use #:cl)
+  (:import-from #:mito.class
+                #:table-class
+                #:table-name)
+  (:import-from #:mito.dao.column
+                #:dao-table-column-class)
+  (:import-from #:sxql)
+  (:export #:dao-table-view
+           #:dao-table-view-as-query
+           #:table-definition))
+(in-package #:mito.dao.view)
+
+(defclass dao-table-view (table-class)
+  ((as :initarg :as
+       :initform (error ":as query is required for dao-table-view")
+       :reader dao-table-view-as-query)))
+
+(defmethod c2mop:direct-slot-definition-class ((class dao-table-view) &key)
+  'dao-table-column-class)
+
+(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)
+
+(defmethod sxql:make-statement ((statement-name (eql :create-view)) &rest args)
+  (destructuring-bind (view-name &key or-replace as)
+      args
+    (make-create-view (sxql.operator:detect-and-convert view-name) :or-replace or-replace :as as)))
+
+(defmethod sxql:yield ((statement create-view))
+  (sxql.sql-type:with-yield-binds
+    (format nil "CREATE~:[~; OR REPLACE~] VIEW ~A AS ~A"
+            (create-view-or-replace statement)
+            (sxql:yield (create-view-view-name statement))
+            (create-view-as 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))
+    (apply #'table-definition (find-class class) args))
+  (:method ((class dao-table-view) &key or-replace &allow-other-keys)
+    (list
+     (sxql:make-statement :create-view
+                          (sxql:make-sql-symbol (table-name class))
+                          :or-replace or-replace
+                          :as (first (dao-table-view-as-query class))))))

src/core/db.lisp

@@ -26,6 +26,7 @@
   (:export #:last-insert-id
            #:table-indices
            #:column-definitions
+           #:table-view-query
            #:table-exists-p
            #:execute-sql
            #:retrieve-by-sql))
@@ -67,6 +68,12 @@
      (:sqlite3  #'mito.db.sqlite3:column-definitions))
    conn table-name))
 
+(defun table-view-query (conn table-name)
+  (funcall
+   (ecase (dbi:connection-driver-type conn)
+     (:postgres #'mito.db.postgres:table-view-query))
+   conn table-name))
+
 (defun table-exists-p (conn table-name)
   (multiple-value-bind (sql binds)
       (sxql:yield

src/core/db/postgres.lisp

@@ -10,7 +10,8 @@
                 #:fetch-all)
   (:export #:last-insert-id
            #:column-definitions
-           #:table-indices))
+           #:table-indices
+           #:table-view-query))
 (in-package :mito.db.postgres)
 
 (defun last-insert-id (conn table-name serial-key-name)
@@ -129,3 +130,12 @@
                                                   column))
                                       |column_names|))))
             (dbi:fetch-all query))))
+
+(defun table-view-query (conn table-name)
+  (let ((query (dbi:execute (dbi:prepare conn
+                                         (format nil "SELECT pg_get_viewdef('~A'::regclass) AS def" table-name)))))
+    (string-right-trim
+     '(#\Space #\;)
+     (string-left-trim
+      '(#\Space)
+      (getf (first (dbi:fetch-all query)) :|def|)))))

src/migration/table.lisp

@@ -4,7 +4,9 @@
         #:sxql)
   (:import-from #:mito.dao
                 #:dao-table-class
-                #:table-definition)
+                #:dao-table-view
+                #:table-definition
+                #:dao-table-view-as-query)
   (:import-from #:mito.dao.column
                 #:dao-table-column-deflate)
   (:import-from #:mito.class
@@ -17,6 +19,7 @@
   (:import-from #:mito.db
                 #:table-indices
                 #:column-definitions
+                #:table-view-query
                 #:table-exists-p
                 #:execute-sql)
   (:import-from #:mito.connection
@@ -284,19 +287,34 @@
 
 (defun migration-expressions (class &optional (driver-type (driver-type *connection*)))
   (setf class (ensure-class class))
-  (if (eq driver-type :sqlite3)
-      (migration-expressions-for-sqlite3 class)
-      (destructuring-bind (add-columns
-                           drop-columns
-                           change-columns
-                           add-indices
-                           drop-indices)
-          (migration-expressions-for-others class driver-type)
-        (nconc drop-indices
-               (ensure-list drop-columns)
-               add-columns
-               change-columns
-               add-indices))))
+  (etypecase class
+    (dao-table-view
+     (execute-sql
+      (sxql:make-statement :create-view
+                           (sxql:make-sql-symbol (format nil "__~A" (table-name class)))
+                           :or-replace t
+                           :as (first (dao-table-view-as-query class))))
+     (unwind-protect
+          (if (equal (table-view-query *connection* (format nil "__~A" (table-name class)))
+                     (table-view-query *connection* (table-name class)))
+              nil
+              (table-definition class :or-replace t))
+       (execute-sql
+        (format nil "DROP VIEW \"__~A\"" (table-name class)))))
+    (dao-table-class
+     (if (eq driver-type :sqlite3)
+         (migration-expressions-for-sqlite3 class)
+         (destructuring-bind (add-columns
+                              drop-columns
+                              change-columns
+                              add-indices
+                              drop-indices)
+             (migration-expressions-for-others class driver-type)
+           (nconc drop-indices
+                  (ensure-list drop-columns)
+                  add-columns
+                  change-columns
+                  add-indices))))))
 
 (defmethod initialize-instance :after ((class dao-table-class) &rest initargs)
   (declare (ignore initargs))

t/mixin.lisp

@@ -6,6 +6,7 @@
         #:mito.connection
         #:mito.class
         #:mito.dao.mixin
+        #:mito.dao.view
         #:mito.dao.table))
 (in-package :mito-test.mixin)