From 8fb542bc902c20fb20cda7ca4c8d0482015579c4 Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Sat, 10 Sep 2016 18:54:11 +0200
Subject: [PATCH] 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                     | 14 ++++++++++++++
 src/parsers/command-alter-table.lisp | 14 +++++++-------
 src/sources/mysql/mysql-schema.lisp  | 11 +++++++++--
 src/utils/alter-table.lisp           | 24 +++++++++++++++++-------
 4 files changed, 47 insertions(+), 16 deletions(-)

diff --git a/src/package.lisp b/src/package.lisp
index 3cd6c6d..3ee6410 100644
--- a/src/package.lisp
+++ b/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))
 
diff --git a/src/parsers/command-alter-table.lisp b/src/parsers/command-alter-table.lisp
index 8da97a7..1b6cc7e 100644
--- a/src/parsers/command-alter-table.lisp
+++ b/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))))))
diff --git a/src/sources/mysql/mysql-schema.lisp b/src/sources/mysql/mysql-schema.lisp
index 3a2967d..2637a14 100644
--- a/src/sources/mysql/mysql-schema.lisp
+++ b/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)
diff --git a/src/utils/alter-table.lisp b/src/utils/alter-table.lisp
index 28ed039..dceafac 100644
--- a/src/utils/alter-table.lisp
+++ b/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)))
 
 
 ;;;