From fb40a472abf69ea47fe4694fbf4847ffd98b3611 Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Fri, 15 Jan 2016 22:34:27 +0100 Subject: [PATCH] Simplify database WITH option handling. Share more code by having a common flattening function as a semantic predicate in the grammar. --- src/parsers/command-dbf.lisp | 22 +++--------- src/parsers/command-ixf.lisp | 17 +++------ src/parsers/command-mssql.lisp | 27 ++++----------- src/parsers/command-mysql.lisp | 31 ++++++++++++++--- src/parsers/command-options.lisp | 59 +++++++++++++++++--------------- src/parsers/command-sqlite.lisp | 33 ++++-------------- 6 files changed, 81 insertions(+), 108 deletions(-) diff --git a/src/parsers/command-dbf.lisp b/src/parsers/command-dbf.lisp index f717a6a8..425b259a 100644 --- a/src/parsers/command-dbf.lisp +++ b/src/parsers/command-dbf.lisp @@ -30,19 +30,8 @@ option-create-tables option-table-name)) -(defrule another-dbf-option (and comma dbf-option) - (:lambda (source) - (bind (((_ option) source)) option))) - -(defrule dbf-option-list (and dbf-option (* another-dbf-option)) - (:lambda (source) - (destructuring-bind (opt1 opts) source - (alexandria:alist-plist `(,opt1 ,@opts))))) - -(defrule dbf-options (and kw-with dbf-option-list) - (:lambda (source) - (bind (((_ opts) source)) - (cons :dbf-options opts)))) +(defrule dbf-options (and kw-with (and dbf-option (* (and comma dbf-option)))) + (:function flatten-option-list)) (defrule dbf-uri (and "dbf://" filename) (:lambda (source) @@ -90,8 +79,7 @@ (defun lisp-code-for-loading-from-dbf (dbf-db-conn pg-db-conn &key (encoding :ascii) - gucs before after - ((:dbf-options options))) + gucs before after options) `(lambda () (let* (,@(pgsql-connection-bindings pg-db-conn gucs) ,@(batch-control-bindings options) @@ -120,7 +108,7 @@ (defrule load-dbf-file load-dbf-command (:lambda (command) (bind (((source encoding pg-db-uri - &key ((:dbf-options options)) gucs before after) command)) + &key options gucs before after) command)) (cond (*dry-run* (lisp-code-for-dbf-dry-run source pg-db-uri)) (t @@ -129,4 +117,4 @@ :gucs gucs :before before :after after - :dbf-options options)))))) + :options options)))))) diff --git a/src/parsers/command-ixf.lisp b/src/parsers/command-ixf.lisp index ff7e8842..b41cc1f6 100644 --- a/src/parsers/command-ixf.lisp +++ b/src/parsers/command-ixf.lisp @@ -31,14 +31,8 @@ option-table-name option-timezone)) -(defrule another-ixf-option (and comma ixf-option) - (:lambda (source) - (bind (((_ option) source)) option))) - -(defrule ixf-option-list (and ixf-option (* another-ixf-option)) - (:lambda (source) - (destructuring-bind (opt1 opts) source - (alexandria:alist-plist `(,opt1 ,@opts))))) +(defrule ixf-options (and kw-with (and ixf-option (* (and comma ixf-option)))) + (:function flatten-option-list)) ;;; piggyback on DBF parsing (defrule ixf-options (and kw-with ixf-option-list) @@ -77,8 +71,7 @@ (defun lisp-code-for-loading-from-ixf (ixf-db-conn pg-db-conn &key - gucs before after - ((:ixf-options options))) + gucs before after options) `(lambda () (let* (,@(pgsql-connection-bindings pg-db-conn gucs) ,@(batch-control-bindings options) @@ -108,7 +101,7 @@ (defrule load-ixf-file load-ixf-command (:lambda (command) (bind (((source pg-db-uri - &key ((:ixf-options options)) gucs before after) command)) + &key options gucs before after) command)) (cond (*dry-run* (lisp-code-for-csv-dry-run pg-db-uri)) (t @@ -116,4 +109,4 @@ :gucs gucs :before before :after after - :ixf-options options)))))) + :options options)))))) diff --git a/src/parsers/command-mssql.lisp b/src/parsers/command-mssql.lisp index 03faf328..49a2cab8 100644 --- a/src/parsers/command-mssql.lisp +++ b/src/parsers/command-mssql.lisp @@ -29,19 +29,9 @@ option-encoding option-identifiers-case)) -(defrule another-mssql-option (and comma mssql-option) - (:lambda (source) - (bind (((_ option) source)) option))) - -(defrule mssql-option-list (and mssql-option (* another-mssql-option)) - (:lambda (source) - (destructuring-bind (opt1 opts) source - (alexandria:alist-plist (list* opt1 opts))))) - -(defrule mssql-options (and kw-with mssql-option-list) - (:lambda (source) - (bind (((_ opts) source)) - (cons :mssql-options opts)))) +(defrule mssql-options (and kw-with + (and mssql-option (* (and comma mssql-option)))) + (:function flatten-option-list)) (defrule including-in-schema (and kw-including kw-only kw-table kw-names kw-like filter-list-like @@ -141,10 +131,8 @@ (defun lisp-code-for-loading-from-mssql (ms-db-conn pg-db-conn &key - gucs casts before after - ((:mssql-options options)) - (including) - (excluding)) + gucs casts before after options + including excluding) `(lambda () ;; now is the time to load the CFFI lib we need (freetds) (let (#+sbcl(sb-ext:*muffled-warnings* 'style-warning)) @@ -174,8 +162,7 @@ (:lambda (source) (bind (((ms-db-uri pg-db-uri &key - gucs casts before after including excluding - ((:mssql-options options))) + gucs casts before after including excluding options) source)) (cond (*dry-run* (lisp-code-for-mssql-dry-run ms-db-uri pg-db-uri)) @@ -185,7 +172,7 @@ :casts casts :before before :after after - :mssql-options options + :options options :including including :excluding excluding)))))) diff --git a/src/parsers/command-mysql.lisp b/src/parsers/command-mysql.lisp index f98302fb..574a3773 100644 --- a/src/parsers/command-mysql.lisp +++ b/src/parsers/command-mysql.lisp @@ -4,6 +4,30 @@ (in-package :pgloader.parser) +;;; +;;; MySQL options +;;; +(defrule mysql-option (or option-workers + option-batch-rows + option-batch-size + option-batch-concurrency + option-truncate + option-disable-triggers + option-data-only + option-schema-only + option-include-drop + option-create-tables + option-create-indexes + option-index-names + option-reset-sequences + option-foreign-keys + option-identifiers-case)) + +(defrule mysql-options (and kw-with + (and mysql-option (* (and comma mysql-option)))) + (:function flatten-option-list)) + + ;;; ;;; Materialize views by copying their data over, allows for doing advanced ;;; ETL processing by having parts of the processing happen on the MySQL @@ -160,8 +184,7 @@ (defun lisp-code-for-loading-from-mysql (my-db-conn pg-db-conn &key - gucs casts views before after - ((:mysql-options options)) + gucs casts views before after options ((:including incl)) ((:excluding excl)) ((:decoding decoding-as))) @@ -194,7 +217,7 @@ pg-db-uri &key gucs casts views before after - mysql-options including excluding decoding) + options including excluding decoding) source (cond (*dry-run* (lisp-code-for-mysql-dry-run my-db-uri pg-db-uri)) @@ -205,7 +228,7 @@ :views views :before before :after after - :mysql-options mysql-options + :options options :including including :excluding excluding :decoding decoding)))))) diff --git a/src/parsers/command-options.lisp b/src/parsers/command-options.lisp index 580e9d66..de560b33 100644 --- a/src/parsers/command-options.lisp +++ b/src/parsers/command-options.lisp @@ -129,38 +129,41 @@ (bind (((action _ _) preserve-or-uniquify)) (cons :index-names action)))) -(defrule mysql-option (or option-workers - option-batch-rows - option-batch-size - option-batch-concurrency - option-truncate - option-disable-triggers - option-data-only - option-schema-only - option-include-drop - option-create-tables - option-create-indexes - option-index-names - option-reset-sequences - option-foreign-keys - option-identifiers-case)) +(defrule option-encoding (and kw-encoding encoding) + (:lambda (enc) + (cons :encoding + (if enc + (destructuring-bind (kw-encoding encoding) enc + (declare (ignore kw-encoding)) + encoding) + :utf-8)))) (defrule comma (and ignore-whitespace #\, ignore-whitespace) (:constant :comma)) -(defrule another-mysql-option (and comma mysql-option) - (:lambda (source) - (bind (((_ option) source)) option))) - -(defrule mysql-option-list (and mysql-option (* another-mysql-option)) - (:lambda (source) - (destructuring-bind (opt1 opts) source - (alexandria:alist-plist (list* opt1 opts))))) - -(defrule mysql-options (and kw-with mysql-option-list) - (:lambda (source) - (bind (((_ opts) source)) - (cons :mysql-options opts)))) +(defun flatten-option-list (with-option-list) + "Flatten given WITH-OPTION-LIST into a flat plist: + + Input: (:with + ((:INCLUDE-DROP . T) + ((:COMMA (:CREATE-TABLES . T)) (:COMMA (:CREATE-INDEXES . T)) + (:COMMA (:RESET-SEQUENCES . T))))) + + Output: (:INCLUDE-DROP T :CREATE-TABLES T + :CREATE-INDEXES T :RESET-SEQUENCES T)" + (destructuring-bind (with option-list) with-option-list + (declare (ignore with)) + (cons :options + (alexandria:alist-plist + (append (list (first option-list)) + (loop :for node :in (second option-list) + ;; bypass :comma + :append (cdr node))))))) + + +;;; +;;; PostgreSQL GUCs, another kind of options +;;; ;; we don't validate GUCs, that's PostgreSQL job. (defrule generic-optname optname-element diff --git a/src/parsers/command-sqlite.lisp b/src/parsers/command-sqlite.lisp index f36053ed..293d5952 100644 --- a/src/parsers/command-sqlite.lisp +++ b/src/parsers/command-sqlite.lisp @@ -13,15 +13,6 @@ load database set work_mem to '16MB', maintenance_work_mem to '512 MB'; |# -(defrule option-encoding (and kw-encoding encoding) - (:lambda (enc) - (cons :encoding - (if enc - (destructuring-bind (kw-encoding encoding) enc - (declare (ignore kw-encoding)) - encoding) - :utf-8)))) - (defrule sqlite-option (or option-batch-rows option-batch-size option-batch-concurrency @@ -35,19 +26,9 @@ load database option-reset-sequences option-encoding)) -(defrule another-sqlite-option (and comma sqlite-option) - (:lambda (source) - (bind (((_ option) source)) option))) - -(defrule sqlite-option-list (and sqlite-option (* another-sqlite-option)) - (:lambda (source) - (destructuring-bind (opt1 opts) source - (alexandria:alist-plist (list* opt1 opts))))) - -(defrule sqlite-options (and kw-with sqlite-option-list) - (:lambda (source) - (bind (((_ opts) source)) - (cons :sqlite-options opts)))) +(defrule sqlite-options (and kw-with + (and sqlite-option (* (and comma sqlite-option)))) + (:function flatten-option-list)) (defrule including-like (and kw-including kw-only kw-table kw-names kw-like filter-list-like) @@ -110,8 +91,7 @@ load database (defun lisp-code-for-loading-from-sqlite (sqlite-db-conn pg-db-conn &key - gucs casts before after - ((:sqlite-options options)) + gucs casts before after options ((:including incl)) ((:excluding excl))) `(lambda () @@ -140,8 +120,7 @@ load database (destructuring-bind (sqlite-uri pg-db-uri &key - gucs casts before after - sqlite-options including excluding) + gucs casts before after options including excluding) source (cond (*dry-run* (lisp-code-for-sqlite-dry-run sqlite-uri pg-db-uri)) @@ -151,7 +130,7 @@ load database :casts casts :before before :after after - :sqlite-options sqlite-options + :options options :including including :excluding excluding))))))