Split SQL queries into their own files.

This change was long overdue. Ideally we would use something like the YeSQL
library for Clojure, but it seems like the cl-yesql equivalent is not ready
yet, and it depends on an experimental build system...

So this patch introduces an URL abstraction built on-top of a hash table.
You can then reference src/pgsql/sql/list-all-columns.sql as

  (sql "pgsql/list-all-columns.sql")

in the source code directly.

So for now the templating system is CL's format language. It is still an
improvement from embedded string. Again, one step at a time.

pgloader.asd

@@ -63,6 +63,7 @@
 
                          ;; PostgreSQL related utils
                          (:file "read-sql-files")
+                         (:file "queries")
                          (:file "quoting")
                          (:file "catalog"     :depends-on ("quoting"))
                          (:file "alter-table" :depends-on ("catalog"))

src/package.lisp

@@ -252,9 +252,15 @@
            #:batch-oversized-p
            #:batch-full-p))
 
+(defpackage #:pgloader.queries
+  (:use #:cl #:pgloader.params)
+  (:export #:*queries*
+           #:sql))
+
 (defpackage #:pgloader.utils
   (:use #:cl
         #:pgloader.params
+        #:pgloader.queries
         #:pgloader.quoting
         #:pgloader.catalog
         #:pgloader.monitor
@@ -285,6 +291,7 @@
            #:show-encodings
            #:make-external-format))
 
+(cl-user::export-inherited-symbols "pgloader.queries" "pgloader.utils")
 (cl-user::export-inherited-symbols "pgloader.quoting" "pgloader.utils")
 (cl-user::export-inherited-symbols "pgloader.catalog" "pgloader.utils")
 (cl-user::export-inherited-symbols "pgloader.monitor" "pgloader.utils")

src/pgsql/connection.lisp

@@ -343,22 +343,7 @@
    to later CREATE INDEX ... ON ... USING gist(...), or even something else
    than gist. "
   (loop :for (typename access-methods) :in
-     (pomo:query "
-select typname,
-       array_agg(amname order by amname <> 'gist', amname <> 'gin')
-  from pg_type
-       join pg_opclass on pg_opclass.opcintype = pg_type.oid
-       join pg_am on pg_am.oid = pg_opclass.opcmethod
- where substring(typname from 1 for 1) <> '_'
-       and not exists
-       (
-         select amname
-           from pg_am am
-                join pg_opclass c on am.oid = c.opcmethod
-                join pg_type t on c.opcintype = t.oid
-          where amname = 'btree' and t.oid = pg_type.oid
-       )
-group by typname;")
+     (pomo:query (sql "/pgsql/list-typenames-without-btree-support.sql"))
      :collect (cons typename access-methods)))
 
 (defun list-reserved-keywords (pgconn)

src/pgsql/pgsql-schema.lisp

@@ -102,12 +102,10 @@
   "Get PostgreSQL schema name where to locate TABLE-NAME by following the
   current search_path rules. A PostgreSQL connection must be opened."
   (make-schema :name
-               (pomo:query (format nil "
-  select nspname
-    from pg_namespace n
-    join pg_class c on n.oid = c.relnamespace
-   where c.oid = '~a'::regclass;"
-                                   (table-name table)) :single)))
+               (pomo:query (format nil
+                                   (sql "/pgsql/query-table-schema.sql")
+                                   (table-name table))
+                           :single)))
 
 
 (defvar *table-type* '((:table    . "r")
@@ -141,25 +139,8 @@
   (loop :for (schema-name table-name table-oid name type typmod notnull default)
      :in
      (query nil
-            (format nil "
-    select nspname, relname, c.oid, attname,
-           t.oid::regtype as type,
-           case when atttypmod > 0 then atttypmod - 4 else null end as typmod,
-           attnotnull,
-           case when atthasdef then def.adsrc end as default
-      from pg_class c
-           join pg_namespace n on n.oid = c.relnamespace
-           left join pg_attribute a on c.oid = a.attrelid
-           join pg_type t on t.oid = a.atttypid and attnum > 0
-           left join pg_attrdef def on a.attrelid = def.adrelid
-                                   and a.attnum = def.adnum
-
-     where nspname !~~ '^pg_' and n.nspname <> 'information_schema'
-           and relkind = '~a'
-           ~:[~*~;and (~{~a~^~&~10t or ~})~]
-           ~:[~*~;and (~{~a~^~&~10t and ~})~]
-
-  order by nspname, relname, attnum"
+            (format nil
+                    (sql "/pgsql/list-all-columns.sql")
                     table-type-name
                     including           ; do we print the clause?
                     (filter-list-to-where-clause including
@@ -189,30 +170,8 @@
                        table-schema table-name
                        primary unique sql conname condef)
      :in (query nil
-                (format nil "
-  select n.nspname,
-         i.relname,
-         i.oid,
-         rn.nspname,
-         r.relname,
-         indisprimary,
-         indisunique,
-         pg_get_indexdef(indexrelid),
-         c.conname,
-         pg_get_constraintdef(c.oid)
-    from pg_index x
-         join pg_class i ON i.oid = x.indexrelid
-         join pg_class r ON r.oid = x.indrelid
-         join pg_namespace n ON n.oid = i.relnamespace
-         join pg_namespace rn ON rn.oid = r.relnamespace
-         left join pg_constraint c ON c.conindid = i.oid
-                                  and c.conrelid = r.oid
-                                  -- filter out self-fkeys
-                                  and c.confrelid <> r.oid
-   where n.nspname !~~ '^pg_' and n.nspname <> 'information_schema'
-         ~:[~*~;and (~{~a~^~&~10t or ~})~]
-         ~:[~*~;and (~{~a~^~&~10t and ~})~]
-order by n.nspname, r.relname"
+                (format nil
+                        (sql "/pgsql/list-all-indexes.sql")
                         including       ; do we print the clause?
                         (filter-list-to-where-clause including
                                                      nil
@@ -247,57 +206,29 @@ order by n.nspname, r.relname"
                        conoid conname condef
                        cols fcols
                        updrule delrule mrule deferrable deferred)
-     :in
-     (query nil
-            (format nil "
- select n.nspname, c.relname, nf.nspname, cf.relname as frelname,
-        r.oid, conname,
-        pg_catalog.pg_get_constraintdef(r.oid, true) as condef,
-        (select string_agg(attname, ',')
-           from pg_attribute
-          where attrelid = r.conrelid
-            and array[attnum::integer] <@ conkey::integer[]
-        ) as conkey,
-        (select string_agg(attname, ',')
-           from pg_attribute
-          where attrelid = r.confrelid
-            and array[attnum::integer] <@ confkey::integer[]
-        ) as confkey,
-        confupdtype, confdeltype, confmatchtype,
-        condeferrable, condeferred
-   from pg_catalog.pg_constraint r
-        JOIN pg_class c on r.conrelid = c.oid
-        JOIN pg_namespace n on c.relnamespace = n.oid
-        JOIN pg_class cf on r.confrelid = cf.oid
-        JOIN pg_namespace nf on cf.relnamespace = nf.oid
-   where r.contype = 'f'
-         AND c.relkind = 'r' and cf.relkind = 'r'
-         AND n.nspname !~~ '^pg_' and n.nspname <> 'information_schema'
-         AND nf.nspname !~~ '^pg_' and nf.nspname <> 'information_schema'
-         ~:[~*~;and (~{~a~^~&~10t or ~})~]
-         ~:[~*~;and (~{~a~^~&~10t and ~})~]
-         ~:[~*~;and (~{~a~^~&~10t or ~})~]
-         ~:[~*~;and (~{~a~^~&~10t and ~})~]"
-                    including           ; do we print the clause (table)?
-                    (filter-list-to-where-clause including
-                                                 nil
-                                                 "n.nspname"
-                                                 "c.relname")
-                    excluding           ; do we print the clause (table)?
-                    (filter-list-to-where-clause excluding
-                                                 nil
-                                                 "n.nspname"
-                                                 "c.relname")
-                    including           ; do we print the clause (ftable)?
-                    (filter-list-to-where-clause including
-                                                 nil
-                                                 "nf.nspname"
-                                                 "cf.relname")
-                    excluding           ; do we print the clause (ftable)?
-                    (filter-list-to-where-clause excluding
-                                                 nil
-                                                 "nf.nspname"
-                                                 "cf.relname")))
+     :in (query nil
+                (format nil
+                        (sql "/pgsql/list-all-fkeys.sql")
+                        including       ; do we print the clause (table)?
+                        (filter-list-to-where-clause including
+                                                     nil
+                                                     "n.nspname"
+                                                     "c.relname")
+                        excluding       ; do we print the clause (table)?
+                        (filter-list-to-where-clause excluding
+                                                     nil
+                                                     "n.nspname"
+                                                     "c.relname")
+                        including       ; do we print the clause (ftable)?
+                        (filter-list-to-where-clause including
+                                                     nil
+                                                     "nf.nspname"
+                                                     "cf.relname")
+                        excluding       ; do we print the clause (ftable)?
+                        (filter-list-to-where-clause excluding
+                                                     nil
+                                                     "nf.nspname"
+                                                     "cf.relname")))
      :do (flet ((pg-fk-rule-to-action (rule)
                   (case rule
                     (#\a "NO ACTION")
@@ -350,31 +281,8 @@ order by n.nspname, r.relname"
       (loop :for (schema-name table-name fschema-name ftable-name
                               conoid conname condef index-oid)
          :in (query nil
-                    (format nil "
-with pkeys(oid) as (
-  values~{(~d)~^,~}
-),
-     knownfkeys(oid) as (
-  values~{(~d)~^,~}
-),
-  pkdeps as (
-  select pkeys.oid, pg_depend.objid
-    from pg_depend
-         join pkeys on pg_depend.refobjid = pkeys.oid
-   where     classid = 'pg_catalog.pg_constraint'::regclass
-         and refclassid = 'pg_catalog.pg_class'::regclass
-)
- select n.nspname, c.relname, nf.nspname, cf.relname as frelname,
-        r.oid as conoid, conname,
-        pg_catalog.pg_get_constraintdef(r.oid, true) as condef,
-        pkdeps.oid as index_oid
-   from pg_catalog.pg_constraint r
-        JOIN pkdeps on r.oid = pkdeps.objid
-        JOIN pg_class c on r.conrelid = c.oid
-        JOIN pg_namespace n on c.relnamespace = n.oid
-        JOIN pg_class cf on r.confrelid = cf.oid
-        JOIN pg_namespace nf on cf.relnamespace = nf.oid
-  where NOT EXISTS (select 1 from knownfkeys where oid = r.oid)"
+                    (format nil
+                            (sql "/pgsql/list-missing-fk-deps.sql")
                             pkey-oid-list
                             (or fkey-oid-list (list -1))))
          ;;
@@ -407,14 +315,10 @@ with pkeys(oid) as (
 (defun list-table-oids (table-names)
   "Return an hash table mapping TABLE-NAME to its OID for all table in the
    TABLE-NAMES list. A PostgreSQL connection must be established already."
-  (let ((oidmap (make-hash-table :size (length table-names) :test #'equal)))
+  (let ((oidmap (make-hash-table :size (length table-names) :test #'equal))
+        (sql    (format nil (sql "/pgsql/list-table-oids.sql") table-names)))
     (when table-names
       (loop :for (name oid)
-         :in (query nil
-                    (format nil
-                            "
-select n, n::regclass::oid
-  from (values ~{('~a')~^,~}) as t(n)"
-                            table-names))
+         :in (query nil sql)
          :do (setf (gethash name oidmap) oid)))
     oidmap))

src/pgsql/sql/list-all-columns.sql

@@ -0,0 +1,23 @@
+-- params: table-type-name
+--         including
+--         filter-list-to-where-clause for including
+--         excluding
+--         filter-list-to-where-clause for excluding
+    select nspname, relname, c.oid, attname,
+           t.oid::regtype as type,
+           case when atttypmod > 0 then atttypmod - 4 else null end as typmod,
+           attnotnull,
+           case when atthasdef then def.adsrc end as default
+      from pg_class c
+           join pg_namespace n on n.oid = c.relnamespace
+           left join pg_attribute a on c.oid = a.attrelid
+           join pg_type t on t.oid = a.atttypid and attnum > 0
+           left join pg_attrdef def on a.attrelid = def.adrelid
+                                   and a.attnum = def.adnum
+
+     where nspname !~~ '^pg_' and n.nspname <> 'information_schema'
+           and relkind = '~a'
+           ~:[~*~;and (~{~a~^~&~10t or ~})~]
+           ~:[~*~;and (~{~a~^~&~10t and ~})~]
+
+  order by nspname, relname, attnum;

src/pgsql/sql/list-all-fkeys.sql

@@ -0,0 +1,36 @@
+-- params: including (table)
+--         filter-list-to-where-clause for including
+--         excluding (table)
+--         filter-list-to-where-clause for excluding
+--         including (ftable)
+--         filter-list-to-where-clause for including
+--         excluding (ftable)
+--         filter-list-to-where-clause for excluding
+ select n.nspname, c.relname, nf.nspname, cf.relname as frelname,
+        r.oid, conname,
+        pg_catalog.pg_get_constraintdef(r.oid, true) as condef,
+        (select string_agg(attname, ',')
+           from pg_attribute
+          where attrelid = r.conrelid
+            and array[attnum::integer] <@ conkey::integer[]
+        ) as conkey,
+        (select string_agg(attname, ',')
+           from pg_attribute
+          where attrelid = r.confrelid
+            and array[attnum::integer] <@ confkey::integer[]
+        ) as confkey,
+        confupdtype, confdeltype, confmatchtype,
+        condeferrable, condeferred
+   from pg_catalog.pg_constraint r
+        JOIN pg_class c on r.conrelid = c.oid
+        JOIN pg_namespace n on c.relnamespace = n.oid
+        JOIN pg_class cf on r.confrelid = cf.oid
+        JOIN pg_namespace nf on cf.relnamespace = nf.oid
+   where r.contype = 'f'
+         AND c.relkind = 'r' and cf.relkind = 'r'
+         AND n.nspname !~~ '^pg_' and n.nspname <> 'information_schema'
+         AND nf.nspname !~~ '^pg_' and nf.nspname <> 'information_schema'
+         ~:[~*~;and (~{~a~^~&~10t or ~})~]
+         ~:[~*~;and (~{~a~^~&~10t and ~})~]
+         ~:[~*~;and (~{~a~^~&~10t or ~})~]
+         ~:[~*~;and (~{~a~^~&~10t and ~})~]

src/pgsql/sql/list-all-indexes.sql

@@ -0,0 +1,27 @@
+-- params: including
+--         filter-list-to-where-clause for including
+--         excluding
+--         filter-list-to-where-clause for excluding
+  select n.nspname,
+         i.relname,
+         i.oid,
+         rn.nspname,
+         r.relname,
+         indisprimary,
+         indisunique,
+         pg_get_indexdef(indexrelid),
+         c.conname,
+         pg_get_constraintdef(c.oid)
+    from pg_index x
+         join pg_class i ON i.oid = x.indexrelid
+         join pg_class r ON r.oid = x.indrelid
+         join pg_namespace n ON n.oid = i.relnamespace
+         join pg_namespace rn ON rn.oid = r.relnamespace
+         left join pg_constraint c ON c.conindid = i.oid
+                                  and c.conrelid = r.oid
+                                  -- filter out self-fkeys
+                                  and c.confrelid <> r.oid
+   where n.nspname !~~ '^pg_' and n.nspname <> 'information_schema'
+         ~:[~*~;and (~{~a~^~&~10t or ~})~]
+         ~:[~*~;and (~{~a~^~&~10t and ~})~]
+order by n.nspname, r.relname

src/pgsql/sql/list-missing-fk-deps.sql

@@ -0,0 +1,26 @@
+-- params pkey-oid-list
+--        fkey-oild-list
+with pkeys(oid) as (
+  values~{(~d)~^,~}
+),
+     knownfkeys(oid) as (
+  values~{(~d)~^,~}
+),
+  pkdeps as (
+  select pkeys.oid, pg_depend.objid
+    from pg_depend
+         join pkeys on pg_depend.refobjid = pkeys.oid
+   where     classid = 'pg_catalog.pg_constraint'::regclass
+         and refclassid = 'pg_catalog.pg_class'::regclass
+)
+ select n.nspname, c.relname, nf.nspname, cf.relname as frelname,
+        r.oid as conoid, conname,
+        pg_catalog.pg_get_constraintdef(r.oid, true) as condef,
+        pkdeps.oid as index_oid
+   from pg_catalog.pg_constraint r
+        JOIN pkdeps on r.oid = pkdeps.objid
+        JOIN pg_class c on r.conrelid = c.oid
+        JOIN pg_namespace n on c.relnamespace = n.oid
+        JOIN pg_class cf on r.confrelid = cf.oid
+        JOIN pg_namespace nf on cf.relnamespace = nf.oid
+  where NOT EXISTS (select 1 from knownfkeys where oid = r.oid)

src/pgsql/sql/list-table-oids.sql

@@ -0,0 +1,4 @@
+-- params: table-names
+select n, n::regclass::oid
+  from (values ~{('~a')~^,~}) as t(n);
+

src/pgsql/sql/list-typenames-without-btree-support.sql

@@ -0,0 +1,15 @@
+select typname,
+       array_agg(amname order by amname <> 'gist', amname <> 'gin')
+  from pg_type
+       join pg_opclass on pg_opclass.opcintype = pg_type.oid
+       join pg_am on pg_am.oid = pg_opclass.opcmethod
+ where substring(typname from 1 for 1) <> '_'
+       and not exists
+       (
+         select amname
+           from pg_am am
+                join pg_opclass c on am.oid = c.opcmethod
+                join pg_type t on c.opcintype = t.oid
+          where amname = 'btree' and t.oid = pg_type.oid
+       )
+group by typname;

src/pgsql/sql/query-table-schema.sql

@@ -0,0 +1,5 @@
+-- params: table-name
+  select nspname
+    from pg_namespace n
+    join pg_class c on n.oid = c.relnamespace
+   where c.oid = '~a'::regclass;

src/sources/mssql/mssql-schema.lisp

@@ -83,51 +83,8 @@
                        datetime-precision
                        character-set-name collation-name)
      :in
-     (mssql-query (format nil "
-  select c.table_schema,
-         c.table_name,
-         c.column_name,
-         c.data_type,
-         CASE
-         WHEN c.column_default LIKE '((%' AND c.column_default LIKE '%))' THEN
-             CASE
-                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'newid()' THEN 'generate_uuid_v4()'
-                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today'
-                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'getdate()' THEN 'CURRENT_TIMESTAMP'
-                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE '''%''' THEN SUBSTRING(c.column_default,4,len(c.column_default)-6)
-                 ELSE SUBSTRING(c.column_default,3,len(c.column_default)-4)
-             END
-         WHEN c.column_default LIKE '(%' AND c.column_default LIKE '%)' THEN
-             CASE
-                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'newid()' THEN 'generate_uuid_v4()'
-                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today'
-                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'getdate()' THEN 'CURRENT_TIMESTAMP'
-                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE '''%''' THEN SUBSTRING(c.column_default,3,len(c.column_default)-4)
-                 ELSE SUBSTRING(c.column_default,2,len(c.column_default)-2)
-             END
-         ELSE c.column_default
-         END,
-         c.is_nullable,
-         COLUMNPROPERTY(object_id(c.table_name), c.column_name, 'IsIdentity'),
-         c.CHARACTER_MAXIMUM_LENGTH,
-         c.NUMERIC_PRECISION,
-         c.NUMERIC_PRECISION_RADIX,
-         c.NUMERIC_SCALE,
-         c.DATETIME_PRECISION,
-         c.CHARACTER_SET_NAME,
-         c.COLLATION_NAME
-
-    from information_schema.columns c
-         join information_schema.tables t
-              on c.table_schema = t.table_schema
-             and c.table_name = t.table_name
-
-   where     c.table_catalog = '~a'
-         and t.table_type = '~a'
-         ~:[~*~;and (~{~a~^~&~10t or ~})~]
-         ~:[~*~;and (~{~a~^~&~10t and ~})~]
-
-order by c.table_schema, c.table_name, c.ordinal_position"
+     (mssql-query (format nil
+                          (sql "/mssql/list-all-columns.sql")
                           (db-name *mssql-db*)
                           table-type-name
                           including     ; do we print the clause?
@@ -158,31 +115,8 @@ order by c.table_schema, c.table_name, c.ordinal_position"
   "Get the list of MSSQL index definitions per table."
   (loop
      :for (schema-name table-name index-name colname unique pkey filter)
-     :in  (mssql-query (format nil "
-    select schema_name(schema_id) as SchemaName,
-           o.name as TableName,
-           REPLACE(i.name, '.', '_') as IndexName,
-           co.[name] as ColumnName,
-           i.is_unique,
-           i.is_primary_key,
-           i.filter_definition
-
-    from sys.indexes i
-         join sys.objects o on i.object_id = o.object_id
-         join sys.index_columns ic on ic.object_id = i.object_id
-             and ic.index_id = i.index_id
-         join sys.columns co on co.object_id = i.object_id
-             and co.column_id = ic.column_id
-
-   where schema_name(schema_id) not in ('dto', 'sys')
-         ~:[~*~;and (~{~a~^ or ~})~]
-         ~:[~*~;and (~{~a~^ and ~})~]
-
-order by SchemaName,
-         o.[name],
-         i.[name],
-         ic.is_included_column,
-         ic.key_ordinal"
+     :in  (mssql-query (format nil
+                               (sql "/mssql/list-all-indexes.sql")
                                including ; do we print the clause?
                                (filter-list-to-where-clause including
                                                             nil
@@ -213,40 +147,11 @@ order by SchemaName,
 (defun list-all-fkeys (catalog &key including excluding)
   "Get the list of MSSQL index definitions per table."
   (loop
-     :for (fkey-name schema-name table-name col fschema-name ftable-name fcol fk-update-rule fk-delete-rule)
-     :in  (mssql-query (format nil "
-   SELECT
-           REPLACE(KCU1.CONSTRAINT_NAME, '.', '_') AS 'CONSTRAINT_NAME'
-         , KCU1.TABLE_SCHEMA AS 'TABLE_SCHEMA'
-         , KCU1.TABLE_NAME AS 'TABLE_NAME'
-         , KCU1.COLUMN_NAME AS 'COLUMN_NAME'
-         , KCU2.TABLE_SCHEMA AS 'UNIQUE_TABLE_SCHEMA'
-         , KCU2.TABLE_NAME AS 'UNIQUE_TABLE_NAME'
-         , KCU2.COLUMN_NAME AS 'UNIQUE_COLUMN_NAME'
-         , RC.UPDATE_RULE AS 'UPDATE_RULE'
-         , RC.DELETE_RULE AS 'DELETE_RULE'
-
-    FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS RC
-         JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU1
-              ON KCU1.CONSTRAINT_CATALOG = RC.CONSTRAINT_CATALOG
-                 AND KCU1.CONSTRAINT_SCHEMA = RC.CONSTRAINT_SCHEMA
-                 AND KCU1.CONSTRAINT_NAME = RC.CONSTRAINT_NAME
-         JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU2
-              ON KCU2.CONSTRAINT_CATALOG = RC.UNIQUE_CONSTRAINT_CATALOG
-                 AND KCU2.CONSTRAINT_SCHEMA = RC.UNIQUE_CONSTRAINT_SCHEMA
-                 AND KCU2.CONSTRAINT_NAME = RC.UNIQUE_CONSTRAINT_NAME
-
-   WHERE KCU1.ORDINAL_POSITION = KCU2.ORDINAL_POSITION
-         AND KCU1.TABLE_CATALOG = '~a'
-         AND KCU1.CONSTRAINT_CATALOG = '~a'
-         AND KCU1.CONSTRAINT_SCHEMA NOT IN ('dto', 'sys')
-         AND KCU1.TABLE_SCHEMA NOT IN ('dto', 'sys')
-         AND KCU2.TABLE_SCHEMA NOT IN ('dto', 'sys')
-
-         ~:[~*~;and (~{~a~^ or ~})~]
-         ~:[~*~;and (~{~a~^ and ~})~]
-
-ORDER BY KCU1.CONSTRAINT_NAME, KCU1.ORDINAL_POSITION"
+     :for (fkey-name schema-name table-name col
+                     fschema-name ftable-name fcol
+                     fk-update-rule fk-delete-rule)
+     :in  (mssql-query (format nil
+                               (sql "/mssql/list-all-fkeys.sql")
                                (db-name *mssql-db*) (db-name *mssql-db*)
                                including ; do we print the clause?
                                (filter-list-to-where-clause including

src/sources/mssql/sql/list-all-columns.sql

@@ -0,0 +1,50 @@
+-- params: dbname
+--         table-type-name
+--         including
+--         filter-list-to-where-clause including
+--         excluding
+--         filter-list-to-where-clause excluding
+  select c.table_schema,
+         c.table_name,
+         c.column_name,
+         c.data_type,
+         CASE
+         WHEN c.column_default LIKE '((%' AND c.column_default LIKE '%))' THEN
+             CASE
+                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'newid()' THEN 'generate_uuid_v4()'
+                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today'
+                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) = 'getdate()' THEN 'CURRENT_TIMESTAMP'
+                 WHEN SUBSTRING(c.column_default,3,len(c.column_default)-4) LIKE '''%''' THEN SUBSTRING(c.column_default,4,len(c.column_default)-6)
+                 ELSE SUBSTRING(c.column_default,3,len(c.column_default)-4)
+             END
+         WHEN c.column_default LIKE '(%' AND c.column_default LIKE '%)' THEN
+             CASE
+                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'newid()' THEN 'generate_uuid_v4()'
+                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE 'convert(%varchar%,getdate(),%)' THEN 'today'
+                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) = 'getdate()' THEN 'CURRENT_TIMESTAMP'
+                 WHEN SUBSTRING(c.column_default,2,len(c.column_default)-2) LIKE '''%''' THEN SUBSTRING(c.column_default,3,len(c.column_default)-4)
+                 ELSE SUBSTRING(c.column_default,2,len(c.column_default)-2)
+             END
+         ELSE c.column_default
+         END,
+         c.is_nullable,
+         COLUMNPROPERTY(object_id(c.table_name), c.column_name, 'IsIdentity'),
+         c.CHARACTER_MAXIMUM_LENGTH,
+         c.NUMERIC_PRECISION,
+         c.NUMERIC_PRECISION_RADIX,
+         c.NUMERIC_SCALE,
+         c.DATETIME_PRECISION,
+         c.CHARACTER_SET_NAME,
+         c.COLLATION_NAME
+
+    from information_schema.columns c
+         join information_schema.tables t
+              on c.table_schema = t.table_schema
+             and c.table_name = t.table_name
+
+   where     c.table_catalog = '~a'
+         and t.table_type = '~a'
+         ~:[~*~;and (~{~a~^~&~10t or ~})~]
+         ~:[~*~;and (~{~a~^~&~10t and ~})~]
+
+order by c.table_schema, c.table_name, c.ordinal_position;

src/sources/mssql/sql/list-all-fkeys.sql

@@ -0,0 +1,37 @@
+-- params: dbname
+--         including
+--         filter-list-to-where-clause including
+--         excluding
+--         filter-list-to-where-clause excluding
+   SELECT
+           REPLACE(KCU1.CONSTRAINT_NAME, '.', '_') AS 'CONSTRAINT_NAME'
+         , KCU1.TABLE_SCHEMA AS 'TABLE_SCHEMA'
+         , KCU1.TABLE_NAME AS 'TABLE_NAME'
+         , KCU1.COLUMN_NAME AS 'COLUMN_NAME'
+         , KCU2.TABLE_SCHEMA AS 'UNIQUE_TABLE_SCHEMA'
+         , KCU2.TABLE_NAME AS 'UNIQUE_TABLE_NAME'
+         , KCU2.COLUMN_NAME AS 'UNIQUE_COLUMN_NAME'
+         , RC.UPDATE_RULE AS 'UPDATE_RULE'
+         , RC.DELETE_RULE AS 'DELETE_RULE'
+
+    FROM INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS RC
+         JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU1
+              ON KCU1.CONSTRAINT_CATALOG = RC.CONSTRAINT_CATALOG
+                 AND KCU1.CONSTRAINT_SCHEMA = RC.CONSTRAINT_SCHEMA
+                 AND KCU1.CONSTRAINT_NAME = RC.CONSTRAINT_NAME
+         JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU2
+              ON KCU2.CONSTRAINT_CATALOG = RC.UNIQUE_CONSTRAINT_CATALOG
+                 AND KCU2.CONSTRAINT_SCHEMA = RC.UNIQUE_CONSTRAINT_SCHEMA
+                 AND KCU2.CONSTRAINT_NAME = RC.UNIQUE_CONSTRAINT_NAME
+
+   WHERE KCU1.ORDINAL_POSITION = KCU2.ORDINAL_POSITION
+         AND KCU1.TABLE_CATALOG = '~a'
+         AND KCU1.CONSTRAINT_CATALOG = '~a'
+         AND KCU1.CONSTRAINT_SCHEMA NOT IN ('dto', 'sys')
+         AND KCU1.TABLE_SCHEMA NOT IN ('dto', 'sys')
+         AND KCU2.TABLE_SCHEMA NOT IN ('dto', 'sys')
+
+         ~:[~*~;and (~{~a~^ or ~})~]
+         ~:[~*~;and (~{~a~^ and ~})~]
+
+ORDER BY KCU1.CONSTRAINT_NAME, KCU1.ORDINAL_POSITION;

src/sources/mssql/sql/list-all-indexes.sql

@@ -0,0 +1,28 @@
+-- params: including
+--         filter-list-to-where-clause including
+--         excluding
+--         filter-list-to-where-clause excluding
+    select schema_name(schema_id) as SchemaName,
+           o.name as TableName,
+           REPLACE(i.name, '.', '_') as IndexName,
+           co.[name] as ColumnName,
+           i.is_unique,
+           i.is_primary_key,
+           i.filter_definition
+
+    from sys.indexes i
+         join sys.objects o on i.object_id = o.object_id
+         join sys.index_columns ic on ic.object_id = i.object_id
+             and ic.index_id = i.index_id
+         join sys.columns co on co.object_id = i.object_id
+             and co.column_id = ic.column_id
+
+   where schema_name(schema_id) not in ('dto', 'sys')
+         ~:[~*~;and (~{~a~^ or ~})~]
+         ~:[~*~;and (~{~a~^ and ~})~]
+
+order by SchemaName,
+         o.[name],
+         i.[name],
+         ic.is_included_column,
+         ic.key_ordinal;

src/sources/mysql/mysql-schema.lisp

@@ -181,18 +181,8 @@
   (loop
      :for (tname tcomment cname ccomment dtype ctype default nullable extra)
      :in
-     (mysql-query (format nil "
-  select c.table_name, t.table_comment,
-         c.column_name, c.column_comment,
-         c.data_type, c.column_type, c.column_default,
-         c.is_nullable, c.extra
-    from information_schema.columns c
-         join information_schema.tables t using(table_schema, table_name)
-   where c.table_schema = '~a' and t.table_type = '~a'
-         ~:[~*~;and table_name in (~{'~a'~^,~})~]
-         ~:[~*~;and (~{table_name ~a~^ or ~})~]
-         ~:[~*~;and (~{table_name ~a~^ and ~})~]
-order by table_name, ordinal_position"
+     (mysql-query (format nil
+                          (sql "/mysql/list-all-columns.sql")
                           (db-name *connection*)
                           table-type-name
                           only-tables   ; do we print the clause?
@@ -224,15 +214,8 @@ order by table_name, ordinal_position"
   "Get the list of MySQL index definitions per table."
   (loop
      :for (table-name name non-unique cols)
-     :in (mysql-query (format nil "
-  SELECT table_name, index_name, sum(non_unique),
-         cast(GROUP_CONCAT(column_name order by seq_in_index) as char)
-    FROM information_schema.statistics
-   WHERE table_schema = '~a'
-         ~:[~*~;and table_name in (~{'~a'~^,~})~]
-         ~:[~*~;and (~{table_name ~a~^ or ~})~]
-         ~:[~*~;and (~{table_name ~a~^ and ~})~]
-GROUP BY table_name, index_name;"
+     :in (mysql-query (format nil
+                              (sql "/mysql/list-all-indexes.sql")
                               (db-name *connection*)
                               only-tables ; do we print the clause?
                               only-tables
@@ -265,41 +248,8 @@ GROUP BY table_name, index_name;"
   "Get the list of MySQL Foreign Keys definitions per table."
   (loop
      :for (table-name name ftable-name cols fcols update-rule delete-rule)
-     :in (mysql-query (format nil "
-SELECT s.table_name, s.constraint_name, s.ft, s.cols, s.fcols,
-       rc.update_rule, rc.delete_rule
-
-FROM
- (
-  SELECT tc.table_schema, tc.table_name,
-         tc.constraint_name, k.referenced_table_name ft,
-
-             group_concat(         k.column_name
-                          order by k.ordinal_position) as cols,
-
-             group_concat(         k.referenced_column_name
-                          order by k.position_in_unique_constraint) as fcols
-
-        FROM information_schema.table_constraints tc
-
-        LEFT JOIN information_schema.key_column_usage k
-               ON k.table_schema = tc.table_schema
-              AND k.table_name = tc.table_name
-              AND k.constraint_name = tc.constraint_name
-
-      WHERE     tc.table_schema = '~a'
-            AND k.referenced_table_schema = '~a'
-            AND tc.constraint_type = 'FOREIGN KEY'
-           ~:[~*~;and tc.table_name in (~{'~a'~^,~})~]
-           ~:[~*~;and (~{tc.table_name ~a~^ or ~})~]
-           ~:[~*~;and (~{tc.table_name ~a~^ and ~})~]
-
-   GROUP BY tc.table_schema, tc.table_name, tc.constraint_name, ft
- ) s
-             JOIN information_schema.referential_constraints rc
-               ON rc.constraint_schema = s.table_schema
-              AND rc.constraint_name = s.constraint_name
-              AND rc.table_name = s.table_name"
+     :in (mysql-query (format nil
+                              (sql "/mysql/list-all-fkeys.sql")
                               (db-name *connection*) (db-name *connection*)
                               only-tables ; do we print the clause?
                               only-tables
@@ -347,14 +297,8 @@ FROM
   "Return comments on MySQL tables."
   (loop
      :for (table-name comment)
-     :in (mysql-query (format nil "
-    SELECT table_name, table_comment
-      FROM information_schema.tables
-    WHERE     table_schema = '~a'
-          and table_type = 'BASE TABLE'
-         ~:[~*~;and table_name in (~{'~a'~^,~})~]
-         ~:[~*~;and (~{table_name ~a~^ or ~})~]
-         ~:[~*~;and (~{table_name ~a~^ and ~})~]"
+     :in (mysql-query (format nil
+                              (sql "/mysql/list-table-comments.sql")
                               (db-name *connection*)
                               only-tables ; do we print the clause?
                               only-tables
@@ -372,16 +316,8 @@ FROM
   "Return comments on MySQL tables."
   (loop
      :for (table-name column-name comment)
-     :in (mysql-query (format nil "
-  select c.table_name, c.column_name, c.column_comment
-    from information_schema.columns c
-         join information_schema.tables t using(table_schema, table_name)
-   where     c.table_schema = '~a'
-         and t.table_type = 'BASE TABLE'
-         ~:[~*~;and table_name in (~{'~a'~^,~})~]
-         ~:[~*~;and (~{table_name ~a~^ or ~})~]
-         ~:[~*~;and (~{table_name ~a~^ and ~})~]
-order by table_name, ordinal_position"
+     :in (mysql-query (format nil
+                              (sql "/mysql/list-columns-comments.sql")
                               (db-name *connection*)
                               only-tables ; do we print the clause?
                               only-tables
@@ -413,13 +349,10 @@ order by table_name, ordinal_position"
 
    This function assumes a valid connection to the MySQL server has been
    established already."
-  (loop
-     for (name type) in (mysql-query (format nil "
-  select column_name, data_type
-    from information_schema.columns
-   where table_schema = '~a' and table_name = '~a'
-order by ordinal_position" dbname table-name)
-					   :result-type 'list)
+  (loop with sql = (format nil
+                           (sql "/mysql/get-column-list.sql")
+                           dbname table-name)
+     for (name type) in (mysql-query sql :result-type 'list)
      collect (get-column-sql-expression name type)))
 
 (declaim (inline fix-nulls))

src/sources/mysql/sql/get-column-list.sql

@@ -0,0 +1,6 @@
+-- params: dbname
+--         table-name
+  select column_name, data_type
+    from information_schema.columns
+   where table_schema = '~a' and table_name = '~a'
+order by ordinal_position;

src/sources/mysql/sql/list-all-columns.sql

@@ -0,0 +1,19 @@
+-- params: db-name
+--         table-type-name
+--         only-tables
+--         only-tables
+--         including
+--         filter-list-to-where-clause incuding
+--         excluding
+--         filter-list-to-where-clause excluding
+  select c.table_name, t.table_comment,
+         c.column_name, c.column_comment,
+         c.data_type, c.column_type, c.column_default,
+         c.is_nullable, c.extra
+    from information_schema.columns c
+         join information_schema.tables t using(table_schema, table_name)
+   where c.table_schema = '~a' and t.table_type = '~a'
+         ~:[~*~;and table_name in (~{'~a'~^,~})~]
+         ~:[~*~;and (~{table_name ~a~^ or ~})~]
+         ~:[~*~;and (~{table_name ~a~^ and ~})~]
+order by table_name, ordinal_position;

src/sources/mysql/sql/list-all-fkeys.sql

@@ -0,0 +1,42 @@
+-- params: db-name
+--         table-type-name
+--         only-tables
+--         only-tables
+--         including
+--         filter-list-to-where-clause incuding
+--         excluding
+--         filter-list-to-where-clause excluding
+SELECT s.table_name, s.constraint_name, s.ft, s.cols, s.fcols,
+       rc.update_rule, rc.delete_rule
+
+FROM
+ (
+  SELECT tc.table_schema, tc.table_name,
+         tc.constraint_name, k.referenced_table_name ft,
+
+             group_concat(         k.column_name
+                          order by k.ordinal_position) as cols,
+
+             group_concat(         k.referenced_column_name
+                          order by k.position_in_unique_constraint) as fcols
+
+        FROM information_schema.table_constraints tc
+
+        LEFT JOIN information_schema.key_column_usage k
+               ON k.table_schema = tc.table_schema
+              AND k.table_name = tc.table_name
+              AND k.constraint_name = tc.constraint_name
+
+      WHERE     tc.table_schema = '~a'
+            AND k.referenced_table_schema = '~a'
+            AND tc.constraint_type = 'FOREIGN KEY'
+           ~:[~*~;and tc.table_name in (~{'~a'~^,~})~]
+           ~:[~*~;and (~{tc.table_name ~a~^ or ~})~]
+           ~:[~*~;and (~{tc.table_name ~a~^ and ~})~]
+
+   GROUP BY tc.table_schema, tc.table_name, tc.constraint_name, ft
+ ) s
+             JOIN information_schema.referential_constraints rc
+               ON rc.constraint_schema = s.table_schema
+              AND rc.constraint_name = s.constraint_name
+              AND rc.table_name = s.table_name;

src/sources/mysql/sql/list-all-indexes.sql

@@ -0,0 +1,16 @@
+-- params: db-name
+--         table-type-name
+--         only-tables
+--         only-tables
+--         including
+--         filter-list-to-where-clause incuding
+--         excluding
+--         filter-list-to-where-clause excluding
+  SELECT table_name, index_name, sum(non_unique),
+         cast(GROUP_CONCAT(column_name order by seq_in_index) as char)
+    FROM information_schema.statistics
+   WHERE table_schema = '~a'
+         ~:[~*~;and table_name in (~{'~a'~^,~})~]
+         ~:[~*~;and (~{table_name ~a~^ or ~})~]
+         ~:[~*~;and (~{table_name ~a~^ and ~})~]
+GROUP BY table_name, index_name;

src/sources/mysql/sql/list-columns-comments.sql

@@ -0,0 +1,17 @@
+-- params: db-name
+--         table-type-name
+--         only-tables
+--         only-tables
+--         including
+--         filter-list-to-where-clause incuding
+--         excluding
+--         filter-list-to-where-clause excluding
+  select c.table_name, c.column_name, c.column_comment
+    from information_schema.columns c
+         join information_schema.tables t using(table_schema, table_name)
+   where     c.table_schema = '~a'
+         and t.table_type = 'BASE TABLE'
+         ~:[~*~;and table_name in (~{'~a'~^,~})~]
+         ~:[~*~;and (~{table_name ~a~^ or ~})~]
+         ~:[~*~;and (~{table_name ~a~^ and ~})~]
+order by table_name, ordinal_position;

src/sources/mysql/sql/list-table-comments.sql

@@ -0,0 +1,15 @@
+-- params: db-name
+--         table-type-name
+--         only-tables
+--         only-tables
+--         including
+--         filter-list-to-where-clause incuding
+--         excluding
+--         filter-list-to-where-clause excluding
+    SELECT table_name, table_comment
+      FROM information_schema.tables
+    WHERE     table_schema = '~a'
+          and table_type = 'BASE TABLE'
+         ~:[~*~;and table_name in (~{'~a'~^,~})~]
+         ~:[~*~;and (~{table_name ~a~^ or ~})~]
+         ~:[~*~;and (~{table_name ~a~^ and ~})~];

src/utils/queries.lisp

@@ -0,0 +1,68 @@
+;;;
+;;; Load SQL queries at load-time into an hash table and offer a function to
+;;; get the SQL query text from the source code. This allows to maintain
+;;; proper .sql files in the source code, for easier maintenance.
+;;;
+
+(in-package :pgloader.queries)
+
+(defparameter *src*
+  (uiop:pathname-directory-pathname
+   (asdf:system-relative-pathname :pgloader "src/"))
+  "Source directory where to look for .sql query files.")
+
+(defun load-static-file (fs pathname url)
+  "Load given PATHNAME contents at URL-PATH in FS."
+  (setf (gethash url fs)
+        (alexandria:read-file-into-string pathname)))
+
+(defun pathname-to-url (pathname &optional (root *src*))
+  "Transform given PATHNAME into an URL at which to serve it within URL-PATH."
+  (multiple-value-bind (flag path-list last-component file-namestring-p)
+      (uiop:split-unix-namestring-directory-components
+       (uiop:native-namestring
+        (uiop:enough-pathname pathname root)))
+    (declare (ignore flag file-namestring-p))
+    ;;
+    ;; we store SQL queries in a sql/ subdirectory because it's easier to
+    ;; manage the code that way, but it's an implementation detail that we
+    ;; are hiding in the query url abstraction...
+    ;;
+    ;; then do the same thing with the "sources" in /src/sources/.../sql/...
+    ;;
+    (let ((no-sql-path-list
+           (remove-if (lambda (path)
+                        (member path (list "sources" "sql")
+                                :test #'string=))
+                      path-list)))
+      (format nil "~{/~a~}/~a" no-sql-path-list last-component))))
+
+(defun load-static-directory (fs &optional (root *src*))
+  "Walk PATH and load all files found in there as binary sequence, FS being
+   an hash table referencing the full path against the bytes."
+  (flet ((collectp  (dir) (declare (ignore dir)) t)
+         (recursep  (dir) (declare (ignore dir)) t)
+         (collector (dir)
+           (loop :for pathname :in (uiop:directory-files dir)
+              :do (when (string= "sql" (pathname-type pathname))
+                    (let ((url (pathname-to-url pathname root)))
+                      (load-static-file fs pathname url))))))
+    (uiop:collect-sub*directories root #'collectp #'recursep #'collector)))
+
+(defun walk-sources-and-build-fs ()
+  (let ((fs (make-hash-table :test #'equal)))
+    (load-static-directory fs)
+    fs))
+
+(defparameter *fs*
+  (walk-sources-and-build-fs)
+  "File system as an hash-table in memory.")
+
+(defun sql (url)
+  "Abstract the hash-table based implementation of our SQL file system."
+  (restart-case
+      (or (gethash url *fs*)
+          (error "URL ~s not found!" url))
+    (recompute-fs-and-retry ()
+      (setf *fs* (walk-sources-and-build-fs))
+      (sql url))))