Improve INCLUDING rule matching for MySQL.

In the MySQL source we have explicit support for both string equality
and regexps for the INCLUDING and EXCLUDING clauses. This got broken
when moved to be shared with the ALTER TABLE implementation, because
we were no longer using the type system in the same way in all places.

To fix, create new abstractions for strings and regexps and use those
new structs in the proper way (thanks to defstruct and CLOS).

Fixes #441.

src/package.lisp

@@ -164,8 +164,22 @@
 
            #:push-to-end
            #:with-schema
+
            #:alter-table
            #:alter-schema
+           #:string-match-rule
+           #:make-string-match-rule
+           #:string-match-rule-target
+           #:regex-match-rule
+           #:make-regex-match-rule
+           #:regex-match-rule-target
+           #:matches
+           #:match-rule
+           #:make-match-rule
+           #:match-rule-rule
+           #:match-rule-schema
+           #:match-rule-action
+           #:match-rule-args
 
            #:format-table-name))
 

src/parsers/command-alter-table.lisp

@@ -5,9 +5,10 @@
 ;;;
 (in-package #:pgloader.parser)
 
-(defrule match-rule-target-regex quoted-regex)
+(defrule match-rule-target-regex quoted-regex
+  (:lambda (re) (make-regex-match-rule :target re)))
 (defrule match-rule-target-string quoted-namestring
-  (:lambda (x) (list :string x)))
+  (:lambda (s) (make-string-match-rule :target s)))
 
 (defrule match-rule-target (or match-rule-target-string
                                match-rule-target-regex))
@@ -48,12 +49,11 @@
                                   (? in-schema)
                                   alter-table-action)
   (:lambda (alter-table-command)
-    (destructuring-bind (match-rule-target-list schema action)
+    (destructuring-bind (rule-list schema action)
         alter-table-command
-      (loop :for match-rule-target :in match-rule-target-list
-         :collect (pgloader.catalog::make-match-rule
-                   :type   (first match-rule-target)
-                   :target (second match-rule-target)
+      (loop :for rule :in rule-list
+         :collect (make-match-rule
+                   :rule   rule
                    :schema schema
                    :action (first action)
                    :args   (rest action))))))

src/sources/mysql/mysql-schema.lisp

@@ -144,8 +144,15 @@
   "Given an INCLUDING or EXCLUDING clause, turn it into a MySQL WHERE clause."
   (mapcar (lambda (filter)
             (typecase filter
-              (string (format nil "~:[~;!~]= '~a'" not filter))
-              (cons   (format nil "~:[~;NOT ~]REGEXP '~a'" not (cadr filter)))))
+              (string-match-rule
+               (format nil "~:[~;!~]= '~a'"
+                       not
+                       (string-match-rule-target filter)))
+
+              (regex-match-rule
+               (format nil "~:[~;NOT ~]REGEXP '~a'"
+                       not
+                       (regex-match-rule-target filter)))))
           filter-list))
 
 (defun cleanup-default-value (dtype default)

src/utils/alter-table.lisp

@@ -4,6 +4,20 @@
 ;;;
 (in-package :pgloader.catalog)
 
+;;;
+;;; Support for the INCLUDING and EXCLUDING clauses
+;;;
+(defstruct string-match-rule target)
+(defstruct regex-match-rule target)
+
+(defgeneric matches (rule string)
+  (:documentation "Return non-nul if the STRING matches given RULE.")
+  (:method ((rule string-match-rule) string)
+    (string= (string-match-rule-target rule) string))
+
+  (:method ((rule regex-match-rule) string)
+    (cl-ppcre:scan (regex-match-rule-target rule) string)))
+
 #|
    See src/parsers/command-alter-table.lisp
 
@@ -12,7 +26,7 @@
                     :action #'pgloader.schema::alter-table-set-schema
                     :args (list "mv"))
 |#
-(defstruct match-rule type target schema action args)
+(defstruct match-rule rule schema action args)
 
 (defgeneric alter-table (object alter-table-rule-list))
 
@@ -72,16 +86,12 @@
         (table-name  (table-source-name table)))
     (when (or (null rule-schema)
               (and rule-schema (string= rule-schema schema-name)))
-      (ecase (match-rule-type match-rule)
-        (:string (string= (match-rule-target match-rule) table-name))
-        (:regex  (cl-ppcre:scan (match-rule-target match-rule) table-name))))))
+      (matches (match-rule-rule match-rule) table-name))))
 
 (defmethod rule-matches ((match-rule match-rule) (schema schema))
   "Return non-nil when TABLE matches given MATCH-RULE."
   (let ((schema-name (schema-source-name schema)))
-    (ecase (match-rule-type match-rule)
-      (:string (string= (match-rule-target match-rule) schema-name))
-      (:regex  (cl-ppcre:scan (match-rule-target match-rule) schema-name)))))
+    (matches (match-rule-rule match-rule) schema-name)))
 
 
 ;;;