From 222b020bcd1961485611df026b722bb518cb0fcd Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Sat, 26 Dec 2020 11:05:07 -0500 Subject: [PATCH 01/10] Finally remove deprecated write-rational-as-floating-point --- cl-postgres/sql-string.lisp | 51 +----------------------------------- cl-postgres/tests/tests.lisp | 9 ------- 2 files changed, 1 insertion(+), 59 deletions(-) diff --git a/cl-postgres/sql-string.lisp b/cl-postgres/sql-string.lisp index b6e6af8a..c73cab7d 100644 --- a/cl-postgres/sql-string.lisp +++ b/cl-postgres/sql-string.lisp @@ -75,55 +75,6 @@ the loss of precision and offering to continue or reset can not be expressed within 38 decimal digits (for example 1/3), it will be truncated, and lose some precision. Set this variable to nil to suppress that behaviour and raise an error instead.") -(defun write-rational-as-floating-point (number stream digit-length-limit) - "DEPRECATED. The same as write-ratio-as-floating point. Note the difference between rational and ratio. -Kept for backwards compatibility. -Given a ratio, a stream and a digital-length-limit, if *silently-truncate-rationals* is true, -will return a potentially truncated ratio. If false and the digital-length-limit is reached, -it will throw an error noting the loss of precision and offering to continue or reset -*silently-truncate-rationals* to true. Code contributed by Attila Lendvai." - (declare #.*optimize* (type fixnum digit-length-limit)) - (check-type number ratio) - (let ((silently-truncate? *silently-truncate-rationals*)) - (flet ((fail () - (unless silently-truncate? - (restart-case - (error 'database-error :message - (format nil "Can not write the rational ~A as a floating point number with only ~A available digits. You may want to (setf ~S t) if you don't mind the loss of precision." - number digit-length-limit '*silently-truncate-rationals*)) - (continue () - :report (lambda (stream) - (write-string "Ignore this precision loss and continue" stream)) - (setf silently-truncate? t)) - (disable-assertion () - :report (lambda (stream) - (write-string "Set ~S to true (the precision loss of ratios will be silently ignored in this Lisp VM)." stream)) - (setf silently-truncate? t) - (setf *silently-truncate-rationals* t)))))) - (multiple-value-bind (quotient remainder) - (truncate (if (< number 0) - (progn - (write-char #\- stream) - (- number)) - number)) - (let* ((quotient-part (princ-to-string quotient)) - (remaining-digit-length (- digit-length-limit (length quotient-part)))) - (write-string quotient-part stream) - (when (<= remaining-digit-length 0) - (fail)) - (unless (zerop remainder) - (write-char #\. stream)) - (loop - :for decimal-digits :upfrom 1 - :until (zerop remainder) - :do (progn - (when (> decimal-digits remaining-digit-length) - (fail) - (return)) - (multiple-value-bind (quotient rem) (floor (* remainder 10)) - (princ quotient stream) - (setf remainder rem))))))))) - (defun write-quoted (string out) (write-char #\" out) (loop :for ch :across string :do @@ -194,7 +145,7 @@ used by S-SQL.)") ;; handle more. For practical reasons we also draw the line there. If ;; someone needs full rational numbers then ;; 200 wouldn't help them much more than 38... - (write-rational-as-floating-point arg result 38))) + (write-ratio-as-floating-point arg result 38))) (:method ((arg (eql t))) "true") (:method ((arg (eql nil))) diff --git a/cl-postgres/tests/tests.lisp b/cl-postgres/tests/tests.lisp index 086c4573..e6ce6eb2 100644 --- a/cl-postgres/tests/tests.lisp +++ b/cl-postgres/tests/tests.lisp @@ -721,15 +721,6 @@ variables:~:{~% ~A: ~(~A~), ~:[defaults to \"~A\"~;~:*provided \"~A\"~]~}~%" (is (equalp (exec-query connection "select array_agg(row(1,2,3));" 'list-row-reader) '((#((1 2 3))))))))) -(test write-rational-as-floating-point - (let ((old-silently-truncate *silently-truncate-rationals*)) - (setf cl-postgres:*silently-truncate-rationals* nil) - (signals error (cl-postgres::write-rational-as-floating-point (/ 1321 7) *standard-output* 5)) - (setf cl-postgres:*silently-truncate-rationals* t) - (is (equal (with-output-to-string (s) (cl-postgres::write-rational-as-floating-point (/ 1321 7) s 5)) - "188.71")) - (setf cl-postgres:*silently-truncate-rationals* old-silently-truncate))) - (test write-ratio-as-floating-point (let ((old-silently-truncate *silently-truncate-ratios*)) (setf cl-postgres:*silently-truncate-ratios* nil) From fe4a3d3d77d6a66791c6e4e869730e04c5908e52 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Tue, 29 Dec 2020 14:42:38 -0500 Subject: [PATCH 02/10] Add :range-between, :rows-between and their use in :partition-by s-sql operators --- s-sql/s-sql.lisp | 158 ++++++++++++++++++++++++++-- s-sql/tests/tests.lisp | 232 ++++++++++++++++++++++++++++++++++------- 2 files changed, 341 insertions(+), 49 deletions(-) diff --git a/s-sql/s-sql.lisp b/s-sql/s-sql.lisp index ac4681b5..11cb8fd0 100644 --- a/s-sql/s-sql.lisp +++ b/s-sql/s-sql.lisp @@ -1076,7 +1076,7 @@ the proper SQL syntax for joining tables." `(" USING (" ,@(sql-expand-list param) ")"))))))) (is-join (x) (member x '(:left-join :right-join :inner-join :outer-join - :cross-join)))) + :cross-join :lateral-join)))) (when (null args) (sql-error "Empty :from clause in select")) (loop :for first = t :then nil :while args @@ -1366,7 +1366,7 @@ Example: `("VAR_SAMP(",@(sql-expand-list vars) ")"))) (def-sql-op :fetch (form amount &optional offset) - "Fetch is a more efficient way to do pagination instead of using limit and + "Fetch can be a more efficient way to do pagination instead of using limit and offset. Fetch allows you to retrieve a limited set of rows, optionally offset by a specified number of rows. In order to ensure this works correctly, you should use the order-by clause. If the amount is not provided, it assumes @@ -1632,16 +1632,151 @@ operator")) ,@(when returning (cons " RETURNING " (sql-expand-list returning)))))) +(def-sql-op :range-between (&rest args) + "Range-between allows window functions to apply to different segments of a result set. +It accepts the following keywords: +:order-by, :rows-between, :range-between, :unbounded-preceding, +:current-row and :unbounded-following. Use of :preceding or :following will generate errors. +See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. + +An example which calculates a running total could look like this : + + (query + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country :unbounded-preceding :current-row)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))))" + (split-on-keywords ((order-by *) (preceding ? *)(unbounded-preceding ? -) + (current-row ? -) (unbounded-following ? -)(following ? *)) + args + `("(ORDER BY ",@(sql-expand-list order-by) + " RANGE BETWEEN " + ,@(when unbounded-preceding (list "UNBOUNDED PRECEDING AND ")) + ,(when preceding + (sql-error (format nil ":range-between cannot use :preceding ~a. Use :rows-between instead." preceding))) + ,@(when current-row (list " CURRENT ROW ")) + ,@(when unbounded-following + (if current-row + (list "AND UNBOUNDED FOLLOWING ") + (list "UNBOUNDED FOLLOWING "))) + ,(when following + (sql-error (format nil ":range-between cannot use :following ~a. Use :rows-between instead." following))) + ")"))) + +(def-sql-op :rows-between (&rest args) + "Rows-between allows window functions to apply to different segments of a result set. +It accepts the following keywords: +:order-by, :rows-between, :range-between, :preceding, :unbounded-preceding, +:current-row, :unbounded-following and :following. See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. + +An example could look like this : + + (query + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :preceding 2 :following 2)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))))" + (split-on-keywords ((order-by ? *) (preceding ? *) (unbounded-preceding ? -) + (current-row ? -) (unbounded-following ? -) (following ? *)) + args + `(,@(when order-by (cons "(ORDER BY " (sql-expand-list order-by))) + " ROWS BETWEEN " + ,@(when unbounded-preceding (list "UNBOUNDED PRECEDING AND ")) + ,@(when preceding (list (format nil "~a" (car preceding)) " PRECEDING AND ")) + ,@(when current-row (list " CURRENT ROW ")) + ,@(when unbounded-following + (if unbounded-preceding + (list "UNBOUNDED FOLLOWING ") + (list "AND UNBOUNDED FOLLOWING "))) + ,@(when following + (if current-row + (list (format nil "AND ~a" (car following)) " FOLLOWING ") + (list (format nil "~a" (car following)) " FOLLOWING "))) + ")"))) + (def-sql-op :over (form &rest args) + "Over allows functions to apply to a result set, creating an additional column. +A simple example of usage would be: + + (query (:select 'salary (:over (:sum 'salary)) + :from 'empsalary)) + +A more complicated version using the :range-between operator could look like this: + (query (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country :unbounded-preceding + :unbounded-following)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5))" (if args `("(" ,@(sql-expand form) " OVER " ,@(sql-expand-list args) ")") `("(" ,@(sql-expand form) " OVER ()) "))) (def-sql-op :partition-by (&rest args) - (split-on-keywords ((partition-by *) (order-by ? *)) (cons :partition-by args) + "Partition-by allows aggregate or window functions to apply separately to +segments of a result. Partition-by accepts the following keywords: +:order-by, :rows-between, :range-between, :preceding, :unbounded-preceding, +:current-row, :unbounded-following and :following. See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. + +Example: + (query + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'region-name + :rows-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976))))" + (split-on-keywords ((partition-by *)(order-by ? *) (rows-between ? -) (range-between ? -) + (preceding ? *) (unbounded-preceding ? -) + (current-row ? -) (unbounded-following ? -) (following ? *)) + (cons :partition-by args) `("(PARTITION BY " ,@(sql-expand-list partition-by) ,@(when order-by (cons " ORDER BY " (sql-expand-list order-by))) + ,@(when rows-between (list " ROWS BETWEEN ")) + ,@(when range-between (list " RANGE BETWEEN ")) + ,@(when unbounded-preceding (list "UNBOUNDED PRECEDING AND ")) + ,(when (and preceding range-between) + (sql-error + (format nil + ":range-between cannot use :preceding ~a. Use :rows-between." + preceding))) + ,@(when (and preceding (not range-between)) + (list (format nil "~a" (car preceding)) + " PRECEDING AND ")) + ,@(when current-row (list " CURRENT ROW ")) + ,@(when unbounded-following + (if unbounded-preceding + (list "UNBOUNDED FOLLOWING ") + (list "AND UNBOUNDED FOLLOWING "))) + ,(when (and following range-between) + (sql-error + (format nil + ":range-between cannot use :following ~a. Use :rows-between." + following))) + ,@(when (and following (not range-between)) + (if current-row + (list (format nil "AND ~a" (car following)) " FOLLOWING ") + (list (format nil "~a" (car following)) " FOLLOWING "))) ")"))) (def-sql-op :parens (op) `(" (" ,@(sql-expand op) ") ")) @@ -1839,17 +1974,18 @@ definition." (:default `(" DEFAULT " ,@(sql-expand value))) (:interval `(" " ,@(expand-interval value))) (:identity-by-default - (when (eq value t) - '(" GENERATED BY DEFAULT AS IDENTITY "))) + '(" GENERATED BY DEFAULT AS IDENTITY ")) (:identity-always - (when (eq value t) - '(" GENERATED ALWAYS AS IDENTITY "))) + '(" GENERATED ALWAYS AS IDENTITY ")) (:generated-as-identity-by-default - (when (eq value t) - '(" GENERATED BY DEFAULT AS IDENTITY "))) + '(" GENERATED BY DEFAULT AS IDENTITY ")) (:generated-as-identity-always - (when (eq value t) - '(" GENERATED ALWAYS AS IDENTITY "))) + '(" GENERATED ALWAYS AS IDENTITY ")) + (:generated-as-identity-always1 + '(" GENERATED ALWAYS AS IDENTITY ")) + (:generated-always + (when value + `(" GENERATED ALWAYS AS (" ,@(sql-expand-names value) ") STORED"))) (:primary-key (cond ((and value (stringp value)) `(" PRIMARY KEY " ,value)) ((and value (keywordp value)) diff --git a/s-sql/tests/tests.lisp b/s-sql/tests/tests.lisp index 3df4a6e8..b091db63 100644 --- a/s-sql/tests/tests.lisp +++ b/s-sql/tests/tests.lisp @@ -154,15 +154,22 @@ associated with the keywords from an argument list, and checks for errors." '((OWNER "Sabra")))) (is (equal (s-sql::split-on-keywords% '((interval ? *)) '(:interval 5 hours)) '((INTERVAL 5 HOURS)))) - (is (equal (s-sql::split-on-keywords% '((a1 * ?) (b2 ?) (c3 ? *)) '(:a1 "Alpha1 " :b2 "Beta2 " :c3 "Ceta3 ")) + (is (equal (s-sql::split-on-keywords% '((a1 * ?) (b2 ?) (c3 ? *)) + '(:a1 "Alpha1 " :b2 "Beta2 " :c3 "Ceta3 ")) '((A1 "Alpha1 ") (B2 "Beta2 ") (C3 "Ceta3 ")))) - (is (equal (s-sql::split-on-keywords% '((a1 * ?) (c3 ? *)) '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 ")) + (is (equal (s-sql::split-on-keywords% '((a1 * ?) (c3 ? *)) + '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 ")) '((A1 "Alpha1 " :B2 "Beta2") (C3 "Ceta3 ")))) - (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (b2 ?) (c3 ? *)) '(:a1 "Alpha1 " :c3 "Ceta3 "))) - (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (b2 -) (c3 ? *)) '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 "))) - (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (b2 ) (c3 ? *)) '(:a1 "Alpha1 " :c3 "Ceta3 "))) - (signals sql-error (s-sql::split-on-keywords% '((owner ?)) '(:owner "Sabra" :tourist "Geoffrey"))) - (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (c3 ? )) '(:a1 "Alpha1 " :c3 "Ceta3 " "Ceta3.5"))) + (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (b2 ?) (c3 ? *)) + '(:a1 "Alpha1 " :c3 "Ceta3 "))) + (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (b2 -) (c3 ? *)) + '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 "))) + (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (b2 ) (c3 ? *)) + '(:a1 "Alpha1 " :c3 "Ceta3 "))) + (signals sql-error (s-sql::split-on-keywords% '((owner ?)) + '(:owner "Sabra" :tourist "Geoffrey"))) + (signals sql-error (s-sql::split-on-keywords% '((a1 * ?) (c3 ? )) + '(:a1 "Alpha1 " :c3 "Ceta3 " "Ceta3.5"))) (is (equal (s-sql::split-on-keywords% '((fraction *)) `(:fraction 0.5)) '((FRACTION 0.5))))) @@ -173,27 +180,33 @@ non-keyword symbols in words, and bound to these symbols. After the naming symbols, a ? can be used to indicate this argument group is optional, an * to indicate it can consist of more than one element, and a - to indicate it does not take any elements." - (is (equal (s-sql::split-on-keywords ((a1 * ?) (b2 ?) (c3 ? *)) '(:a1 "Alpha1 " :b2 "Beta2 " :c3 "Ceta3 ") - `("Results " ,@(when a1 a1) ,@(when c3 c3) ,@(when b2 b2))) + (is (equal (s-sql::split-on-keywords ((a1 * ?) (b2 ?) (c3 ? *)) + '(:a1 "Alpha1 " :b2 "Beta2 " :c3 "Ceta3 ") + `("Results " ,@(when a1 a1) ,@(when c3 c3) ,@(when b2 b2))) '("Results " "Alpha1 " "Ceta3 " "Beta2 "))) - (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (b2 ?) (c3 ? *)) '(:a1 "Alpha1 " :c3 "Ceta3 ") + (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (b2 ?) (c3 ? *)) + '(:a1 "Alpha1 " :c3 "Ceta3 ") `("Results " ,@(when a1 a1) ,@(when c3 c3) ,@(when b2 b2))) '("Results " "Alpha1 " "Ceta3 ")) - (is (equal (s-sql::split-on-keywords ((a1 * ?) (c3 ? *)) '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 ") - `("Results " ,@(when a1 a1) ,@(when c3 c3))) + (is (equal (s-sql::split-on-keywords ((a1 * ?) (c3 ? *)) + '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 ") + `("Results " ,@(when a1 a1) ,@(when c3 c3))) '("Results " "Alpha1 " :B2 "Beta2" "Ceta3 "))) ;; Keyword does not take any arguments - (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (b2 -) (c3 ? *)) '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 ") + (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (b2 -) (c3 ? *)) + '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 ") `("Results " ,@(when a1 a1) ,@(when c3 c3) ,@(when b2 b2)))) ;; Required keyword missing - (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (b2 ) (c3 ? *)) '(:a1 "Alpha1 " :c3 "Ceta3 ") + (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (b2 ) (c3 ? *)) + '(:a1 "Alpha1 " :c3 "Ceta3 ") `("Results " ,@(when a1 a1) ,@(when c3 c3) ,@(when b2 b2)))) (is (equal (s-sql::split-on-keywords ((a1 * ?) (c3 ? *)) '(:a1 "Alpha1 " :b2 "Beta2" :c3 "Ceta3 ") `("Results " ,@(when a1 a1) ,@ (when c3 c3))) '("Results " "Alpha1 " :B2 "Beta2" "Ceta3 "))) ;;too many elements for a keyword - (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (c3 ? )) '(:a1 "Alpha1 " :c3 "Ceta3 " "Ceta3.5") - `("Results " ,@(when a1 a1) ,@(when c3 c3))))) + (signals sql-error (s-sql::split-on-keywords ((a1 * ?) (c3 ? )) + '(:a1 "Alpha1 " :c3 "Ceta3 " "Ceta3.5") + `("Results " ,@(when a1 a1) ,@(when c3 c3))))) (test to-sql-name "Testing to-sql-name. Convert a symbol or string into a name that can be an sql table, @@ -485,6 +498,12 @@ to strings \(which will form an SQL query when concatenated)." (is (equal (sql (:select '* :from (:as (:values (:set 1 "one") (:set 2 "two") (:set 3 "three")) (:t1 'num 'letter)))) "(SELECT * FROM (VALUES (1, E'one'), (2, E'two'), (3, E'three')) AS t1(num, letter))"))) +(test any + (is (equal (sql (:select 'sub-region-name :from 'regions :where (:= 'id (:any* '$1)))) + "(SELECT sub_region_name FROM regions WHERE (id = ANY($1)))")) + (is (equal (sql (:select 'sub-region-name :from 'regions :where (:= 'id (:any '$1)))) + "(SELECT sub_region_name FROM regions WHERE (id = ANY $1))"))) + (test select-limit-offset (is (equal (sql (:limit (:select 'country :from 'un-m49) 5 10)) "((SELECT country FROM un_m49) LIMIT 5 OFFSET 10)"))) @@ -944,12 +963,19 @@ To sum the column len of all films and group the results by kind:" (is (equal (sql (:select (:percentile-cont :fraction array[0.25 0.5 0.75 1] :order-by 'number-of-staff) :from 'schools)) "(SELECT PERCENTILE_CONT(ARRAY[0.25 0.5 0.75 1]) WITHIN GROUP (ORDER BY number_of_staff) FROM schools)")) - (is (equal (sql (:order-by (:select 'day - (:over (:percentile-cont :fraction 0.25 :order-by (:asc 'duration)) (:partition-by 'day)) - (:over (:percentile-cont :fraction 0.5 :order-by (:asc 'duration)) (:partition-by 'day)) - (:over (:percentile-cont :fraction 0.75 :order-by (:asc 'duration)) (:partition-by 'day)) - (:over (:percentile-cont :fraction 0.85 :order-by (:asc 'duration)) (:partition-by 'day)) - :from 'query-durations :group-by 1 ) 1)) + (is (equal (sql (:order-by + (:select 'day + (:over (:percentile-cont :fraction 0.25 :order-by (:asc 'duration)) + (:partition-by 'day)) + (:over (:percentile-cont :fraction 0.5 :order-by (:asc 'duration)) + (:partition-by 'day)) + (:over (:percentile-cont :fraction 0.75 :order-by (:asc 'duration)) + (:partition-by 'day)) + (:over (:percentile-cont :fraction 0.85 :order-by (:asc 'duration)) + (:partition-by 'day)) + :from 'query-durations + :group-by 1 ) + 1)) "((SELECT day, (PERCENTILE_CONT(0.25) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)), (PERCENTILE_CONT(0.5) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)), (PERCENTILE_CONT(0.75) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)), (PERCENTILE_CONT(0.85) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)) FROM query_durations GROUP BY 1) ORDER BY 1)"))) (test percentile-dist @@ -2033,21 +2059,151 @@ that the table will need to be scanned twice. Everything is a trade-off." (is-false (table-exists-p "table_1")))))) (test over - (is (equal (sql (:over (:sum 'salary))) - "(SUM(salary) OVER ()) ")) - (is (equal (sql (:over (:sum 'salary) 'w)) - "(SUM(salary) OVER w)")) - (is (equal (sql (:over (:count '*) - (:partition-by (:date-trunc "month" 'joindate)))) - "(COUNT(*) OVER (PARTITION BY date_trunc(E'month', joindate)))")) - (is (equal (sql (:over (:rank) (:order-by (:desc 'total)))) - "(rank() OVER ( ORDER BY total DESC))")) - (is (equal (sql (:over (:percentile-cont :fraction 0.25 :order-by (:asc 'duration)) - (:partition-by 'day))) - "(PERCENTILE_CONT(0.25) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day))"))) + (is (equal (sql (:over (:sum 'salary))) + "(SUM(salary) OVER ()) ")) + (is (equal (sql (:over (:sum 'salary) 'w)) + "(SUM(salary) OVER w)")) + (is (equal (sql (:over (:count '*) + (:partition-by (:date-trunc "month" 'joindate)))) + "(COUNT(*) OVER (PARTITION BY date_trunc(E'month', joindate)))")) + (is (equal (sql (:over (:rank) (:order-by (:desc 'total)))) + "(rank() OVER ( ORDER BY total DESC))")) + (is (equal (sql (:over (:percentile-cont :fraction 0.25 :order-by (:asc 'duration)) + (:partition-by 'day))) + "(PERCENTILE_CONT(0.25) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day))"))) (test between - (is (equal (sql (:between 'latitude -10 10)) - "(latitude BETWEEN -10 AND 10)")) - (is (equal (sql (:between (:- 'population.year 'ma-population.year) 0 2)) - "((population.year - ma_population.year) BETWEEN 0 AND 2)"))) + (is (equal (sql (:between 'latitude -10 10)) + "(latitude BETWEEN -10 AND 10)")) + (is (equal (sql (:between (:- 'population.year 'ma-population.year) 0 2)) + "((population.year - ma_population.year) BETWEEN 0 AND 2)"))) + +(test over-range-between + (signals error + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country :preceding 2 :following 2)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5))) + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country :unbounded-preceding + :unbounded-following)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country RANGE BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country :current-row + :unbounded-following)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country RANGE BETWEEN CURRENT ROW AND UNBOUNDED FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) + +(test over-row-between + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :preceding 2 + :following 2)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN 2 PRECEDING AND 2 FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :current-row + :following 2)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN CURRENT ROW AND 2 FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :preceding 2 + :current-row)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN 2 PRECEDING AND CURRENT ROW )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) + +(test over-with-partition-with-range-or-row-between + (is (equal + (sql (:limit + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'population.country + :range-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976))) + 5)) + "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY population.country RANGE BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'region-name + :range-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976))) + 5)) + "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY region_name RANGE BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'region-name + :rows-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976))) + 5)) + "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY region_name ROWS BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) From f4207a2787189ef4c29387b1985ec751d25f9b85 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Tue, 12 Jan 2021 11:36:05 -0500 Subject: [PATCH 03/10] Update README --- README.md | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index e4b0d230..3567d681 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # Postmodern A Common Lisp PostgreSQL programming interface --- -Version 1.32 +Version 1.38 Postmodern is a Common Lisp library for interacting with [PostgreSQL](http://www.postgresql.org) databases. It is under active development. Features are: @@ -19,6 +19,13 @@ The biggest differences between this library and CLSQL/CommonSQL or cl-dbi are t * [License](#dependencies) * [Download and installation](#download-and-installation) * [Quickstart](#quickstart) +* [Authentication](#authentication) +* [Reference](#reference) +* [Data types](#data-types) +* [Portability](#portability) +* [Reserved Words](#reserved-words) +* [Feature Requests](#feature-requests) +* [Resources](#resources) * [Running tests](#running-tests) * [Reference](#reference) * [Caveats and to-dos](#caveats-and-to-dos) @@ -419,9 +426,8 @@ The reference manuals for the different components of Postmodern are kept in sep - [Simple-date](https://marijnhaverbeke.nl/postmodern/simple-date.html) - [CL-postgres](https://marijnhaverbeke.nl/postmodern/cl-postgres.html) -## Data Types, Caveats and to-dos +## Data Types --- -### Data Types For a short comparison of lisp and Postgresql data types (date and time datatypes are described in the next section) @@ -551,7 +557,7 @@ the same sample data looks like: | timestamp\_without\_timezone | 2020-05-16T05:47:33.315622-04:00 | TIMESTAMP | | timestamp\_with\_timezone | 2020-05-16T09:47:27.855146-04:00 | TIMESTAMP | -### Portability +## Portability The Lisp code in Postmodern is theoretically portable across implementations, and seems to work on all major ones as well as some minor ones such as Genera. It is regularly tested on ccl, sbcl, ecl and cmucl. ABCL currently has issues with utf-8 and :null. @@ -560,7 +566,7 @@ Please let us know if it does not work on the implementation that you normally u The library is not likely to work for PostgreSQL versions older than 8.4. Other features only work in newer Postgresql versions as the features were only introduced in those newer versions. -### Reserved Words +## Reserved Words It is highly suggested that you do not use words that are reserved by Postgresql as identifiers (e.g. table names, columns). The reserved words are: "all" "analyse" "analyze" "and" "any" "array" "as" "asc" "asymmetric" @@ -577,12 +583,10 @@ It is highly suggested that you do not use words that are reserved by Postgresql "similar" "some" "symmetric" "table" "then" "to" "trailing" "true" "union" "unique" "user" "using" "variadic" "verbose" "when" "where" "window" "with" -### Things that could be implemented +## Feature Requests Postmodern is under active development so issues and feature requests should be flagged on [[https://github.com/marijnh/Postmodern](Postmodern's site on github). -Some areas that are currently under consideration can be found in the ROADMAP.md file. - ## Resources --- - [Mailing List](https://mailman.common-lisp.net/listinfo/postmodern-devel) From 6f9ccf8574a9df8a8d8e1f6d899569737296caba Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Wed, 13 Jan 2021 07:51:05 -0500 Subject: [PATCH 04/10] copy-from-csv convenience function Runs the psql copy command from inside lisp. Uses uiop:run-program --- postmodern/util.lisp | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/postmodern/util.lisp b/postmodern/util.lisp index 7d402185..f3df42db 100644 --- a/postmodern/util.lisp +++ b/postmodern/util.lisp @@ -1281,3 +1281,22 @@ underscore and returns the modified string." (alphanumericp ch)) (write-char ch) (write-char replacement)))))) + +(defun copy-from-csv (tablename filename + &key (delimiter 'comma) (header-p nil) + (database (when *database* (cl-postgres::connection-db *database*))) + (user (when *database* (cl-postgres::connection-user *database*))) + (password (when *database* (cl-postgres::connection-password *database*))) + (host (if *database* (cl-postgres::connection-host *database*) + "localhost")) + (port (if *database* (cl-postgres::connection-port *database*) + 5432))) + "Runs the psql copy command against a file. Assuming you are already connected to the desired database and the *database* global variable is set to that, then the mMinimum parameters required are the postgresql table-name and the file name including its absolute path. The delimiter parameter should be either 'comma or 'tab. Set the header-p parameter t if the first line of the csv file is a header that should not get imported into the database table. The table name can be either a string or quoted symbol." + (setf tablename (to-sql-name tablename)) + (uiop:run-program + (format nil "psql postgresql://~a:~a@~a:~a/~a -c \"\\copy ~a from '~a' delimiter ~a csv ~a;\"" + user password host port database tablename filename + (case delimiter + (comma "','") + (tab "E'\t'")) + (if header-p "HEADER" "")) :output :string)) From a8181422017c14bc58bcfc38eb301ad8ec9660f8 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Wed, 13 Jan 2021 07:54:35 -0500 Subject: [PATCH 05/10] Correct typo in roles.lisp --- postmodern/roles.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/postmodern/roles.lisp b/postmodern/roles.lisp index 41870477..68faee78 100644 --- a/postmodern/roles.lisp +++ b/postmodern/roles.lisp @@ -306,7 +306,7 @@ read-only role with access to only a limited number of tables." (grant-editor-permissions schema-x name)) (:readonly (grant-readonly-permissions schema-x name)) - (t (query (readonly-permissions schema-x name))))) + (t (query (grant-readonly-permissions schema-x name))))) ((listp tables) (let ((existing-tables (list-tables t))) ; Grant access to existing tables (when (or (eq (first tables) :all) From bd09e043f2e520e215f6d853d2194c73b4cef611 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Wed, 13 Jan 2021 07:55:39 -0500 Subject: [PATCH 06/10] Small formatting change in test-roles Slight rearrangement of parameter definition locations in the file to reduce some compiler warnings --- postmodern/tests/test-roles.lisp | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/postmodern/tests/test-roles.lisp b/postmodern/tests/test-roles.lisp index 9a5c6312..f7ba1465 100644 --- a/postmodern/tests/test-roles.lisp +++ b/postmodern/tests/test-roles.lisp @@ -23,6 +23,22 @@ ;;; These tests must be run in order. They also assume that the existing user is a superuser +(defun test-create-role-names () + (let ((names nil)) + (loop for database in '("d1" "d2" "all") do + (loop for schema in '("public" "s2") do + (loop for table in '("t1" "all") do + (let ((name (format nil "readonly_d_~a_s_~a_t_~a" database schema table))) + (push name names))))) + (push "standard" names) + names)) + +(defparameter *test-dbs* '("d1" "d1_al" "d2" "d2_al" "d3" "d3_al")) +(defparameter *first-test-dbs* '("d1" "d1_al" "d2" "d2_al")) +(defparameter *subsequent-test-dbs* '("d3")) +(defparameter *public-limited-test-dbs* '("d1_al""d2_al" "d3_al")) +(defparameter *test-roles* (test-create-role-names)) + (defun test-result (result) (cond ((not (listp result)) result) @@ -55,15 +71,6 @@ (loop for table in '("t1" "t2" "t3") do (generate-test-table-row database name schema table)))))) -(defun test-create-role-names () - (let ((names nil)) - (loop for database in '("d1" "d2" "all") do - (loop for schema in '("public" "s2") do - (loop for table in '("t1" "all") do - (let ((name (format nil "readonly_d_~a_s_~a_t_~a" database schema table))) - (push name names))))) - (push "standard" names) - names)) (defun test-create-roles () (loop for database in '("d1" "d2" "all") do @@ -76,12 +83,6 @@ database)))))) (create-role "standard" "standard" :base-role :standard)) -(defparameter *test-dbs* '("d1" "d1_al" "d2" "d2_al" "d3" "d3_al")) -(defparameter *first-test-dbs* '("d1" "d1_al" "d2" "d2_al")) -(defparameter *subsequent-test-dbs* '("d3")) -(defparameter *public-limited-test-dbs* '("d1_al""d2_al" "d3_al")) -(defparameter *test-roles* (test-create-role-names)) - (defun clean-test () "Drops roles and databases created by this test suite." (with-test-connection From c74af70bd5e060830be47c256cb582b5cd34f913 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Wed, 13 Jan 2021 07:57:35 -0500 Subject: [PATCH 07/10] S-SQL Enhancements :Update without the :columns parameter, :update requires alternating column value like so: (query (:update 'weather :set 'temp-lo (:+ 'temp-lo 1) 'temp-hi (:+ 'temp-lo 15) 'prcp :default :where (:and (:= 'city "San Francisco") (:= 'date "2003-07-03")) :returning 'temp-lo 'temp-hi 'prcp)) :update now accepts a :columns parameter. This allows the use of either :set or :select (both of which need to be enclosed in a form) to provide the values, allowing update queries like: (query (:update 'weather :columns 'temp-lo 'temp-hi 'prcp (:set (:+ 'temp-lo 1) (:+ 'temp-lo 15) :DEFAULT) :where (:and (:= 'city "San Francisco") (:= 'date "2003-07-03")))) (query (:update 't1 :columns 'database-name 'encoding (:select 'x.datname 'x.encoding :from (:as 'pg-database 'x) :where (:= 'x.oid 't1.oid)))) :Insert-into Insert-into also now accepts a :columns parameter which allows more precise use of select to insert values into specific row(s). A sample query could look like: (query (:insert-into 't11 :columns 'region 'subregion 'country (:select (:as 'region-name 'region) (:as 'sub-region-name 'subregion) 'country :from 'regions))) Joins Lateral Joins Joins are now expanded to include lateral joins. So addition join types are - :join-lateral (best practice is still to be specific on what kind of join you want) - :left-join-lateral - :right-join-lateral - :inner-join-lateral - :outer-join-lateral - :cross-join-lateral Ordinality Selects can now use :with-ordinality or :with-ordinality-as parameters. Postgresql will give the new ordinality column the name of ordinality. :with-ordinality-as allows you to set different names for the columns in the result set. (query (:select '* :from (:generate-series 4 1 -1) :with-ordinality)) (query (:select 't1.* :from (:json-object-keys "{\"a1\":\"1\",\"a2\":\"2\",\"a3\":\"3\"}") :with-ordinality-as (:t1 'keys 'n) New Utility copy-from-csv Just a convenience function. It runs the psql copy command from inside lisp using uiop:run-program --- s-sql/s-sql.lisp | 166 +++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 140 insertions(+), 26 deletions(-) diff --git a/s-sql/s-sql.lisp b/s-sql/s-sql.lisp index 11cb8fd0..f071f7b5 100644 --- a/s-sql/s-sql.lisp +++ b/s-sql/s-sql.lisp @@ -35,10 +35,11 @@ errors." (optional (member '? (car words))) (multi (member '* (car words))) (no-args (member '- (car words))) + (zero-or-more (member '^ (car words))) (found (position me values))) (cond (found (let ((after-me (nthcdr (1+ found) values))) - (unless (or after-me no-args) + (unless (or after-me no-args zero-or-more) (sql-error "Keyword ~A encountered at end of arguments." me)) (let ((next (next-word (cdr words) after-me))) @@ -51,6 +52,7 @@ errors." (unless (>= next 1) (sql-error "Not enough arguments to keyword ~A." me))) + (zero-or-more t) (t (unless (= next 1) (sql-error "Keyword ~A takes exactly one argument." me)))) @@ -342,7 +344,7 @@ Symbols will be converted to SQL names. Examples: string)))) (defparameter *expand-runtime* nil) - +#| (defun sql-expand (arg) "Compile-time expansion of forms into lists of stuff that evaluate to strings (which will form a SQL query when concatenated)." @@ -364,6 +366,30 @@ to strings (which will form a SQL query when concatenated)." (not (or (keywordp arg) (eq arg t) (eq arg nil))))) (list `(sql-escape ,arg))) (t (list (sql-escape arg))))) +|# +;;; CURRENT DRAFT +(defun sql-expand (arg) + "Compile-time expansion of forms into lists of stuff that evaluate +to strings (which will form a SQL query when concatenated). NEW :default will +return ' DEFAULT' " + + (cond ((eq arg :default) (list " DEFAULT ")) ((and (consp arg) (keywordp (first arg))) + (expand-sql-op (car arg) (cdr arg))) + ((and (consp arg) (eq (first arg) 'quote)) + (list (sql-escape (second arg)))) + ((and (consp arg) *expand-runtime*) + (expand-sql-op (intern (symbol-name (car arg)) :keyword) (cdr arg))) + ((and (eq arg '$$) *expand-runtime*) + '($$)) + (*expand-runtime* + (list (sql-escape arg))) + ((consp arg) + (list `(sql-escape ,arg))) + ((or (consp arg) + (and (symbolp arg) + (not (or (keywordp arg) (eq arg t) (eq arg nil))))) + (list `(sql-escape ,arg))) + (t (list (sql-escape arg))))) (defun sql-expand-list (elts &optional (sep ", ")) "Expand a list of elements, adding a separator between them." @@ -1056,34 +1082,69 @@ variables. As an example: "Helper for the select operator. Turns the part following :from into the proper SQL syntax for joining tables." (labels ((expand-join (natural-p) - (let ((type (first args)) (table (second args)) kind param) - (unless table (sql-error "Incomplete join clause in select.")) + (let ((type (first args)) (table (second args)) kind param ordinality-as) + (unless (or table + (eq type :with-ordinality)) + (sql-error "Incomplete join clause in select.")) (setf args (cddr args)) - (unless (or natural-p (eq type :cross-join)) + (unless (or natural-p (eq type :cross-join) (eq type :lateral)) (setf kind (pop args)) - (unless (and (or (eq kind :on) (eq kind :using)) args) - (sql-error "Incorrect join form in select.")) + (unless (or (not (is-join kind)) + (and (or (eq kind :with-ordinality) + (eq kind :with-ordinality-as) + (eq kind :on) + (eq kind :lateral) + (eq kind :using)) + args)) + (sql-error "Incorrect join form in select.")) (setf param (pop args))) `(" " ,@(when natural-p '("NATURAL ")) ,(ecase type - (:left-join "LEFT") (:right-join "RIGHT") - (:inner-join "INNER") (:outer-join "FULL OUTER") - (:cross-join "CROSS")) " JOIN " ,@(sql-expand table) - ,@(unless (or natural-p (eq type :cross-join)) - (ecase kind - (:on `(" ON " . ,(sql-expand param))) - (:using + (:lateral ", LATERAL ") + (:join "JOIN ") + (:left-join "LEFT JOIN ") + (:right-join "RIGHT JOIN ") + (:inner-join "INNER JOIN ") + (:outer-join "FULL OUTER JOIN ") + (:cross-join "CROSS JOIN ") + (:join-lateral "JOIN LATERAL ") + (:left-join-lateral "LEFT JOIN LATERAL ") + (:right-join-lateral "RIGHT JOIN LATERAL ") + (:inner-join-lateral "INNER JOIN LATERAL ") + (:outer-join-lateral "FULL OUTER JOIN LATERAL ") + (:cross-join-lateral "CROSS JOIN LATERAL ") + (:with-ordinality "WITH ORDINALITY ") + (:with-ordinality-as "WITH ORDINALITY AS ")) + ,@(when table;(not (eq type :with-ordinality)) + (sql-expand table)) + ,@(unless (or natural-p (eq type :cross-join)) + `("" ,@(if (eq kind :with-ordinality) + (progn (setf kind param) + (setf param (pop args)) + `(" WITH ORDINALITY " ))) + ,@(when (eq kind :with-ordinality-as) + (setf ordinality-as param) + (setf kind (pop args)) + (setf param (pop args)) + `(" WITH ORDINALITY AS " . ,(sql-expand ordinality-as))) + ,@(when (eq kind :on) + `(" ON " . ,(sql-expand param))) + ,@(when (eq kind :using) `(" USING (" ,@(sql-expand-list param) ")"))))))) (is-join (x) - (member x '(:left-join :right-join :inner-join :outer-join - :cross-join :lateral-join)))) + (member x '(:joint :left-join :right-join :inner-join :outer-join + :cross-join :join-lateral :left-join-lateral :right-join-lateral + :inner-join-lateral :outer-join-lateral + :cross-join-lateral :lateral-join :with-ordinality :with-ordinality-as + :lateral)))) (when (null args) (sql-error "Empty :from clause in select")) (loop :for first = t :then nil :while args :append (cond ((is-join (car args)) (when first (sql-error ":from clause starts with a join.")) - (expand-join nil)) + (progn ;(format t "A1: args ~a~%" args) + (expand-join nil))) ((eq (car args) :natural) (when first (sql-error ":from clause starts with a join.")) @@ -1092,6 +1153,7 @@ the proper SQL syntax for joining tables." (t `(,@(if first () '(", ")) ,@(sql-expand (pop args)))))))) + (def-sql-op :select (&rest args) "Creates a select query. The arguments are split on the keywords found among them. The group of arguments immediately after :select is interpreted as @@ -1099,19 +1161,47 @@ the expressions that should be selected. After this, an optional :distinct may follow, which will cause the query to only select distinct rows, or alternatively :distinct-on followed by a group of row names. Next comes the optional keyword :from, followed by at least one table name and then any -number of join statements. Join statements start with one of :left-join, -:right-join, :inner-join, :outer-join or :cross-join, then a table name or -subquery, then the keyword :on or :using, if applicable, and then a form. +number of join statements. + +Join statements start with one of :left-join, +:right-join, :inner-join, :outer-join, :cross-join (or those with -lateral, +e.g :left-join-lateral, :right-join-lateral, :inner-join-lateral, :outer-join-lateral). +S-sql will not accept :join, use :inner-join instead. + +Then comes a table name or subquery, + +then there is an optional :with-ordinality or :with-ordinality-as alisa + +Then the keyword :on or :using, if applicable, and then a form. A join can be preceded by :natural (leaving off the :on clause) to use a -natural join. After the joins an optional :where followed by a single form -may occur. And finally :group-by and :having can optionally be specified. -The first takes any number of arguments, and the second only one. An example: +natural join. + +After the joins an optional :where followed by a single form may occur. + +And finally :group-by and :having can optionally be specified. +The first takes any number of arguments, and the second only one. + +A few examples: (query (:select (:+ 'field-1 100) 'field-5 :from (:as 'my-table 'x) :left-join 'your-table :on (:= 'x.field-2 'your-table.field-1) - :where (:not-null 'a.field-3)))" + :where (:not-null 'a.field-3))) + + (query (:select 'i.* 'p.* + :from (:as 'individual 'i) + :inner-join (:as 'publisher 'p) + :using ('individualid) + :left-join-lateral (:as 'anothertable 'a) + :on (:= 'a.identifier 'i.individualid) + :where (:= 'a.something \"something\"))) + + (query (:select 't1.id 'a.elem 'a.nr + :from (:as 't12 't1) + :left-join (:unnest (:string-to-array 't1.elements \",\")) + :with-ordinality-as (:a 'elem 'nr) + :on 't))" (split-on-keywords ((vars *) (distinct - ?) (distinct-on * ?) (from * ?) (where ?) (group-by * ?) (having ?) (window ?)) (cons :vars args) @@ -1365,7 +1455,7 @@ Example: (split-on-keywords ((vars *)) (cons :vars args) `("VAR_SAMP(",@(sql-expand-list vars) ")"))) -(def-sql-op :fetch (form amount &optional offset) +(def-sql-op :fetch (form &optional amount offset) "Fetch can be a more efficient way to do pagination instead of using limit and offset. Fetch allows you to retrieve a limited set of rows, optionally offset by a specified number of rows. In order to ensure this works correctly, you @@ -1479,6 +1569,9 @@ passed to insert-into sql operator")) :by #'cddr :collect value)) ")")))) + ((eq (car method) :columns) + `(" (" ,@(sql-expand-list (butlast (cdr method))) ") " + ,@(sql-expand (car (last method))))) ((and (not (cdr method)) (consp (car method)) (keywordp (caar method))) (sql-expand (car method))) @@ -1608,7 +1701,7 @@ passed to insert-into sql operator")) ,@(if where (cons " WHERE " (sql-expand (car where))) ()))) ,@(when returning `(" RETURNING " ,@(sql-expand-list returning)))))) - +#| (def-sql-op :update (table &rest args) (split-on-keywords ((set *) (from * ?) (where ?) (returning ? *)) args (when (oddp (length set)) @@ -1624,6 +1717,26 @@ operator")) ,@(if where (cons " WHERE " (sql-expand (car where))) ()) ,@(when returning (cons " RETURNING " (sql-expand-list returning)))))) +|# +;;;CURRENT DRAFT +(def-sql-op :update (table &rest args) + (split-on-keywords ((set * ?) (columns ? *) (from * ?) (where ?) (returning ? *)) args + (when (oddp (length set)) + (sql-error "Invalid amount of :set arguments passed to update sql operator")) + `("UPDATE " ,@(sql-expand table) + ,@(when columns `(" SET (" ,@(sql-expand-list (butlast columns)) ") = " + ,@(sql-expand (car (last columns))))) + ,@(when (and set (not columns)) (list " SET ")) + ,@(when (and set (not columns)) (loop :for (field value) :on set :by #'cddr + :for first = t :then nil + :append `(,@(if first () '(", ")) ,@(sql-expand field) + " = " + ,@(sql-expand value)))) + ,@(if from (cons " FROM " (expand-joins from))) + ,@(if where (cons " WHERE " (sql-expand (car where))) ()) + ,@(when returning + (cons " RETURNING " (sql-expand-list returning)))))) + (def-sql-op :delete-from (table &rest args) (split-on-keywords ((where ?) (returning ? *)) args @@ -1724,6 +1837,7 @@ A more complicated version using the :range-between operator could look like thi (if args `("(" ,@(sql-expand form) " OVER " ,@(sql-expand-list args) ")") `("(" ,@(sql-expand form) " OVER ()) "))) + (def-sql-op :partition-by (&rest args) "Partition-by allows aggregate or window functions to apply separately to segments of a result. Partition-by accepts the following keywords: From 3ee93528fedd6ed0828eb1146a11d7da5a91fe95 Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Wed, 13 Jan 2021 09:34:31 -0500 Subject: [PATCH 08/10] S-SQL Enhancements :Update without the :columns parameter, :update requires alternating column value like so: (query (:update 'weather :set 'temp-lo (:+ 'temp-lo 1) 'temp-hi (:+ 'temp-lo 15) 'prcp :default :where (:and (:= 'city "San Francisco") (:= 'date "2003-07-03")) :returning 'temp-lo 'temp-hi 'prcp)) :update now accepts a :columns parameter. This allows the use of either :set or :select (both of which need to be enclosed in a form) to provide the values, allowing update queries like: (query (:update 'weather :columns 'temp-lo 'temp-hi 'prcp (:set (:+ 'temp-lo 1) (:+ 'temp-lo 15) :DEFAULT) :where (:and (:= 'city "San Francisco") (:= 'date "2003-07-03")))) (query (:update 't1 :columns 'database-name 'encoding (:select 'x.datname 'x.encoding :from (:as 'pg-database 'x) :where (:= 'x.oid 't1.oid)))) :Insert-into Insert-into also now accepts a :columns parameter which allows more precise use of select to insert values into specific row(s). A sample query could look like: (query (:insert-into 't11 :columns 'region 'subregion 'country (:select (:as 'region-name 'region) (:as 'sub-region-name 'subregion) 'country :from 'regions))) Joins Lateral Joins Joins are now expanded to include lateral joins. So addition join types are - :join-lateral (best practice is still to be specific on what kind of join you want) - :left-join-lateral - :right-join-lateral - :inner-join-lateral - :outer-join-lateral - :cross-join-lateral Ordinality Selects can now use :with-ordinality or :with-ordinality-as parameters. Postgresql will give the new ordinality column the name of ordinality. :with-ordinality-as allows you to set different names for the columns in the result set. (query (:select '* :from (:generate-series 4 1 -1) :with-ordinality)) (query (:select 't1.* :from (:json-object-keys "{\"a1\":\"1\",\"a2\":\"2\",\"a3\":\"3\"}") :with-ordinality-as (:t1 'keys 'n) New Utility copy-from-csv Just a convenience function. It runs the psql copy command from inside lisp using uiop:run-program --- CHANGELOG.md | 112 +- ROADMAP.md | 12 +- cl-postgres.asd | 2 +- doc/s-sql.html | 902 +++++++----- doc/s-sql.org | 227 ++- postmodern.asd | 2 +- s-sql.asd | 2 +- s-sql/s-sql.lisp | 51 +- s-sql/tests/test-tables.lisp | 54 +- s-sql/tests/tests.lisp | 2649 ++++++++++++++++++++-------------- 10 files changed, 2486 insertions(+), 1527 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 302b195e..2f583e7d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,114 @@ -# Changelog v. 1.32.1 +# Changelog v. 1.32.8 +S-SQL Enhancements + +## :Update +without the :columns parameter, :update requires alternating column value like so: + + (query (:update 'weather + :set 'temp-lo (:+ 'temp-lo 1) + 'temp-hi (:+ 'temp-lo 15) + 'prcp :default + :where (:and (:= 'city "San Francisco") + (:= 'date "2003-07-03")) + :returning 'temp-lo 'temp-hi 'prcp)) + +:update now accepts a :columns parameter. This allows the use of either :set or :select (both of which need to be enclosed in a form) to provide the values, allowing update queries like: + + (query (:update 'weather + :columns 'temp-lo 'temp-hi 'prcp + (:set (:+ 'temp-lo 1) (:+ 'temp-lo 15) :DEFAULT) + :where (:and (:= 'city "San Francisco") + (:= 'date "2003-07-03")))) + + (query (:update 't1 + :columns 'database-name 'encoding + (:select 'x.datname 'x.encoding + :from (:as 'pg-database 'x) + :where (:= 'x.oid 't1.oid)))) + +## :Insert-into +Insert-into also now accepts a :columns parameter which allows more precise use of select to insert values into specific row(s). A sample query could look like: + + (query (:insert-into 't11 + :columns 'region 'subregion 'country + (:select (:as 'region-name 'region) + (:as 'sub-region-name 'subregion) + 'country + :from 'regions))) + +## Joins +### Lateral Joins +Joins are now expanded to include lateral joins. So addition join types are + +- :join-lateral (best practice is still to be specific on what kind of join you want) +- :left-join-lateral +- :right-join-lateral +- :inner-join-lateral +- :outer-join-lateral +- :cross-join-lateral + +### Ordinality +Selects can now use :with-ordinality or :with-ordinality-as parameters. Postgresql will give the new ordinality column the name of ordinality. :with-ordinality-as allows you to set different names for the columns in the result set. + + (query (:select '* + :from (:generate-series 4 1 -1) + :with-ordinality)) + + + (query (:select 't1.* + :from (:json-object-keys "{\"a1\":\"1\",\"a2\":\"2\",\"a3\":\"3\"}") + :with-ordinality-as (:t1 'keys 'n) + + +## New Utility copy-from-csv +Just a convenience function. It runs the psql copy command from inside lisp using uiop:run-program + +# Changelog v. 1.32.7 + +Additional capabilities for s-sql functions :insert-into and :insert-rows-into + +Specifically, both can now use: + +- overriding-system-value +- overriding-user-value +- on-conflict-do-nothing +- on-conflict +- on-conflict-on-constraint +- on-conflict-update +- do-nothing +- update-set +- from +- where +- returning + +See updated s-sql docs for examples. + +# Changelog v. 1.32.4 + +Added the ability to return results as json-encoded results as follows: + +- :Json-strs +Return a list of strings where the row returned is a json object expressed as a string + + (query (:select 'id 'int4 'text :from 'short-data-type-tests :where (:< 'id 3)) :json-strs) + ("{\"id\":1,\"int4\":2147483645,\"text\":\"text one\"}" + "{\"id\":2,\"int4\":0,\"text\":\"text two\"}") + +- :Json-str +Return a single string where the row returned is a json object expressed as a string + + (query (:select 'id 'int4 'text :from 'short-data-type-tests :where (:= 'id 3)) :json-str) + "{\"id\":3,\"int4\":3,\"text\":\"text three\"}" + +- :Json-array-str +Return a string containing a json array, each element in the array is a selected row expressed as a json object + + (query (:select 'id 'int4 'text :from 'short-data-type-tests :where (:< 'id 3)) :json-array-str) + "[{\"id\":1,\"int4\":2147483645,\"text\":\"text one\"}, {\"id\":2,\"int4\":0,\"text\":\"text two\"}]" + +# Changelog v. 1.32.3 + +Added flag to avoid SSL certificate verification if required by user ## Fix S-SQL issue 239 (:drop-table ...) expanded incorrectly diff --git a/ROADMAP.md b/ROADMAP.md index 2929999f..1103e18c 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -1,4 +1,4 @@ -# Roadmap +# Possible Roadmap Postmodern is a common lisp support library for the postgresql database. It makes no attempt to be database agnostic. You can think of postmodern as having three components - cl-postgres : a low level interface for communicating with a postgresql database server @@ -13,13 +13,10 @@ welcomed, particularly by anyone willing to work on the item. No guarantee is given with respect to resolution or timing on any item. ## Sql support -- [ ] Hypothetical Set Aggregates Functions (rank, dense-rank, percent-rank, cume-dist) - [ ] UUID (see e.g https://github.com/michaeljforster/cl-postgres-plus-uuid) Postgresql has a uuid extension. A database owner needs to add the extension manually to the specific database, calling: create extension if not exists "uuid-ossp"; A uuid can then be generated in postmodern by calling (query (:select (:uuid-generate-v1))) -- [ ] Generate-Series needs testing and interval work -- [ ] Lateral Join (postgresql 9.3) - [ ] Transition tables for triggers (postgresql 10) - [ ] Hash Indexes (postgresql 10, See https://blog.2ndquadrant.com/postgresql-10-identity-columns/, https://www.depesz.com/2017/04/10/waiting-for-postgresql-10-identity-columns/) @@ -27,11 +24,10 @@ No guarantee is given with respect to resolution or timing on any item. - [ ] WITH CHECK clause - Auto-updatable views can now specify whether an INSERT or UPDATE would change the state of the row so that it would no longer be visible in the view. Using WITH CHECK OPTION will prevent any such changes from occuring. (postgresql 9.4) -- [ ] WITH ORDINALITY clause (postgresql 9.4) - [ ] Table Creation with different indexes (various postgresql version additions) +- [ ] Generated columns - see https://pgdash.io/blog/postgres-12-generated-columns.html - [ ] Postgresql regular expression support - see https://www.postgresql.org/docs/current/static/pgtrgm.html -- [ ] Multiple row upserts -- [ ] Crosstabview support (postgresql 9.6) +- [ ] Create table by selecting from another table. ## Data type support - [ ] json, jsonb (postgresql 9.4, full text search support in postgresql 10) See @@ -76,7 +72,7 @@ No guarantee is given with respect to resolution or timing on any item. ## Security Audit -## Long Range +## Long Range (Likely Never) - [ ] Consider extending dao into more ORM capability - [ ] Multi-Cluster Support - [ ] Replication Support diff --git a/cl-postgres.asd b/cl-postgres.asd index b068da8c..cbd2b694 100644 --- a/cl-postgres.asd +++ b/cl-postgres.asd @@ -16,7 +16,7 @@ :author "Marijn Haverbeke " :maintainer "Sabra Crolleton " :license "zlib" - :version "1.32.7" + :version "1.32.8" :depends-on ("md5" "split-sequence" "ironclad" "cl-base64" "uax-15" (:feature (:or :sbcl :allegro :ccl :clisp :genera :armedbear :cmucl :lispworks) diff --git a/doc/s-sql.html b/doc/s-sql.html index d75ec05a..3e3ea689 100644 --- a/doc/s-sql.html +++ b/doc/s-sql.html @@ -1,7 +1,7 @@ - + S-SQL Reference Manual @@ -284,10 +284,10 @@

Table of Contents

  • sql-op :select (&rest args)
  • Joins
  • @@ -381,11 +381,14 @@

    Table of Contents

  • sql-op :variance (&rest args)
  • sql-op :var-pop (&rest args)
  • sql-op :var-samp (&rest args)
  • +
  • sql-op :range-between (&rest args)
  • +
  • sql-op :rows-between (&rest args)
  • sql-op :over (form &rest args)
  • sql-op :partition-by (&rest args)
  • sql-op :window (form)
  • sql-op :with (&rest args)
  • sql-op :with-recursive (&rest args)
  • +
  • sql-op :with-ordinality, :with-ordinality-as
  • Table Functions @@ -449,12 +452,12 @@

    Table of Contents

    is all that is needed to produce the final SQL query.

    -
    -

    Interface

    +
    +

    Interface

    -
    -

    macro sql (form)

    +
    +

    macro sql (form)

    → string @@ -485,8 +488,8 @@

    -

    function sql-compile (form)

    +
    +

    function sql-compile (form)

    → string @@ -518,8 +521,8 @@

    -

    function sql-template (form)

    +
    +

    function sql-template (form)

    In cases where you do need to build the query at run time, yet you do not @@ -532,8 +535,8 @@

    -

    function enable-s-sql-syntax (&optional (char #\Q))

    +
    +

    function enable-s-sql-syntax (&optional (char #\Q))

    Modifies the current readtable to add a #Q syntax that is read as (sql …). @@ -541,8 +544,8 @@

    -

    function sql-escape-string (string)

    +
    +

    function sql-escape-string (string)

    → string @@ -561,8 +564,8 @@

    -

    method sql-escape (value)

    +
    +

    method sql-escape (value)

    → string @@ -588,16 +591,16 @@

    -

    variable downcase-symbols

    +
    +

    variable downcase-symbols

    When converting symbols to strings, whether to downcase the symbols is set here. The default is to downcase symbols.

    -
    -

    variable standard-sql-strings

    +
    +

    variable standard-sql-strings

    Used to configure whether S-SQL will use standard SQL strings (just replace #\' with ''), or backslash-style escaping. Setting this to NIL is always safe, but when the server is configured to allow standard strings (compile-time parameter 'standard_conforming_strings' is 'on', which will become the default in future versions of PostgreSQL), the noise in queries can be reduced by setting this to T. @@ -605,8 +608,8 @@

    -

    variable postgres-reserved-words hashtable

    +
    +

    variable postgres-reserved-words hashtable

    A set of all Postgresql's reserved words, for automatic escaping. Probably not a good idea to use these words as identifiers anyway. @@ -625,8 +628,8 @@

    -

    variable escape-sql-names-p

    +
    +

    variable escape-sql-names-p

    Determines whether double quotes are added around column, table, and ** function names in @@ -653,8 +656,8 @@

    -

    function sql-type-name (type)

    +
    +

    function sql-type-name (type)

    → string @@ -666,8 +669,8 @@

    -

    function to-sql-name (name &optional (escape-p escape-sql-names-p)(ignore-reserved-words nil)

    +
    +

    function to-sql-name (name &optional (escape-p escape-sql-names-p)(ignore-reserved-words nil)

    → string @@ -683,8 +686,8 @@

    -

    function from-sql-name (string)

    +
    +

    function from-sql-name (string)

    → keyword @@ -697,8 +700,8 @@

    -

    macro register-sql-operators (arity &rest names)

    +
    +

    macro register-sql-operators (arity &rest names)

    Define simple SQL operators. Arity is one of :unary (like 'not'), :unary-postfix @@ -712,8 +715,8 @@

    -

    SQL Types

    +
    +

    SQL Types

    S-SQL knows the SQL equivalents to a number of Lisp types, and defines some @@ -833,8 +836,8 @@

    -

    type db-null

    +
    +

    type db-null

    This is a type of which only the keyword :null is a member. It is used to represent @@ -844,8 +847,8 @@

    -

    SQL Syntax

    +
    +

    SQL Syntax

    An S-SQL form is converted to a query through the following rules: @@ -866,8 +869,8 @@

    -

    sql-op :select (&rest args)

    +
    +

    sql-op :select (&rest args)

    +

    +Other examples can be found in s-sql/tests/tests.lisp +

    -
    -

    Joins

    +
    +

    Joins

    +

    +Allowable join keywords are: +

    +
      +
    • :left-join
    • +
    • :right-join
    • +
    • :inner-join
    • +
    • :outer-join
    • +
    • :cross-join
    • +
    • :join-lateral
    • +
    • :left-join-lateral (left join with an additional sql keyword LATERAL)
    • +
    • :right-join-lateral (right join with an additional sql keyword LATERAL)
    • +
    • :inner-join-lateral (inner join with an additional sql keyword LATERAL)
    • +
    • :outer-join-lateral (outer join with an additional sql keyword LATERAL)
    • +
    • :cross-join-lateral (cross join with an additional sql keyword LATERAL)
    • +
    + +

    +The lateral joins will not be discussed separately. +

    -
    -

    Cross Join

    +
    +

    Cross Join/ Cross Join Lateral

    From the postgresql documentation: "For every possible combination of rows from T1 and T2 (i.e., a Cartesian product), the joined table will contain a row consisting of all columns in T1 followed by all columns in T2. If the tables have N and M rows respectively, the joined table will have N * M rows." @@ -931,8 +998,8 @@

    Cross Join<

    -
    -

    Inner Join

    +
    +

    Inner Join / Inner Join Lateral

    An inner join looks at two tables and creates a new result consisting of the selected elements in the rows from the two tables that match the specified conditions. You can simplistically think of it as the intersection of the two sets. In reality, it is creating a new set consisting of certain elements of the intersecting rows. An inner join is the default and need not be specified. @@ -1001,8 +1068,8 @@

    Inner Join<

    -
    -

    Outer Join

    +
    +

    Outer Join / Outer Join Lateral

    An outer join not only generates an inner join, it also joins the rows from one table that matches the conditions and adds null values for the joined columns from the second table (which obviously did not match the condition.) Under Postgresql, a "left join", "right join" or "full join" all imply an outer join. @@ -1014,8 +1081,8 @@

    Outer Join<

    -
    -

    Left Join

    +
    +

    Left Join / Left Join Lateral / Right Join / Right Join Lateral

    Example: Here we assume two tables. A countries table and a many-to-many linking table named countries-topics. (There is an implicit third table named topics.) We are looking for records from the countries table which do not have a match in the countries-topics table. In other words, where do we have a note, but not matched it to a topic? @@ -1050,16 +1117,16 @@

    Left Join

    -
    -

    Defined Operators

    +
    +

    Defined Operators

    The following operators are defined:

    -
    -

    sql-op :+, :*, :%, :&, :|, :||, :and, :or, :=, :/, :!=, :<, :>, :<=, :>=, :^, :union, :union-all, :intersect, :intersect-all, :except, :except-all (&rest args)

    +
    +

    sql-op :+, :*, :%, :&, :|, :||, :and, :or, :=, :/, :!=, :<, :>, :<=, :>=, :^, :union, :union-all, :intersect, :intersect-all, :except, :except-all (&rest args)

    These are expanded as infix operators. When meaningful, they allow more than @@ -1075,8 +1142,8 @@

    -

    sql-op :or

    +
    +

    sql-op :or

    (query (:select 'countries.name
    @@ -1102,8 +1169,8 @@ 

    sql-op :or<

    -
    -

    sql-op :intersect

    +
    +

    sql-op :intersect

    Intersect produces a result contain rows that appear on all the sub-selects. @@ -1120,8 +1187,8 @@

    sql-op :int

    -
    -

    sql-op :union, :union-all

    +
    +

    sql-op :union, :union-all

    The union operation generally eliminates what it thinks are duplicate rows. The union-all operation preserves duplicate rows. The examples below use the union-all operator, but the syntax would be the same with union. @@ -1156,8 +1223,8 @@

    sql-op :uni

    -
    -

    sql-op :except, :except-all

    +
    +

    sql-op :except, :except-all

    :except removes all matches. :except-all is slightly different. @@ -1179,8 +1246,8 @@

    sql-op :exc

    -
    -

    sql-op :~, :not (arg)

    +
    +

    sql-op :~, :not (arg)

    Unary operators for bitwise and logical negation. @@ -1196,8 +1263,8 @@

    -

    sql-op :any, :any*

    +
    +

    sql-op :any, :any*

    Any needs to be considered as a special case. Quoting Marijn Haverbeke here,"Postgres has both a function-call-style any and an infix any, and S-SQL's syntax doesn't allow them to be distinguished." As a result, postmodern has a regular :any sql-op and a :any* sql-op, which expand slightly differently. @@ -1305,8 +1372,8 @@

    sql-op :any

    -
    -

    sql-op :function (name (&rest arg-types) return-type stability body)

    +
    +

    sql-op :function (name (&rest arg-types) return-type stability body)

    Create a stored procedure. The argument and return types are interpreted as @@ -1321,8 +1388,8 @@

    -

    sql-op :~, :~*, :!~, :!~* (string pattern)

    +
    +

    sql-op :~, :~*, :!~, :!~* (string pattern)

    Regular expression matching operators. The exclamation mark means 'does not match', @@ -1368,8 +1435,8 @@

    -

    sql-op :like, :ilike (string pattern)

    +
    +

    sql-op :like, :ilike (string pattern)

    Simple SQL string matching operators (:ilike is case-insensitive). @@ -1382,8 +1449,8 @@

    -

    sql-op :@@

    +
    +

    sql-op :@@

    Fast Text Search match operator. @@ -1391,8 +1458,8 @@

    -

    sql-op :desc (column)

    +
    +

    sql-op :desc (column)

    Used to invert the meaning of an operator in an :order-by clause. @@ -1407,8 +1474,8 @@

    -

    sql-op :nulls-first, :nulls-last (column)

    +
    +

    sql-op :nulls-first, :nulls-last (column)

    Used to determine where :null values appear in an :order-by clause. @@ -1416,8 +1483,8 @@

    -

    sql-op :as (form name &rest fields)

    +
    +

    sql-op :as (form name &rest fields)

    Also known in some explanations as "alias". This assigns a name to a column or @@ -1472,8 +1539,8 @@

    -

    sql-op :cast (query)

    +
    +

    sql-op :cast (query)

    The CAST operator. Takes a query as an argument, and returns the result @@ -1502,8 +1569,8 @@

    -

    sql-op :type (query)

    +
    +

    sql-op :type (query)

    Is similar to cast but uses the postgresql :: formating. Unlike cast it will not @@ -1521,8 +1588,8 @@

    -

    sql-op :create-composite-type (type-name &rest args)

    +
    +

    sql-op :create-composite-type (type-name &rest args)

    Creates a composite type with a type-name and two or more columns. E.g. @@ -1533,8 +1600,8 @@

    -

    sql-op :exists (query)

    +
    +

    sql-op :exists (query)

    The EXISTS operator. Takes a query as an argument, and returns true or false @@ -1554,8 +1621,8 @@

    -

    sql-op :is-null (arg)

    +
    +

    sql-op :is-null (arg)

    Test whether a value is null. @@ -1566,8 +1633,8 @@

    -

    sql-op :not-null (arg)

    +
    +

    sql-op :not-null (arg)

    Test whether a value is not null. @@ -1578,8 +1645,8 @@

    -

    sql-op :in (value set)

    +
    +

    sql-op :in (value set)

    Test whether a value is in a set of values. @@ -1599,8 +1666,8 @@

    -

    sql-op :not-in (value set)

    +
    +

    sql-op :not-in (value set)

    Inverse of the above. @@ -1608,8 +1675,8 @@

    -

    sql-op :set (&rest elements)

    +
    +

    sql-op :set (&rest elements)

    Denote a set of values. This operator has two interfaces. When @@ -1684,8 +1751,8 @@

    -

    sql-op :array (query)

    +
    +

    sql-op :array (query)

    This is used when calling a select query into an array. See array-notes.html @@ -1710,8 +1777,8 @@

    -

    sql-op :array[] (&rest args)

    +
    +

    sql-op :array[] (&rest args)

    This is the general operator for arrays. It also handles statements that include @@ -1732,8 +1799,8 @@

    -

    sql-op :[] (form start &optional end)

    +
    +

    sql-op :[] (form start &optional end)

    Dereference an array value. If end is provided, extract a slice of the array. @@ -1749,8 +1816,8 @@

    -

    sql-op :extract (unit form)

    +
    +

    sql-op :extract (unit form)

    Extract a field from a date/time value. For example, (:extract :month (:now)). @@ -1769,8 +1836,8 @@

    -

    sql-op :case (&rest clauses)

    +
    +

    sql-op :case (&rest clauses)

    A conditional expression. Clauses should take the form (test value). If @@ -1785,8 +1852,8 @@

    -

    sql-op :between (n start end)

    +
    +

    sql-op :between (n start end)

    Test whether a value lies between two other values. @@ -1800,8 +1867,8 @@

    -

    sql-op :between-symmetric (n start end)

    +
    +

    sql-op :between-symmetric (n start end)

    Works like :between, except that the start value is not required to be @@ -1810,8 +1877,8 @@

    -

    sql-op :dot (&rest names)

    +
    +

    sql-op :dot (&rest names)

    Can be used to combine multiple names into a name of the form A.B to @@ -1821,8 +1888,8 @@

    -

    sql-op :type (form type)

    +
    +

    sql-op :type (form type)

    Add a type declaration to a value, as in in "4.3::real". The second @@ -1835,8 +1902,8 @@

    -

    sql-op :raw (string)

    +
    +

    sql-op :raw (string)

    Insert a string as-is into the query. This can be useful for doing things @@ -1853,8 +1920,8 @@

    -

    sql-op :fetch (form amount &optional offset)

    +
    +

    sql-op :fetch (form amount &optional offset)

    Fetch is a more efficient way to do pagination instead of using limit and @@ -1881,8 +1948,8 @@

    -

    sql-op :limit (query amount &optional offset)

    +
    +

    sql-op :limit (query amount &optional offset)

    In S-SQL limit is not part of the select operator, but an extra @@ -1898,8 +1965,8 @@

    -

    sql-op :order-by (query &rest exprs)

    +
    +

    sql-op :order-by (query &rest exprs)

    Order the results of a query by the given expressions. See :desc for @@ -1916,8 +1983,8 @@

    -

    sql-op :values

    +
    +

    sql-op :values

    Values computes a row value or set of row values for use in a specific @@ -1952,8 +2019,8 @@

    -

    sql-op :empty-set

    +
    +

    sql-op :empty-set

    This is a fudge. It returns a string "()" where something like '() @@ -1969,8 +2036,8 @@

    -

    sql-op :group-by

    +
    +

    sql-op :group-by

    https://www.postgresql.org/docs/current/static/queries-table-expressions.html#QUERIES-GROUPING-SETS @@ -1995,8 +2062,8 @@

    -

    sql-op :grouping-sets

    +
    +

    sql-op :grouping-sets

    https://www.postgresql.org/docs/current/static/queries-table-expressions.html#QUERIES-GROUPING-SETS @@ -2016,20 +2083,20 @@

    -

    Time, Date and Interval Operators

    +
    +

    Time, Date and Interval Operators

    -
    -

    sql-op :interval (arg)

    +
    +

    sql-op :interval (arg)

    Creates an interval data type, generally represented in postmodern as an alist

    -
    -

    sql-op :current-date ()

    +
    +

    sql-op :current-date ()

    (query (:select (:current-date)) :single)
    @@ -2037,33 +2104,33 @@ 

    -

    sql-op :current-time ()

    +
    +

    sql-op :current-time ()

    -
    -

    sql-op :current-timestamp ()

    +
    +

    sql-op :current-timestamp ()

    -
    -

    sql-op :timestamp (arg)

    +
    +

    sql-op :timestamp (arg)

    -
    -

    sql-op :age (&rest args)

    +
    +

    sql-op :age (&rest args)

    -
    -

    sql-op :date (arg)

    +
    +

    sql-op :date (arg)

    -
    -

    sql-op :make-interval (&rest args)

    +
    +

    sql-op :make-interval (&rest args)

    Takes lists of (time-unit value) and returns a timestamp type. Example: @@ -2076,8 +2143,8 @@

    -

    sql-op :make-timestamp (&rest args)

    +
    +

    sql-op :make-timestamp (&rest args)

    Takes lists of (time-unit value) and returns a timestamptz type. Example: @@ -2091,8 +2158,8 @@

    -

    sql-op :make-timestamptz (&rest args)

    +
    +

    sql-op :make-timestamptz (&rest args)

    Takes lists of (time-unit value) and returns a timestamptz type. Example: @@ -2108,12 +2175,12 @@

    -

    Aggregation Operators

    +
    +

    Aggregation Operators

    -
    -

    sql-op :count (&rest args)

    +
    +

    sql-op :count (&rest args)

    Count returns the number of rows for which the expression is not null. @@ -2166,8 +2233,8 @@

    -

    sql-op :avg (&rest rest args)

    +
    +

    sql-op :avg (&rest rest args)

    Avg calculates the average value of a list of values. Note that if the @@ -2182,8 +2249,8 @@

    -

    sql-op :sum (&rest rest args)

    +
    +

    sql-op :sum (&rest rest args)

    Sum calculates the total of a list of values. Note that if the keyword filter @@ -2200,8 +2267,8 @@

    -

    sql-op ::max (&rest args)

    +
    +

    sql-op ::max (&rest args)

    max returns the maximum value of a set of values. Note that if the filter @@ -2218,8 +2285,8 @@

    -

    sql-op ::min (&rest args)

    +
    +

    sql-op ::min (&rest args)

    min returns the minimum value of a set of values. Note that if the filter @@ -2236,8 +2303,8 @@

    -

    sql-op ::every (&rest args)

    +
    +

    sql-op ::every (&rest args)

    Every returns true if all input values are true, otherwise false. Note @@ -2255,8 +2322,8 @@

    -

    sql-op :percentile-cont (&rest args)

    +
    +

    sql-op :percentile-cont (&rest args)

    Requires Postgresql 9.4 or higher. Percentile-cont returns a value @@ -2280,8 +2347,8 @@

    -

    sql-op :percentile-dist (&rest args)

    +
    +

    sql-op :percentile-dist (&rest args)

    Requires Postgresql 9.4 or higher. There are two required keyword parameters @@ -2306,8 +2373,8 @@

    -

    sql-op :corr (y x)

    +
    +

    sql-op :corr (y x)

    The corr function returns the correlation coefficient between a set of @@ -2321,8 +2388,8 @@

    -

    sql-op :covar-pop (y x)

    +
    +

    sql-op :covar-pop (y x)

    The covar-pop function returns the population covariance between a set of @@ -2336,8 +2403,8 @@

    -

    sql-op :covar-samp (y x)

    +
    +

    sql-op :covar-samp (y x)

    (query (:select (:covar-samp 'height 'weight)
    @@ -2351,8 +2418,8 @@ 

    -

    sql-op :string-agg (&rest args)

    +
    +

    sql-op :string-agg (&rest args)

    String-agg allows you to concatenate strings using different types of @@ -2377,8 +2444,8 @@

    -

    sql-op :array-agg (&rest args)

    +
    +

    sql-op :array-agg (&rest args)

    Array-agg returns a list of values concatenated into an arrays. @@ -2408,8 +2475,8 @@

    -

    sql-op :mode (&rest args)

    +
    +

    sql-op :mode (&rest args)

    Mode is used to find the most frequent input value in a group. @@ -2424,8 +2491,8 @@

    -

    sql-op :regr_avgx (y x)

    +
    +

    sql-op :regr_avgx (y x)

    The regr_avgx function returns the average of the independent variable @@ -2439,8 +2506,8 @@

    -

    sql-op :regr_avgy (y x)

    +
    +

    sql-op :regr_avgy (y x)

    The regr_avgy function returns the average of the dependent variable @@ -2456,8 +2523,8 @@

    -

    sql-op :regr_count (y x)

    +
    +

    sql-op :regr_count (y x)

    The regr_count function returns the number of input rows in which both @@ -2471,8 +2538,8 @@

    -

    sql-op :regr_intercept (y x)

    +
    +

    sql-op :regr_intercept (y x)

    The regr_intercept function returns the y-intercept of the least-squares-fit @@ -2486,8 +2553,8 @@

    -

    sql-op :regr_r2 (y x)

    +
    +

    sql-op :regr_r2 (y x)

    The regr_r2 function returns the square of the correlation coefficient. Example: @@ -2500,8 +2567,8 @@

    -

    sql-op :regr_slope (y x)

    +
    +

    sql-op :regr_slope (y x)

    The regr_slope function returns the slope of the least-squares-fit linear @@ -2515,8 +2582,8 @@

    -

    sql-op :regr_sxx (y x)

    +
    +

    sql-op :regr_sxx (y x)

    The regr_sxx function returns the sum(X^2) - sum(X)^2/N (“sum of squares” of @@ -2530,8 +2597,8 @@

    -

    sql-op :regr_sxy (y x)

    +
    +

    sql-op :regr_sxy (y x)

    The regr_sxy function returns the sum(X*Y) - sum(X) * sum(Y)/N (“sum of products” @@ -2545,8 +2612,8 @@

    -

    sql-op :regr_syy (y x)

    +
    +

    sql-op :regr_syy (y x)

    The regr_syy function returns the sum(Y^2) - sum(Y)^2/N (“sum of squares” @@ -2560,8 +2627,8 @@

    -

    sql-op :stddev (&rest args)

    +
    +

    sql-op :stddev (&rest args)

    The stddev function returns the the sample standard deviation of the input @@ -2575,8 +2642,8 @@

    -

    sql-op :stddev-pop (&rest args)

    +
    +

    sql-op :stddev-pop (&rest args)

    The stddev-pop function returns the population standard deviation of the @@ -2590,8 +2657,8 @@

    -

    sql-op :stddev-samp (&rest args)

    +
    +

    sql-op :stddev-samp (&rest args)

    The stddev-samp function returns the sample standard deviation of the @@ -2605,8 +2672,8 @@

    -

    sql-op :variance (&rest args)

    +
    +

    sql-op :variance (&rest args)

    Variance is a historical alias for var_samp. The variance function returns @@ -2621,8 +2688,8 @@

    -

    sql-op :var-pop (&rest args)

    +
    +

    sql-op :var-pop (&rest args)

    The var-pop function returns the population variance of the input values @@ -2637,8 +2704,8 @@

    -

    sql-op :var-samp (&rest args)

    +
    +

    sql-op :var-samp (&rest args)

    The var-samp function returns the sample variance of the input values @@ -2656,28 +2723,103 @@

    -

    sql-op :over (form &rest args)

    +
    +

    sql-op :range-between (&rest args)

    +
    +

    +Range-between allows window functions to apply to different segments of a result set. +It accepts the following keywords: :order-by, :rows-between, :range-between, +:unbounded-preceding, :current-row and :unbounded-following. Use of :preceding or +:following will generate errors. +See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. +

    + +

    +An example which calculates a running total could look like this: +

    +
    +
    (query
    + (:select (:as 'country 'country-name)
    +          (:as 'population 'country-population)
    +          (:as (:over (:sum 'population)
    +                      (:range-between :order-by 'country
    +                                      :unbounded-preceding :current-row))
    +               'global-population)
    +  :from 'population
    +  :where (:and (:not-null 'iso2)
    +               (:= 'year 1976))))
    +
    +
    +
    +
    + +
    +

    sql-op :rows-between (&rest args)

    +
    +

    +Rows-between allows window functions to apply to different segments of a result set. +It accepts the following keywords: +:order-by, :rows-between, :range-between, :preceding, :unbounded-preceding, +:current-row, :unbounded-following and :following. See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. +

    + +

    +An example could look like this : +

    +
    +
    (query
    + (:select (:as 'country 'country-name)
    +          (:as 'population 'country-population)
    +          (:as (:over (:sum 'population)
    +                      (:rows-between :order-by 'country :preceding 2 :following 2))
    +               'global-population)
    +  :from 'population
    +  :where (:and (:not-null 'iso2)
    +               (:= 'year 1976))))
    +
    +
    +
    +
    + +
    +

    sql-op :over (form &rest args)

    Over, partition-by and window are so-called window functions. A window function performs a calculation across a set of table rows that are -somehow related to the current row. +somehow related to the current row and adds that as an additional column to +the result. The following collects individual salaries and the total salaries.

    (query (:select 'salary (:over (:sum 'salary))
                     :from 'empsalary))
     
    +

    +A more complicated version that calculates a running total might look like: +

    +
    +
    (query
    + (:select 'name
    +          (:as 'salary 'individual-salary)
    +          (:as (:over (:sum 'salary)
    +                      (:range-between :order-by 'name :unbounded-preceding
    +                       :current-row))
    +               'running-total-salary)
    +  :from 'empsalary))
    +
    +
    -
    -

    sql-op :partition-by (&rest args)

    +
    +

    sql-op :partition-by (&rest args)

    - -
    -

    sql-op :window (form)

    +
    +

    sql-op :window (form)

    (query (:select (:over (:sum 'salary) 'w)
    @@ -2714,8 +2875,8 @@ 

    -

    sql-op :with (&rest args)

    +
    +

    sql-op :with (&rest args)

    With provides a way to write auxillary statements for use in a larger query, @@ -2738,8 +2899,8 @@

    -

    sql-op :with-recursive (&rest args)

    + -
    -

    Table Functions

    +
    +

    Table Functions

    -
    -

    sql-op :for-update (query &key of nowait)

    +
    +

    sql-op :for-update (query &key of nowait)

    Locks the selected rows against concurrent updates. This will prevent the @@ -2821,8 +3000,8 @@

    -

    sql-op :for-share (query &key of nowait)

    +
    +

    sql-op :for-share (query &key of nowait)

    Similar to :for-update, except it acquires a shared lock on the table, @@ -2832,20 +3011,39 @@

    -

    sql-op :insert-into (table &rest rest)

    +
    +

    sql-op :insert-into (table &rest rest)

    -Use insert-into when you are either inserting from a select clause and you do not need to specify specific columns: +You can use insert-into when you are:

    + +
      +
    1. Inserting from a select clause and you do not need to specify specific columns:
    2. +
    (query (:insert-into 'table1
              (:select 'c1 'c2 :from 'table2)))
     
    +
      +
    1. Inserting from a select clause and you specifying the columns which will be filled with values from the select clause
    2. +
    +
    +
    (query (:insert-into 't11
    +        :columns 'region 'subregion 'country
    +        (:select (:as 'region-name 'region)
    +                 (:as 'sub-region-name 'subregion)
    +                 'country
    +         :from 'regions)))
    +
    +

    -or you are alternating specific columns and values for a single row: +or

    +
      +
    1. You are alternating specific columns and values for a single row:
    2. +
    -

    To create what is commonly known as an upsert, use :on-conflict-update (if the item already exists, update the values) @@ -2946,8 +3141,8 @@

    -

    sql-op :insert-rows-into (table &rest rest)

    +
    +

    sql-op :insert-rows-into (table &rest rest)

    Insert-rows-into provides the ability to insert multiple rows into a table without using a select statement. (Insert-rows-into keeps the VALUES key word in the resulting sql. If you do use a select statement, Postgresql requires that it only return one row.) @@ -3043,23 +3238,52 @@

    -

    sql-op :update (table &rest rest)

    +
    +

    sql-op :update (table &rest rest)

    -Update values in a table. After the table name there should follow the -keyword :set and any number of alternating field names and values, like +Update values in a table. There are two ways to update the values +

    + +

    +The first method uses the keyword :set and any number of alternating field names and values, like for :insert-into. Next comes the optional keyword :from, followed by at least one table name and then any number of join statements, like for :select. After the joins, an optional :where keyword followed by the condition, and :returning keyword followed by a list of field names or expressions indicating values to be returned as query result.

    +
    +
    (query (:update 'weather
    +        :set 'temp-lo (:+ 'temp-lo 1)
    +             'temp-hi (:+ 'temp-lo 15)
    +             'prcp :default
    +        :where (:and (:= 'city "San Francisco")
    +                     (:= 'date "2003-07-03"))
    +        :returning 'temp-lo 'temp-hi 'prcp))
    +
    -
    +

    +The second method uses the :columns keyword to specify which columns get created and allows the use of either :set or :select (both of which need to be enclosed in a form) to provide the values, allowing update queries like: +

    +
    +
    (query (:update 'weather
    +        :columns 'temp-lo 'temp-hi 'prcp
    +                 (:set (:+ 'temp-lo 1)  (:+ 'temp-lo 15) :DEFAULT)
    +        :where (:and (:= 'city "San Francisco")
    +                     (:= 'date "2003-07-03"))))
     
    -
    -

    sql-op :delete-from (table &rest rest)

    +(query (:update 't1 + :columns 'database-name 'encoding + (:select 'x.datname 'x.encoding + :from (:as 'pg-database 'x) + :where (:= 'x.oid 't1.oid)))) +
    +
    +
    +

    +
    +

    sql-op :delete-from (table &rest rest)

    Delete rows from the named table. Can be given a :where argument followed @@ -3072,8 +3296,8 @@

    -

    sql-op :create-table (name (&rest columns) &rest options)

    +
    +

    sql-op :create-table (name (&rest columns) &rest options)

    Create a new table. The simplest example would pass two parameters, @@ -3095,8 +3319,8 @@

    -

    Column Definition parameters

    +
    +

    Column Definition parameters

    After the table name a list of column definitions @@ -3167,8 +3391,8 @@

    -

    Table Constraints

    +
    +

    Table Constraints

    After the list of columns, zero or more extra options (table constraints) can @@ -3246,8 +3470,8 @@

    -

    sql-op :alter-table (name action &rest args)

    +
    +

    sql-op :alter-table (name action &rest args)

    Alters named table. Currently changing a column's data type is not supported. @@ -3350,8 +3574,8 @@

    -

    sql-op :drop-table (name)

    +
    +

    sql-op :drop-table (name)

    Drops the named table. You may optionally pass :if-exists before the name @@ -3376,8 +3600,8 @@

    -

    sql-op :truncate (&rest args)

    +
    +

    sql-op :truncate (&rest args)

    Truncates one or more tables, deleting all the rows. Optional keyword arguments are @@ -3411,8 +3635,8 @@

    -

    sql-op :create-index (name &rest args)

    +
    +

    sql-op :create-index (name &rest args)

    Create an index on a table. After the name of the index the keyword :on should @@ -3431,8 +3655,8 @@

    -

    sql-op :create-unique-index (name &rest args)

    +
    +

    sql-op :create-unique-index (name &rest args)

    Works like :create-index, except that the index created is unique. @@ -3440,8 +3664,8 @@

    -

    sql-op :drop-index (name)

    +
    +

    sql-op :drop-index (name)

    Drop an index. Takes :if-exists and/or :cascade arguments like :drop-table. @@ -3459,8 +3683,8 @@

    -

    sql-op :create-sequence (name &key increment min-value max-value start cache cycle)

    +
    +

    sql-op :create-sequence (name &key increment min-value max-value start cache cycle)

    Create a sequence with the given name. The rest of the arguments control @@ -3469,8 +3693,8 @@

    -

    sql-op :alter-sequence (name)

    +
    +

    sql-op :alter-sequence (name)

    Alters a sequence. See Postgresql documentation for parameters. @@ -3510,8 +3734,8 @@

    -

    sql-op :drop-sequence (name)

    +
    +

    sql-op :drop-sequence (name)

    Drop a sequence. Takes :if-exists and/or :cascade arguments like :drop-table. @@ -3526,8 +3750,8 @@

    -

    sql-op :create-view (name query)

    +
    +

    sql-op :create-view (name query)

    Create a view from an S-SQL-style query. @@ -3535,8 +3759,8 @@

    -

    sql-op :drop-view (name)

    +
    +

    sql-op :drop-view (name)

    Drop a view. Takes optional :if-exists argument. @@ -3544,8 +3768,8 @@

    -

    sql-op :set-constraints (state &rest constraints)

    +
    +

    sql-op :set-constraints (state &rest constraints)

    Configure whether deferrable constraints should be checked when a statement @@ -3558,8 +3782,8 @@

    -

    sql-op :listen (channel)

    +
    +

    sql-op :listen (channel)

    Tell the server to listen for notification events on channel channel, @@ -3568,8 +3792,8 @@

    -

    sql-op :unlisten (channel)

    +
    +

    sql-op :unlisten (channel)

    Stop listening for events on channel. @@ -3577,8 +3801,8 @@

    -

    sql-op :notify (channel &optional payload)

    +
    +

    sql-op :notify (channel &optional payload)

    Signal a notification event on channel channel, a string. The optional @@ -3587,8 +3811,8 @@

    -

    sql-op :create-role (role &rest args)

    +
    +

    sql-op :create-role (role &rest args)

    Create a new role (user). Following the role name are optional keywords @@ -3665,8 +3889,8 @@

    -

    sql-op :create-database (name)

    +
    +

    sql-op :create-database (name)

    Create a new database with the given name. @@ -3674,8 +3898,8 @@

    -

    sql-op :drop-database (name)

    +
    +

    sql-op :drop-database (name)

    Drops the named database. You may optionally pass :if-exists before the @@ -3690,8 +3914,8 @@

    -

    sql-op :copy (table &rest args)

    +
    +

    sql-op :copy (table &rest args)

    Move data between Postgres tables and filesystem files. Table name is required @@ -3721,13 +3945,13 @@

    -

    Dynamic Queries, Composition and Parameterized Queries

    +
    +

    Dynamic Queries, Composition and Parameterized Queries

    -
    -

    Overview

    +
    +

    Overview

    The question gets asked how to build dynamic or composable queries in @@ -3737,8 +3961,8 @@

    -

    Programmer Built Queries

    +
    +

    Programmer Built Queries

    The question gets asked how to build dynamic or composable queries in @@ -3799,12 +4023,12 @@

    -
  • Approach #1 Using symbols in variables
    +
  • Approach #1 Using symbols in variables
      -
    • Select Statements
      -
      +
    • Select Statements
      +

      Consider the following two toy examples where we determine the table and columns to be selected using symbols (either keyword or quoted) inside variables. @@ -3828,8 +4052,8 @@

      Update Statements
      -
      +
    • Update Statements
      +

      This works with update statements as well

      @@ -3842,8 +4066,8 @@

      Insert Statements
      -
      +
    • Insert Statements
      +

      This works with insert-into statements as well

      @@ -3864,8 +4088,8 @@

      Delete Statements
      -
      +
    • Delete Statements
      +

      This works with delete statements as well

      @@ -3878,8 +4102,8 @@

      -

      Approach #2 Use sql-compile

      +
      +

      Approach #2 Use sql-compile

      Sql-compile does a run-time compilation of an s-sql expression. In the @@ -4043,8 +4267,8 @@

      Approach #2

      -
      -

      Approach #3 Use :raw

      +
      +

      Approach #3 Use :raw

      To quote Marijn, the :raw keyword takes a string and inserts it straight @@ -4059,8 +4283,8 @@

      Approach #3

      -
      -

      Queries with User Input

      +
      +

      Queries with User Input

      In any of the above approaches to building queries you will need to diff --git a/doc/s-sql.org b/doc/s-sql.org index f3a92c97..e72a3303 100644 --- a/doc/s-sql.org +++ b/doc/s-sql.org @@ -293,18 +293,31 @@ the expressions that should be selected. After this, an optional :distinct may follow, which will cause the query to only select distinct rows, or alternatively :distinct-on followed by a group of row names. Next comes the optional keyword :from, followed by at least one table name and then any -number of join statements. Join statements start with one of :left-join, -:right-join, :inner-join, :outer-join or :cross-join, then a table name or -subquery, then the keyword :on or :using, if applicable, and then a form. +number of join statements. + +Join statements start with one of :join, :left-join, +:right-join, :inner-join, :outer-join, :cross-join (or those with -lateral, +e.g :join-lateral, :left-join-lateral, :right-join-lateral, :inner-join-lateral, :outer-join-lateral). +S-sql will accept :join, but best usage is to explicitly use :inner-join instead. + +Then comes a table name or subquery, + +Then there is an optional :with-ordinality or :with-ordinality-as alisa + +Then the keyword :on or :using, if applicable, and then a form. A join can be preceded by :natural (leaving off the :on clause) to use a -natural join. After the joins an optional :where followed by a single form -may occur. And finally :group-by and :having can optionally be specified. -The first takes any number of arguments, and the second only one. A couple of -examples: +natural join. + +After the joins an optional :where followed by a single form may occur. + +Finally :group-by and :having can optionally be specified. +The first takes any number of arguments, and the second only one. + +A few examples: #+BEGIN_SRC lisp (query (:select 'item :distinct - :from 'item-table - :where (:= 'col1 "Albania"))) + :from 'item-table + :where (:= 'col1 "Albania"))) (query (:select (:+ 'field-1 100) 'field-5 :from (:as 'my-table 'x) @@ -313,25 +326,54 @@ examples: :where (:not-null 'a.field-3))) (query (:order-by - (:select 'regions.name - (:count 'regions.name) - :from 'countries 'regions - :where (:= 'regions.id 'countries.region-id) - :group-by 'regions.name) + (:select 'regions.name + (:count 'regions.name) + :from 'countries 'regions + :where (:= 'regions.id 'countries.region-id) + :group-by 'regions.name) 'regions.name)) (query (:select (:count 'c.id) 'r.name - :from (:as 'countries 'c) - :inner-join (:as 'regions 'r) - :on (:= 'c.region-id 'r.id) - :group-by 'r.name - :having (:< (:count 'c.id) 10))) -#+END_SRC + :from (:as 'countries 'c) + :inner-join (:as 'regions 'r) + :on (:= 'c.region-id 'r.id) + :group-by 'r.name + :having (:< (:count 'c.id) 10))) + +(query (:select 'i.* 'p.* + :from (:as 'individual 'i) + :inner-join (:as 'publisher 'p) + :using ('individualid) + :left-join-lateral (:as 'anothertable 'a) + :on (:= 'a.identifier 'i.individualid) + :where (:= 'a.something \"something\"))) + +(query (:select 't1.id 'a.elem 'a.nr + :from (:as 't12 't1) + :left-join (:unnest (:string-to-array 't1.elements ",")) + :with-ordinality-as (:a 'elem 'nr) + :on 't)) +#+END_SRC +Other examples can be found in s-sql/tests/tests.lisp ** Joins :PROPERTIES: :CUSTOM_ID: e0f01ac7-cb3c-4b38-8902-dc4a981a15e8 :END: -*** Cross Join +Allowable join keywords are: +- :left-join +- :right-join +- :inner-join +- :outer-join +- :cross-join +- :join-lateral +- :left-join-lateral (left join with an additional sql keyword LATERAL) +- :right-join-lateral (right join with an additional sql keyword LATERAL) +- :inner-join-lateral (inner join with an additional sql keyword LATERAL) +- :outer-join-lateral (outer join with an additional sql keyword LATERAL) +- :cross-join-lateral (cross join with an additional sql keyword LATERAL) + +The lateral joins will not be discussed separately. +*** Cross Join/ Cross Join Lateral :PROPERTIES: :CUSTOM_ID: 40e45849-5e9d-4b4c-830b-53f79f0b21e2 :END: @@ -341,7 +383,7 @@ From the postgresql documentation: "For every possible combination of rows from (query (:select '* from 'employee :cross-join 'compensation)) #+END_SRC -*** Inner Join +*** Inner Join / Inner Join Lateral :PROPERTIES: :CUSTOM_ID: 85c25a7d-3660-4d38-85f0-2b9c9dc88684 :END: @@ -397,7 +439,7 @@ The full portable ansi version, using inner join would look like this. :on (:= 'tmp1.region-id 'tmp2.id))) #+END_SRC -*** Outer Join +*** Outer Join / Outer Join Lateral :PROPERTIES: :CUSTOM_ID: ee0a6fef-de2f-407e-9cc9-3667de7775dc :END: @@ -406,7 +448,7 @@ An outer join not only generates an inner join, it also joins the rows from one A left join (or left outer join) looks at two tables, keeps the matched rows from both and the unmatched rows from the left table and drops the unmatched rows from the right table. A right outer join keeps the matched rows, the unmatched rows from the right table and drops the unmatched rows from the left table. A full outer join includes the rows that match from each table individually, with null values for the missing matching columns. -*** Left Join +*** Left Join / Left Join Lateral / Right Join / Right Join Lateral :PROPERTIES: :CUSTOM_ID: 3061c378-d2d1-4dda-833a-f1b3f8569018 :END: @@ -1811,6 +1853,46 @@ The var-samp function returns the sample variance of the input values #+END_SRC Window Functions +** sql-op :range-between (&rest args) +Range-between allows window functions to apply to different segments of a result set. +It accepts the following keywords: :order-by, :rows-between, :range-between, +:unbounded-preceding, :current-row and :unbounded-following. Use of :preceding or +:following will generate errors. +See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. + +An example which calculates a running total could look like this: +#+BEGIN_SRC lisp +(query + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country + :unbounded-preceding :current-row)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976)))) +#+END_SRC + +** sql-op :rows-between (&rest args) +Rows-between allows window functions to apply to different segments of a result set. +It accepts the following keywords: +:order-by, :rows-between, :range-between, :preceding, :unbounded-preceding, +:current-row, :unbounded-following and :following. See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. + +An example could look like this : +#+BEGIN_SRC lisp +(query + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :preceding 2 :following 2)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976)))) +#+END_SRC + ** sql-op :over (form &rest args) :PROPERTIES: :ID: bb6eb9f2-d9ed-4348-9467-79cae9b78819 @@ -1819,11 +1901,23 @@ Window Functions Over, partition-by and window are so-called window functions. A window function performs a calculation across a set of table rows that are -somehow related to the current row. +somehow related to the current row and adds that as an additional column to +the result. The following collects individual salaries and the total salaries. #+BEGIN_SRC lisp (query (:select 'salary (:over (:sum 'salary)) :from 'empsalary)) #+END_SRC +A more complicated version that calculates a running total might look like: +#+BEGIN_SRC lisp +(query + (:select 'name + (:as 'salary 'individual-salary) + (:as (:over (:sum 'salary) + (:range-between :order-by 'name :unbounded-preceding + :current-row)) + 'running-total-salary) + :from 'empsalary)) +#+END_SRC ** sql-op :partition-by (&rest args) :PROPERTIES: @@ -1832,7 +1926,9 @@ somehow related to the current row. :END: Args is a list of one or more columns to partition by, optionally -followed by an :order-by clause. +followed by other keywords. Partition-by accepts the following keywords: +:order-by, :rows-between, :range-between, :preceding, :unbounded-preceding, +:current-row, :unbounded-following and :following. See https://www.postgresql.org/docs/current/sql-expressions.html#SYNTAX-WINDOW-FUNCTIONS for Postgresql documentation on usage. #+BEGIN_SRC lisp (query (:select 'depname 'subdepname 'empno 'salary (:over (:avg 'salary) @@ -1848,6 +1944,22 @@ Note the use of :order-by without parens: :from 'empsalary)) #+END_SRC +The following example shows a query for country population in 1976 with running total population by region. +#+BEGIN_SRC lisp +(query + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'region-name + :rows-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976)))) +#+END_SRC ** sql-op :window (form) :PROPERTIES: @@ -1938,6 +2050,17 @@ Recursive modifier to a WITH statement, allowing the query to refer to its own o (:not 'cycle))))) (:select '* :from 'search-graph))) #+END_SRC +** sql-op :with-ordinality, :with-ordinality-as +Selects can use :with-ordinality or :with-ordinality-as parameters. Postgresql will give the new ordinality column the name of ordinality. :with-ordinality-as allows you to set different names for the columns in the result set. +#+BEGIN_SRC lisp +(query (:select '* + :from (:generate-series 4 1 -1) + :with-ordinality)) + +(query (:select 't1.* + :from (:json-object-keys "{\"a1\":\"1\",\"a2\":\"2\",\"a3\":\"3\"}") + :with-ordinality-as (:t1 'keys 'n) +#+END_SRC * Table Functions :PROPERTIES: @@ -1978,12 +2101,24 @@ tables. :CUSTOM_ID: 62cd3ff0-f034-46fc-a28e-c9875b577c40 :END: -Use insert-into when you are either inserting from a select clause and you do not need to specify specific columns: +You can use insert-into when you are: + +1. Inserting from a select clause and you do not need to specify specific columns: #+BEGIN_SRC lisp (query (:insert-into 'table1 (:select 'c1 'c2 :from 'table2))) #+END_SRC -or you are alternating specific columns and values for a single row: +2. Inserting from a select clause and you specifying the columns which will be filled with values from the select clause +#+BEGIN_SRC lisp +(query (:insert-into 't11 + :columns 'region 'subregion 'country + (:select (:as 'region-name 'region) + (:as 'sub-region-name 'subregion) + 'country + :from 'regions))) +#+END_SRC +or +3. You are alternating specific columns and values for a single row: #+BEGIN_SRC lisp (query (:insert-into 'my-table :set 'field-1 42 'field-2 "foobar")) #+END_SRC @@ -2021,13 +2156,10 @@ In Postgresql versions 9.5 and above, it is possible to add #+END_SRC If your insertion is setting a column that is an identity column with a value normally created by the system and you want to override that, you can use the :overriding-system-value keyword: #+BEGIN_SRC lisp -(query (:insert-into 'table1 :set 'c1 "A" 'c2 "B" :overriding-system-value)) - -(query (:insert-rows-into 'table1 - :overriding-user-value - :values '(((:select 'c1 'c2 :from 'table2))))) +(query (:insert-into 'table1 + :set 'c1 "A" 'c2 "B" + :overriding-system-value)) #+END_SRC - To create what is commonly known as an upsert, use :on-conflict-update (if the item already exists, update the values) followed by a list of field names which are checked for the conflict @@ -2140,14 +2272,37 @@ You can use :on-conflict-on-constraint to check for conflicts on constraints. :CUSTOM_ID: fadb04ea-7827-477c-bc40-8e5baf263690 :END: -Update values in a table. After the table name there should follow the -keyword :set and any number of alternating field names and values, like +Update values in a table. There are two ways to update the values + +The first method uses the keyword :set and any number of alternating field names and values, like for :insert-into. Next comes the optional keyword :from, followed by at least one table name and then any number of join statements, like for :select. After the joins, an optional :where keyword followed by the condition, and :returning keyword followed by a list of field names or expressions indicating values to be returned as query result. +#+BEGIN_SRC lisp +(query (:update 'weather + :set 'temp-lo (:+ 'temp-lo 1) + 'temp-hi (:+ 'temp-lo 15) + 'prcp :default + :where (:and (:= 'city "San Francisco") + (:= 'date "2003-07-03")) + :returning 'temp-lo 'temp-hi 'prcp)) +#+END_SRC +The second method uses the :columns keyword to specify which columns get created and allows the use of either :set or :select (both of which need to be enclosed in a form) to provide the values, allowing update queries like: +#+BEGIN_SRC lisp +(query (:update 'weather + :columns 'temp-lo 'temp-hi 'prcp + (:set (:+ 'temp-lo 1) (:+ 'temp-lo 15) :DEFAULT) + :where (:and (:= 'city "San Francisco") + (:= 'date "2003-07-03")))) +(query (:update 't1 + :columns 'database-name 'encoding + (:select 'x.datname 'x.encoding + :from (:as 'pg-database 'x) + :where (:= 'x.oid 't1.oid)))) +#+END_SRC ** sql-op :delete-from (table &rest rest) :PROPERTIES: :ID: cdee608e-71cb-4d41-9e1d-a21b7728d956 diff --git a/postmodern.asd b/postmodern.asd index 13ce2e54..49fddbb4 100644 --- a/postmodern.asd +++ b/postmodern.asd @@ -20,7 +20,7 @@ :maintainer "Sabra Crolleton " :homepage "https://github.com/marijnh/Postmodern" :license "zlib" - :version "1.32.7" + :version "1.32.8" :depends-on ("alexandria" "cl-postgres" "s-sql" diff --git a/s-sql.asd b/s-sql.asd index 8c301124..19ae39b9 100644 --- a/s-sql.asd +++ b/s-sql.asd @@ -9,7 +9,7 @@ :author "Marijn Haverbeke " :maintainer "Sabra Crolleton " :license "zlib" - :version "1.32.7" + :version "1.32.8" :depends-on ("cl-postgres" "alexandria") :components diff --git a/s-sql/s-sql.lisp b/s-sql/s-sql.lisp index f071f7b5..f65ebef4 100644 --- a/s-sql/s-sql.lisp +++ b/s-sql/s-sql.lisp @@ -35,11 +35,10 @@ errors." (optional (member '? (car words))) (multi (member '* (car words))) (no-args (member '- (car words))) - (zero-or-more (member '^ (car words))) (found (position me values))) (cond (found (let ((after-me (nthcdr (1+ found) values))) - (unless (or after-me no-args zero-or-more) + (unless (or after-me no-args) (sql-error "Keyword ~A encountered at end of arguments." me)) (let ((next (next-word (cdr words) after-me))) @@ -52,7 +51,6 @@ errors." (unless (>= next 1) (sql-error "Not enough arguments to keyword ~A." me))) - (zero-or-more t) (t (unless (= next 1) (sql-error "Keyword ~A takes exactly one argument." me)))) @@ -344,30 +342,7 @@ Symbols will be converted to SQL names. Examples: string)))) (defparameter *expand-runtime* nil) -#| -(defun sql-expand (arg) - "Compile-time expansion of forms into lists of stuff that evaluate -to strings (which will form a SQL query when concatenated)." - (cond ((and (consp arg) (keywordp (first arg))) - (expand-sql-op (car arg) (cdr arg))) - ((and (consp arg) (eq (first arg) 'quote)) - (list (sql-escape (second arg)))) - ((and (consp arg) *expand-runtime*) - (expand-sql-op (intern (symbol-name (car arg)) :keyword) (cdr arg))) - ((and (eq arg '$$) *expand-runtime*) - '($$)) - (*expand-runtime* - (list (sql-escape arg))) - ((consp arg) - (list `(sql-escape ,arg))) - ((or (consp arg) - (and (symbolp arg) - (not (or (keywordp arg) (eq arg t) (eq arg nil))))) - (list `(sql-escape ,arg))) - (t (list (sql-escape arg))))) -|# -;;; CURRENT DRAFT (defun sql-expand (arg) "Compile-time expansion of forms into lists of stuff that evaluate to strings (which will form a SQL query when concatenated). NEW :default will @@ -1132,10 +1107,10 @@ the proper SQL syntax for joining tables." ,@(when (eq kind :using) `(" USING (" ,@(sql-expand-list param) ")"))))))) (is-join (x) - (member x '(:joint :left-join :right-join :inner-join :outer-join + (member x '(:join :left-join :right-join :inner-join :outer-join :cross-join :join-lateral :left-join-lateral :right-join-lateral :inner-join-lateral :outer-join-lateral - :cross-join-lateral :lateral-join :with-ordinality :with-ordinality-as + :cross-join-lateral :with-ordinality :with-ordinality-as :lateral)))) (when (null args) (sql-error "Empty :from clause in select")) @@ -1701,24 +1676,7 @@ passed to insert-into sql operator")) ,@(if where (cons " WHERE " (sql-expand (car where))) ()))) ,@(when returning `(" RETURNING " ,@(sql-expand-list returning)))))) -#| -(def-sql-op :update (table &rest args) - (split-on-keywords ((set *) (from * ?) (where ?) (returning ? *)) args - (when (oddp (length set)) - (sql-error "Invalid amount of :set arguments passed to update sql -operator")) - `("UPDATE " ,@(sql-expand table) " SET " - ,@(loop :for (field value) :on set :by #'cddr - :for first = t :then nil - :append `(,@(if first () '(", ")) ,@(sql-expand field) - " = " - ,@(sql-expand value))) - ,@(if from (cons " FROM " (expand-joins from))) - ,@(if where (cons " WHERE " (sql-expand (car where))) ()) - ,@(when returning - (cons " RETURNING " (sql-expand-list returning)))))) -|# -;;;CURRENT DRAFT + (def-sql-op :update (table &rest args) (split-on-keywords ((set * ?) (columns ? *) (from * ?) (where ?) (returning ? *)) args (when (oddp (length set)) @@ -1837,7 +1795,6 @@ A more complicated version using the :range-between operator could look like thi (if args `("(" ,@(sql-expand form) " OVER " ,@(sql-expand-list args) ")") `("(" ,@(sql-expand form) " OVER ()) "))) - (def-sql-op :partition-by (&rest args) "Partition-by allows aggregate or window functions to apply separately to segments of a result. Partition-by accepts the following keywords: diff --git a/s-sql/tests/test-tables.lisp b/s-sql/tests/test-tables.lisp index 2c21c6e0..d2cc26d9 100644 --- a/s-sql/tests/test-tables.lisp +++ b/s-sql/tests/test-tables.lisp @@ -9,14 +9,34 @@ (test expand-table-column "Testing expand-table-column" - (is (equal (s-sql::expand-table-column 'code '(:type varchar :primary-key 't)) + (is (equal (s-sql::expand-table-column 'code '(:type varchar :primary-key t)) '("code" " " "VARCHAR" " NOT NULL" " PRIMARY KEY "))) - (is (equal (s-sql::expand-table-column 'code '(:type (or char db-null) :primary-key 't)) + (is (equal (s-sql::expand-table-column 'code '(:type (or char db-null) :primary-key t)) '("code" " " "CHAR" " PRIMARY KEY "))) - (is (equal (s-sql::expand-table-column 'code '(:type (or (string 5) db-null) :primary-key 't)) + (is (equal (s-sql::expand-table-column 'code '(:type (or (string 5) db-null) :primary-key t)) '("code" " " "CHAR(5)" " PRIMARY KEY "))) - (is (equal (s-sql::expand-table-column 'code '(:type (or (varchar 64) db-null) :collate "en_US.utf8")) - '("code" " " "VARCHAR(64)" " COLLATE \"" "en_US.utf8" "\"")))) + (is (equal (s-sql::expand-table-column 'code '(:type (or (varchar 64) db-null) + :collate "en_US.utf8")) + '("code" " " "VARCHAR(64)" " COLLATE \"" "en_US.utf8" "\""))) + (is (equal (s-sql::expand-table-column 'color '(:type int :generated-as-identity-always t)) + '("color" " " "INT" " NOT NULL" " GENERATED ALWAYS AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'color '(:type int :generated-as-identity-by-default t)) + '("color" " " "INT" " NOT NULL" " GENERATED BY DEFAULT AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'color '(:type int :identity-by-default t)) + '("color" " " "INT" " NOT NULL" " GENERATED BY DEFAULT AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'color '(:type int :identity-always t)) + '("color" " " "INT" " NOT NULL" " GENERATED ALWAYS AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'color '(:type int :generated-as-identity-always)) + '("color" " " "INT" " NOT NULL" " GENERATED ALWAYS AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'color '(:type int :generated-as-identity-by-default)) + '("color" " " "INT" " NOT NULL" " GENERATED BY DEFAULT AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'color '(:type int :identity-by-default)) + '("color" " " "INT" " NOT NULL" " GENERATED BY DEFAULT AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'color '(:type int :identity-always)) + '("color" " " "INT" " NOT NULL" " GENERATED ALWAYS AS IDENTITY "))) + (is (equal (s-sql::expand-table-column 'area '(:type (or real db-null) + :generated-always ((* w h)))) + '("area" " " "REAL" " GENERATED ALWAYS AS (" "(" "w" " * " "h" ")" ") STORED")))) (test expand-table-names-1 "Testing expand-table-names basic" @@ -417,10 +437,21 @@ :foreign-key (user-id) (users user-id)))) "CREATE TABLE account_role (user_id INTEGER NOT NULL, role_id INTEGER NOT NULL, grant_date TIMESTAMP WITHOUT TIME ZONE, PRIMARY KEY (user_id, role_id), CONSTRAINT account_role_role_id_fkey FOREIGN KEY (role_id) REFERENCES role(role_id) MATCH SIMPLE ON DELETE RESTRICT ON UPDATE RESTRICT, CONSTRAINT account_role_user_id_fkey FOREIGN KEY (user_id) REFERENCES users(user_id) MATCH SIMPLE ON DELETE RESTRICT ON UPDATE RESTRICT)"))) +(test create-table-generated-always + "Testing generated always column" + (is (equal (sql (:create-table 't10 + ((title :type (or text db-null)) + (body :type (or text db-null)) + (tsv :type (or tsvector db-null) + :generated-always ((:to-tsvector "english" 'body)))))) + "CREATE TABLE t10 (title TEXT, body TEXT, tsv TSVECTOR GENERATED ALWAYS AS (to_tsvector(E'english', body)) STORED)"))) + (test create-table-identity "Testing generating identity columns" (is (equal (sql (:create-table 'color ((color-id :type int :generated-as-identity-always t) (color-name :type varchar)))) "CREATE TABLE color (color_id INT NOT NULL GENERATED ALWAYS AS IDENTITY , color_name VARCHAR NOT NULL)")) + (is (equal (sql (:create-table 'color ((color-id :type int :generated-as-identity-always) (color-name :type varchar)))) + "CREATE TABLE color (color_id INT NOT NULL GENERATED ALWAYS AS IDENTITY , color_name VARCHAR NOT NULL)")) (is (equal (sql (:create-table 'color ((color-id :type int :generated-as-identity-by-default t) (color-name :type varchar)))) "CREATE TABLE color (color_id INT NOT NULL GENERATED BY DEFAULT AS IDENTITY , color_name VARCHAR NOT NULL)")) (is (equal (sql (:create-table color ((color-id :type int :generated-as-identity-always t) (color-name :type varchar)))) @@ -431,6 +462,16 @@ "CREATE TABLE color (color_id INT NOT NULL GENERATED ALWAYS AS IDENTITY , color_name VARCHAR NOT NULL)")) (is (equal (sql (:create-table 'color ((color-id :type int :identity-by-default t) (color-name :type varchar)))) "CREATE TABLE color (color_id INT NOT NULL GENERATED BY DEFAULT AS IDENTITY , color_name VARCHAR NOT NULL)")) + (is (equal (sql + (:create-table t1 + ((id :type int :generated-as-identity-by-default t :primary-key t) + (name :type varchar)))) + "CREATE TABLE t1 (id INT NOT NULL GENERATED BY DEFAULT AS IDENTITY PRIMARY KEY , name VARCHAR NOT NULL)")) + (is (equal (sql (:create-table 't1 ((w :type (or real db-null)) + (h :type (or real db-null)) + (area :type (or real db-null) :generated-always ((:* w h)))))) + "CREATE TABLE t1 (w REAL, h REAL, area REAL GENERATED ALWAYS AS ((w * h)) STORED)")) + (with-test-connection (when (table-exists-p 'color) (execute (:drop-table 'color))) (query (:create-table 'color ((color-id :type int :generated-as-identity-always t) (color-name :type varchar)))) @@ -440,7 +481,8 @@ 1)) (signals database-error (query (:insert-into 'color :set 'color-id 2 'color-name "Green"))) (execute (:drop-table 'color)) - (query (:create-table 'color ((color-id :type int :generated-as-identity-by-default t) (color-name :type varchar)))) + (query (:create-table 'color ((color-id :type int :generated-as-identity-by-default t) + (color-name :type varchar)))) (query (:insert-into 'color :set 'color-name "White")) (is (equal (length (query (:select '* :from 'color))) 1)) diff --git a/s-sql/tests/tests.lisp b/s-sql/tests/tests.lisp index b091db63..ab879d78 100644 --- a/s-sql/tests/tests.lisp +++ b/s-sql/tests/tests.lisp @@ -6,13 +6,13 @@ ;; run the tests with (fiveam:run! :cl-postgres) (fiveam:def-suite :s-sql - :description "Master suite for s-sql") + :description "Master suite for s-sql") (fiveam:in-suite :s-sql) (fiveam:def-suite :s-sql-base - :description "Base suite for s-sql" - :in :s-sql) + :description "Base suite for s-sql" + :in :s-sql) (in-suite :s-sql-base) @@ -28,14 +28,15 @@ (defmacro with-test-connection (&body body) `(pomo:with-connection (prompt-connection-to-s-sql-db-spec - (cl-postgres-tests:prompt-connection)) ,@body)) + (cl-postgres-tests:prompt-connection)) + ,@body)) (defmacro protect (&body body) `(unwind-protect (progn ,@(butlast body)) ,(car (last body)))) (fiveam:def-suite :s-sql-base - :description "Base test suite for s-sql" - :in :s-sql) + :description "Base test suite for s-sql" + :in :s-sql) (fiveam:in-suite :s-sql-base) @@ -61,7 +62,7 @@ (is (equal (query (:select 'nullable :from 'null-test :where (:= 'id 2)) :single) :null)) (is (equal (query (:select '* :from 'null-test :where (:= 'id 2))) - '((2 :null)))))) + '((2 :null)))))) (defun build-recipe-tables () "Build recipe tables uses in array tests" @@ -74,11 +75,14 @@ (name :type text) (text :type text)))) - (query (:create-table recipe-tags-array ((recipe-id :type integer :references ((recipes recipe-id))) - (tags :type text[] :default "{}")))) + (query (:create-table recipe-tags-array + ((recipe-id :type integer :references ((recipes recipe-id))) + (tags :type text[] :default "{}")))) - (query (:create-unique-index 'recipe-tags-id-recipe-id :on "recipe-tags-array" :fields 'recipe-id)) - (query (:create-index 'recipe-tags-id-tags :on "recipe-tags-array" :using gin :fields 'tags)) + (query (:create-unique-index 'recipe-tags-id-recipe-id + :on "recipe-tags-array" :fields 'recipe-id)) + (query (:create-index 'recipe-tags-id-tags + :on "recipe-tags-array" :using gin :fields 'tags)) (loop for x in '(("Fattoush" #("greens" "pita bread" "olive oil" "garlic" "lemon" "salt" "spices")) @@ -94,14 +98,15 @@ ("Kofta" #("minced meat" "parsley" "spices" "onions")) ("Kunafeh" #("cheese" "sugar syrup" "pistachios")) ("Baklava" #("filo dough" "honey" "nuts"))) do - (query (:insert-into 'recipes :set 'name (first x) 'text (format nil "~a" (rest x)))) - (query - (:insert-into 'recipe-tags-array - :set 'recipe-id - (:select 'recipe-id - :from 'recipes - :where (:= 'recipes.name (first x))) - 'tags (second x)))))) + (query (:insert-into 'recipes :set 'name (first x) 'text + (format nil "~a" (rest x)))) + (query + (:insert-into 'recipe-tags-array + :set 'recipe-id + (:select 'recipe-id + :from 'recipes + :where (:= 'recipes.name (first x))) + 'tags (second x)))))) (defun build-employee-table () "Build employee table for test purposes" @@ -119,21 +124,21 @@ (region :type char) (age :type int)))) (query (:insert-rows-into 'employee - :columns 'id 'name 'salary 'start-date 'city 'region 'age - :values '((1 "Jason" 40420 "02/01/94" "New York" "W" 29) - (2 "Robert" 14420 "01/02/95" "Vancouver" "N" 21) - (3 "Celia" 24020 "12/03/96" "Toronto" "W" 24) - (4 "Linda" 40620 "11/04/97" "New York" "N" 28) - (5 "David" 80026 "10/05/98" "Vancouver" "W" 31) - (6 "James" 70060 "09/06/99" "Toronto" "N" 26) - (7 "Alison" 90620 "08/07/00" "New York" "W" 38) - (8 "Chris" 26020 "07/08/01" "Vancouver" "N" 22) - (9 "Mary" 60020 "06/08/02" "Toronto" "W" 34)))))) + :columns 'id 'name 'salary 'start-date 'city 'region 'age + :values '((1 "Jason" 40420 "02/01/94" "New York" "W" 29) + (2 "Robert" 14420 "01/02/95" "Vancouver" "N" 21) + (3 "Celia" 24020 "12/03/96" "Toronto" "W" 24) + (4 "Linda" 40620 "11/04/97" "New York" "N" 28) + (5 "David" 80026 "10/05/98" "Vancouver" "W" 31) + (6 "James" 70060 "09/06/99" "Toronto" "N" 26) + (7 "Alison" 90620 "08/07/00" "New York" "W" 38) + (8 "Chris" 26020 "07/08/01" "Vancouver" "N" 22) + (9 "Mary" 60020 "06/08/02" "Toronto" "W" 34)))))) (test employee-table (with-test-connection (build-employee-table) - (is-true (table-exists-p 'employee)))) + (is-true (table-exists-p 'employee)))) (test sql-error) @@ -342,7 +347,8 @@ to strings \(which will form an SQL query when concatenated)." "E'ringo'" ", " "E'mary-ann'" ", " (SQL-ESCAPE CAROL-ANNE)))) (is (equal (s-sql::sql-expand-list '((:desc 'today) 'tomorrow 'yesterday)) '("today" " DESC" ", " "tomorrow" ", " "yesterday"))) - (is (equal (s-sql::sql-expand-list (remove nil '(george paul john "ringo" "mary-ann" nil carol-anne nil))) + (is (equal (s-sql::sql-expand-list (remove nil '(george paul john "ringo" "mary-ann" + nil carol-anne nil))) '((SQL-ESCAPE GEORGE) ", " (SQL-ESCAPE PAUL) ", " (SQL-ESCAPE JOHN) ", " "E'ringo'" ", " "E'mary-ann'" ", " (SQL-ESCAPE CAROL-ANNE))))) @@ -365,51 +371,51 @@ to strings \(which will form an SQL query when concatenated)." (test reduce-strings "Testing reduce-strings. Join adjacent strings in a list, leave other values intact." - (is (equal (s-sql::reduce-strings '("john" 7 "paul" "ringo" "george")) - '("john" 7 "paulringogeorge"))) - (is (equal (s-sql::reduce-strings '("john" 7 "paul" "ringo" george)) - '("john" 7 "paulringo" GEORGE)))) + (is (equal (s-sql::reduce-strings '("john" 7 "paul" "ringo" "george")) + '("john" 7 "paulringogeorge"))) + (is (equal (s-sql::reduce-strings '("john" 7 "paul" "ringo" george)) + '("john" 7 "paulringo" GEORGE)))) (test sql-macro "Testing sql-macro. Compile form to an sql expression as far as possible." - (is (equal (sql (:select 'name :from 'items :where (:= 'id 1))) - "(SELECT name FROM items WHERE (id = 1))")) + (is (equal (sql (:select 'name :from 'items :where (:= 'id 1))) + "(SELECT name FROM items WHERE (id = 1))")) (is (equal (sql (:select "name" :from 'items :where (:= 'id 1))) ;note that Postgresql will error on the escaped columns "(SELECT E'name' FROM items WHERE (id = 1))"))) (test sql-compile "Testing sql-compile" - (is (equal (sql-compile '(:select 'name :from 'items :where (:= 'id 1))) - "(SELECT name FROM items WHERE (id = 1))"))) + (is (equal (sql-compile '(:select 'name :from 'items :where (:= 'id 1))) + "(SELECT name FROM items WHERE (id = 1))"))) (test sql-template "Testing sql-template" - (is (functionp (sql-template '(:select 'name :from 'items :where (:= 'id 1)))))) + (is (functionp (sql-template '(:select 'name :from 'items :where (:= 'id 1)))))) (test expand-sql-op - "Testing expand-sql-op" - (is (equal (s-sql::expand-sql-op :max '(1 2 3)) - '("MAX(" "1" ", " "2" ", " "3" ")")))) + "Testing expand-sql-op" + (is (equal (s-sql::expand-sql-op :max '(1 2 3)) + '("MAX(" "1" ", " "2" ", " "3" ")")))) (test make-expander - "Testing make-expander" - (is (equal (funcall (s-sql::make-expander :unary "unary1") '("like")) - '("(" "unary1" " " "E'like'" ")"))) - (is (equal (funcall (s-sql::make-expander :unary-postfix "unary2") '("like")) - '("(" "E'like'" " " "unary2" ")"))) - (is (equal (funcall (s-sql::make-expander :n-ary "unary3") '("like" "a" "b")) - '("(" "E'like'" " unary3 " "E'a'" " unary3 " "E'b'" ")"))) - (is (equal (funcall (s-sql::make-expander :2+-ary "unary4") '("like" "a" "b")) - '("(" "E'like'" " unary4 " "E'a'" " unary4 " "E'b'" ")"))) - (is (equal (funcall (s-sql::make-expander :2+-ary "unary4") '("like" "a")) - '("(" "E'like'" " unary4 " "E'a'" ")"))) - (signals sql-error (funcall (s-sql::make-expander :2+-ary "unary4") '("like"))) - (is (equal (funcall (s-sql::make-expander :n-or-unary "unary5") '("like" "a" "b")) - '("(" "E'like'" " unary5 " "E'a'" " unary5 " "E'b'" ")"))) - (is (equal (funcall (s-sql::make-expander :n-or-unary "unary5") '("like")) - '("(" "unary5" " " "E'like'" ")"))) - (is (equal (funcall (s-sql::make-expander :n-or-unary "unary5") '("like" "a")) - '("(" "E'like'" " unary5 " "E'a'" ")")))) + "Testing make-expander" + (is (equal (funcall (s-sql::make-expander :unary "unary1") '("like")) + '("(" "unary1" " " "E'like'" ")"))) + (is (equal (funcall (s-sql::make-expander :unary-postfix "unary2") '("like")) + '("(" "E'like'" " " "unary2" ")"))) + (is (equal (funcall (s-sql::make-expander :n-ary "unary3") '("like" "a" "b")) + '("(" "E'like'" " unary3 " "E'a'" " unary3 " "E'b'" ")"))) + (is (equal (funcall (s-sql::make-expander :2+-ary "unary4") '("like" "a" "b")) + '("(" "E'like'" " unary4 " "E'a'" " unary4 " "E'b'" ")"))) + (is (equal (funcall (s-sql::make-expander :2+-ary "unary4") '("like" "a")) + '("(" "E'like'" " unary4 " "E'a'" ")"))) + (signals sql-error (funcall (s-sql::make-expander :2+-ary "unary4") '("like"))) + (is (equal (funcall (s-sql::make-expander :n-or-unary "unary5") '("like" "a" "b")) + '("(" "E'like'" " unary5 " "E'a'" " unary5 " "E'b'" ")"))) + (is (equal (funcall (s-sql::make-expander :n-or-unary "unary5") '("like")) + '("(" "unary5" " " "E'like'" ")"))) + (is (equal (funcall (s-sql::make-expander :n-or-unary "unary5") '("like" "a")) + '("(" "E'like'" " unary5 " "E'a'" ")")))) (test select-simple "Testing select modifiers" @@ -419,7 +425,8 @@ to strings \(which will form an SQL query when concatenated)." "(SELECT item FROM item_table WHERE (id = 2))")) (is (equal (sql (:select 'item :distinct :from 'item-table :where (:= 'col1 "Albania"))) "(SELECT DISTINCT item FROM item_table WHERE (col1 = E'Albania'))")) - (is (equal (sql (:select 'item 'groups :from 'item-table 'item-groups :where (:= 'item-table.group-id 'item-groups.id))) + (is (equal (sql (:select 'item 'groups :from 'item-table 'item-groups + :where (:= 'item-table.group-id 'item-groups.id))) "(SELECT item, groups FROM item_table, item_groups WHERE (item_table.group_id = item_groups.id))")) (is (equal (sql (:select (:over (:sum 'salary) 'w) (:over (:avg 'salary) 'w) @@ -427,22 +434,22 @@ to strings \(which will form an SQL query when concatenated)." (:as 'w (:partition-by 'depname :order-by (:desc 'salary))))) "(SELECT (SUM(salary) OVER w), (AVG(salary) OVER w) FROM empsalary WINDOW w AS (PARTITION BY depname ORDER BY salary DESC))")) (is (equal (let ((param-latitude nil) (param-longitude t)) - (sql (:select 'id 'name (when param-latitude '0) - (when param-longitude 'longitude) - :from 'countries - :where (:= 'id 20)))) + (sql (:select 'id 'name (when param-latitude '0) + (when param-longitude 'longitude) + :from 'countries + :where (:= 'id 20)))) "(SELECT id, name, false, longitude FROM countries WHERE (id = 20))")) (is (equal (sql (:with (:as 'upd - (:parens - (:update 'employees :set 'sales-count (:= 'sales-count 1) - :where (:= 'id - (:select 'sales-person - :from 'accounts - :where (:= 'name "Acme Corporation"))) - :returning '*))) - (:insert-into 'employees-log - (:select '* 'current-timestamp :from - 'upd)))) + (:parens + (:update 'employees :set 'sales-count (:= 'sales-count 1) + :where (:= 'id + (:select 'sales-person + :from 'accounts + :where (:= 'name "Acme Corporation"))) + :returning '*))) + (:insert-into 'employees-log + (:select '* 'current-timestamp :from + 'upd)))) "WITH upd AS (UPDATE employees SET sales_count = (sales_count = 1) WHERE (id = (SELECT sales_person FROM accounts WHERE (name = E'Acme Corporation'))) RETURNING *) INSERT INTO employees_log (SELECT *, \"current_timestamp\" FROM upd)")) @@ -460,7 +467,7 @@ to strings \(which will form an SQL query when concatenated)." "(SELECT ta FROM a WHERE (ta IS NOT NULL))"))) (test cast - "Testing cast using cast or type" + "Testing cast using cast or type" (is (equal (sql (:select (:type 1.0 int))) "(SELECT 1.0::INT)")) (is (equal (sql (:select (:type "true" boolean))) @@ -483,19 +490,21 @@ to strings \(which will form an SQL query when concatenated)." "20")) (is (equal (with-test-connection (let ((type 'integer))(query (:select (:cast (:as "20" type))) - :single))) + :single))) 20))) (test values "Testing values. Escaped string results have been validated." (is (equal (sql (:select 'a 'b 'c (:cast (:as (:* 50 (:random)) 'int)) - :from (:as (:values (:set "a") (:set "b")) (:d1 'a)) - (:as (:values (:set "c") (:set "d")) (:d2 'b)) - (:as (:values (:set "e") (:set "f")) (:d3 'c)))) + :from (:as (:values (:set "a") (:set "b")) (:d1 'a)) + (:as (:values (:set "c") (:set "d")) (:d2 'b)) + (:as (:values (:set "e") (:set "f")) (:d3 'c)))) "(SELECT a, b, c, CAST((50 * random()) AS int) FROM (VALUES (E'a'), (E'b')) AS d1(a), (VALUES (E'c'), (E'd')) AS d2(b), (VALUES (E'e'), (E'f')) AS d3(c))")) - (is (equal (sql (:select '* :from (:as (:values (:set 1 "one") (:set 2 "two") (:set 3 "three")) (:t1 'num 'letter)))) + (is (equal (sql (:select '* :from (:as (:values (:set 1 "one") (:set 2 "two") + (:set 3 "three")) + (:t1 'num 'letter)))) "(SELECT * FROM (VALUES (1, E'one'), (2, E'two'), (3, E'three')) AS t1(num, letter))"))) (test any @@ -505,376 +514,443 @@ to strings \(which will form an SQL query when concatenated)." "(SELECT sub_region_name FROM regions WHERE (id = ANY $1))"))) (test select-limit-offset - (is (equal (sql (:limit (:select 'country :from 'un-m49) 5 10)) - "((SELECT country FROM un_m49) LIMIT 5 OFFSET 10)"))) + (is (equal (sql (:limit (:select 'country :from 'un-m49) 5 10)) + "((SELECT country FROM un_m49) LIMIT 5 OFFSET 10)"))) (test select-distinct - "Testing select with distinct. From https://www.pgexercises.com/questions/basic/unique.html" - (is (equal (sql (:limit (:order-by (:select 'surname :distinct :from 'cd.members) 'surname) 10)) - "(((SELECT DISTINCT surname FROM cd.members) ORDER BY surname) LIMIT 10)"))) + "Testing select with distinct. From https://www.pgexercises.com/questions/basic/unique.html" + (is (equal (sql (:limit (:order-by (:select 'surname :distinct :from 'cd.members) 'surname) 10)) + "(((SELECT DISTINCT surname FROM cd.members) ORDER BY surname) LIMIT 10)"))) (test select-distinct-on - "Testing select with distinct on. https://www.postgresql.org/docs/current/static/sql-select.html. + "Testing select with distinct on. https://www.postgresql.org/docs/current/static/sql-select.html. SELECT DISTINCT ON ( expression [, ...] ) keeps only the first row of each set of rows where the given expressions evaluate to equal. The DISTINCT ON expressions are interpreted using the same rules as for ORDER BY (see above). Note that the “first row” of each set is unpredictable unless ORDER BY is used to ensure that the desired row appears first. " - (is (equal (sql (:order-by (:select 'location 'time 'report - :distinct-on 'location - :from 'weather-reports) - 'location (:desc 'time))) - "((SELECT DISTINCT ON (location) location, time, report FROM weather_reports) ORDER BY location, time DESC)"))) + (is (equal (sql (:order-by (:select 'location 'time 'report + :distinct-on 'location + :from 'weather-reports) + 'location (:desc 'time))) + "((SELECT DISTINCT ON (location) location, time, report FROM weather_reports) ORDER BY location, time DESC)"))) -(test select-fetch +(test fetch "Testing the fetch sql-op" (is (equal (sql (:fetch (:order-by (:select 'id :from 'historical-events) 'id) 5)) - "(((SELECT id FROM historical_events) ORDER BY id) FETCH FIRST 5 ROWS ONLY)"))) + "(((SELECT id FROM historical_events) ORDER BY id) FETCH FIRST 5 ROWS ONLY)")) + (is (equal (sql (:fetch + (:order-by (:select 'id + :from 'historical-events) + 'id))) + "(((SELECT id FROM historical_events) ORDER BY id) FETCH FIRST ROWS ONLY)")) + (is (equal (sql (:fetch + (:order-by (:select 'id + :from 'historical-events) + 'id) + 5)) + "(((SELECT id FROM historical_events) ORDER BY id) FETCH FIRST 5 ROWS ONLY)")) + (is (equal (sql (:fetch + (:order-by + (:select 'id + :from 'historical-events) + 'id) + 5 10)) + "(((SELECT id FROM historical_events) ORDER BY id) OFFSET 10 FETCH FIRST 5 ROWS ONLY)"))) (test select-join-1 - "Testing basic join. Note full use of as. https://www.postgresql.org/docs/current/static/sql-select.html + "Testing basic join. Note full use of as. https://www.postgresql.org/docs/current/static/sql-select.html To join the table films with the table distributors:" - (is (equal (sql (:select 'f.title 'f.did 'd.name 'f.date-prod 'f.kind - :from (:as 'distributors 'd) (:as 'films 'f) - :where (:= 'f.did 'd.did))) - "(SELECT f.title, f.did, d.name, f.date_prod, f.kind FROM distributors AS d, films AS f WHERE (f.did = d.did))")) - ;; Cross Join - (is (equal (sql (:select '* :from 't1 :cross-join 't2)) - "(SELECT * FROM t1 CROSS JOIN t2)")) - - (is (equal (sql (:select '* :from 't1 't2)) - "(SELECT * FROM t1, t2)")) -;; Examples from https://www.postgresql.org/docs/current/static/queries-table-expressions.html#QUERIES-WINDOW -;; Inner Join - (is (equal (sql (:select '* :from 't1 :inner-join 't2 :on (:= 't1.num 't2.num))) - "(SELECT * FROM t1 INNER JOIN t2 ON (t1.num = t2.num))")) -;; From https://www.pgexercises.com/questions/joins/simplejoin.html - (is (equal (sql (:select 'bks.starttime - :from (:as 'cd.bookings 'bks) - :inner-join (:as 'cd.members 'mems) - :on (:= 'mems.memid 'bks.memid) - :where (:and (:= 'mems.firstname "David") - (:= 'mems.surname "Farrell")))) - "(SELECT bks.starttime FROM cd.bookings AS bks INNER JOIN cd.members AS mems ON (mems.memid = bks.memid) WHERE ((mems.firstname = E'David') and (mems.surname = E'Farrell')))")) - -;; From https://www.pgexercises.com/questions/joins/self.html - (is (equal (sql (:order-by (:select (:as 'recs.firstname 'firstname) - (:as 'recs.surname 'surname) - :distinct - :from (:as 'cd.members 'mems) - :inner-join (:as 'cd.members 'recs) - :on (:= 'recs.memid 'mems.recommendedby)) - 'surname 'firstname)) - "((SELECT DISTINCT recs.firstname AS firstname, recs.surname AS surname FROM cd.members AS mems INNER JOIN cd.members AS recs ON (recs.memid = mems.recommendedby)) ORDER BY surname, firstname)")) - - ;; inner join with min from - (is (equal (sql (:order-by - (:select 'mems.surname 'mems.firstname 'mems.memid (:as (:min 'bks.starttime) 'starttime) - :from (:as 'cd.bookings 'bks) - :inner-join (:as 'cd.members 'mems) - :on (:= 'mems.memid 'bks.memid) - :where (:>= 'starttime "2012-09-01") - :group-by 'mems.surname 'mems.firstname 'mems.memid) - 'mems.memid)) - "((SELECT mems.surname, mems.firstname, mems.memid, MIN(bks.starttime) AS starttime FROM cd.bookings AS bks INNER JOIN cd.members AS mems ON (mems.memid = bks.memid) WHERE (starttime >= E'2012-09-01') GROUP BY mems.surname, mems.firstname, mems.memid) ORDER BY mems.memid)")) - -;; Inner Join with using - (is (equal (sql (:select '* :from 't1 :inner-join 't2 :using ('num))) - - "(SELECT * FROM t1 INNER JOIN t2 USING (num))")) - - ;; inner join with case from https://www.pgexercises.com/questions/joins/threejoin2.html - (is (equal (sql (:order-by (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) (:as 'facs.name 'facility) - (:as (:case ((:= 'mems.memid 0 ) (:* 'bks.slots 'facs.guestcost)) - (:else (:* 'bks.slots 'facs.membercost))) - 'cost) - :from (:as 'cd.members 'mems) - :inner-join (:as 'cd.bookings 'bks) - :on (:= 'mems.memid 'bks.memid) - :inner-join (:as 'cd.facilities 'facs) - :on (:= 'bks.facid 'facs.facid) - :where - (:and (:>= 'bks.starttime "2012-09-14") - (:<= 'bks.starttime "2012-09-15") - (:or (:and (:= 'mems.memid 0) - (:> (:* 'bks.slots 'facs.guestcost) 30)) - (:and (:not (:= 'mems.memid 0)) - (:> (:* 'bks.slots 'facs.membercost) 30))))) - (:desc 'cost))) - "((SELECT (mems.firstname || E' ' || mems.surname) AS member, facs.name AS facility, CASE WHEN (mems.memid = 0) THEN (bks.slots * facs.guestcost) ELSE (bks.slots * facs.membercost) END AS cost FROM cd.members AS mems INNER JOIN cd.bookings AS bks ON (mems.memid = bks.memid) INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) WHERE ((bks.starttime >= E'2012-09-14') and (bks.starttime <= E'2012-09-15') and (((mems.memid = 0) and ((bks.slots * facs.guestcost) > 30)) or ((not (mems.memid = 0)) and ((bks.slots * facs.membercost) > 30))))) ORDER BY cost DESC)")) - -;; Natural Inner Join - (is (equal (sql (:select '* :from 't1 :natural :inner-join 't2)) - "(SELECT * FROM t1 NATURAL INNER JOIN t2)")) - -;; Left Join (also known as left outer join - (is (equal (sql (:select '* :from 't1 :left-join 't2 :on (:= 't1.num 't2.num))) - "(SELECT * FROM t1 LEFT JOIN t2 ON (t1.num = t2.num))")) - -;; from https://www.pgexercises.com/questions/joins/self2.html - (is (equal (sql (:order-by (:select (:as 'mems.firstname 'memfname) - (:as 'mems.surname 'memsname) - (:as 'recs.firstname 'recfname) - (:as 'recs.surname 'recsname) - :from (:as 'cd.members 'mems) - :left-join (:as 'cd.members 'recs) - :on (:= 'recs.memid 'mems.recommendedby)) - 'memsname 'memfname)) - "((SELECT mems.firstname AS memfname, mems.surname AS memsname, recs.firstname AS recfname, recs.surname AS recsname FROM cd.members AS mems LEFT JOIN cd.members AS recs ON (recs.memid = mems.recommendedby)) ORDER BY memsname, memfname)")) -;; multiple inner join with column concatenate from https://www.pgexercises.com/questions/joins/threejoin.html - (is (equal (sql (:order-by (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) - (:as 'facs.name 'facility) - :distinct - :from (:as 'cd.members 'mems) - :inner-join (:as 'cd.bookings 'bks) :on (:= 'mems.memid 'bks.memid) - :inner-join (:as 'cd.facilities 'facs) :on (:= 'bks.facid 'facs.facid) - :where (:in 'bks.facid (:set 0 1))) - 'member)) -"((SELECT DISTINCT (mems.firstname || E' ' || mems.surname) AS member, facs.name AS facility FROM cd.members AS mems INNER JOIN cd.bookings AS bks ON (mems.memid = bks.memid) INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) WHERE (bks.facid IN (0, 1))) ORDER BY member)")) -;; Right Join - (is (equal (sql (:select '* :from 't1 :right-join 't2 :on (:= 't1.num 't2.num))) - "(SELECT * FROM t1 RIGHT JOIN t2 ON (t1.num = t2.num))")) - -;; Full Outer Join - (is (equal (sql (:select '* :from 't1 :outer-join 't2 :on (:= 't1.num 't2.num))) - "(SELECT * FROM t1 FULL OUTER JOIN t2 ON (t1.num = t2.num))"))) + (is (equal (sql (:select 'f.title 'f.did 'd.name 'f.date-prod 'f.kind + :from (:as 'distributors 'd) (:as 'films 'f) + :where (:= 'f.did 'd.did))) + "(SELECT f.title, f.did, d.name, f.date_prod, f.kind FROM distributors AS d, films AS f WHERE (f.did = d.did))")) + ;; Overview + (is (equal + (sql (:select 'i.* 'p.* + :from (:as 'individual 'i) + :inner-join (:as 'publisher 'p) + :using ('individualid) + :inner-join (:as 'anothertable 'a) + :on (:= 'a.identifier 'i.individualid) + :where (:= 'a.something "something"))) + "(SELECT i.*, p.* FROM individual AS i INNER JOIN publisher AS p USING (individualid) INNER JOIN anothertable AS a ON (a.identifier = i.individualid) WHERE (a.something = E'something'))")) + + (is (equal (sql (:select 'c.customer 'c.state 'e.entry + :from (:as 'customer 'c) + :left-join (:as 'entry 'e) + :on (:and (:= 'c.customer 'e.customer) + (:= 'e.category "D")))) + "(SELECT c.customer, c.state, e.entry FROM customer AS c LEFT JOIN entry AS e ON ((c.customer = e.customer) and (e.category = E'D')))")) + + ;; Cross Join + (is (equal (sql (:select '* :from 't1 :cross-join 't2)) + "(SELECT * FROM t1 CROSS JOIN t2)")) + + (is (equal (sql (:select '* :from 't1 't2)) + "(SELECT * FROM t1, t2)")) + + ;; Examples from https://www.postgresql.org/docs/current/static/queries-table-expressions.html#QUERIES-WINDOW + ;; Inner Join + (is (equal (sql (:select '* :from 't1 :inner-join 't2 :on (:= 't1.num 't2.num))) + "(SELECT * FROM t1 INNER JOIN t2 ON (t1.num = t2.num))")) + ;; From https://www.pgexercises.com/questions/joins/simplejoin.html + (is (equal (sql (:select 'bks.starttime + :from (:as 'cd.bookings 'bks) + :inner-join (:as 'cd.members 'mems) + :on (:= 'mems.memid 'bks.memid) + :where (:and (:= 'mems.firstname "David") + (:= 'mems.surname "Farrell")))) + "(SELECT bks.starttime FROM cd.bookings AS bks INNER JOIN cd.members AS mems ON (mems.memid = bks.memid) WHERE ((mems.firstname = E'David') and (mems.surname = E'Farrell')))")) + + ;; From https://www.pgexercises.com/questions/joins/self.html + (is (equal (sql (:order-by (:select (:as 'recs.firstname 'firstname) + (:as 'recs.surname 'surname) + :distinct + :from (:as 'cd.members 'mems) + :inner-join (:as 'cd.members 'recs) + :on (:= 'recs.memid 'mems.recommendedby)) + 'surname 'firstname)) + "((SELECT DISTINCT recs.firstname AS firstname, recs.surname AS surname FROM cd.members AS mems INNER JOIN cd.members AS recs ON (recs.memid = mems.recommendedby)) ORDER BY surname, firstname)")) + + ;; inner join with min from + (is (equal (sql (:order-by + (:select 'mems.surname 'mems.firstname 'mems.memid (:as (:min 'bks.starttime) + 'starttime) + :from (:as 'cd.bookings 'bks) + :inner-join (:as 'cd.members 'mems) + :on (:= 'mems.memid 'bks.memid) + :where (:>= 'starttime "2012-09-01") + :group-by 'mems.surname 'mems.firstname 'mems.memid) + 'mems.memid)) + "((SELECT mems.surname, mems.firstname, mems.memid, MIN(bks.starttime) AS starttime FROM cd.bookings AS bks INNER JOIN cd.members AS mems ON (mems.memid = bks.memid) WHERE (starttime >= E'2012-09-01') GROUP BY mems.surname, mems.firstname, mems.memid) ORDER BY mems.memid)")) + + ;; Inner Join with using + (is (equal (sql (:select '* :from 't1 :inner-join 't2 :using ('num))) + + "(SELECT * FROM t1 INNER JOIN t2 USING (num))")) + + ;; inner join with case from https://www.pgexercises.com/questions/joins/threejoin2.html + (is (equal (sql (:order-by (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) + (:as 'facs.name 'facility) + (:as (:case ((:= 'mems.memid 0 ) + (:* 'bks.slots 'facs.guestcost)) + (:else (:* 'bks.slots 'facs.membercost))) + 'cost) + :from (:as 'cd.members 'mems) + :inner-join (:as 'cd.bookings 'bks) + :on (:= 'mems.memid 'bks.memid) + :inner-join (:as 'cd.facilities 'facs) + :on (:= 'bks.facid 'facs.facid) + :where + (:and (:>= 'bks.starttime "2012-09-14") + (:<= 'bks.starttime "2012-09-15") + (:or (:and (:= 'mems.memid 0) + (:> (:* 'bks.slots 'facs.guestcost) 30)) + (:and (:not (:= 'mems.memid 0)) + (:> (:* 'bks.slots 'facs.membercost) 30))))) + (:desc 'cost))) + "((SELECT (mems.firstname || E' ' || mems.surname) AS member, facs.name AS facility, CASE WHEN (mems.memid = 0) THEN (bks.slots * facs.guestcost) ELSE (bks.slots * facs.membercost) END AS cost FROM cd.members AS mems INNER JOIN cd.bookings AS bks ON (mems.memid = bks.memid) INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) WHERE ((bks.starttime >= E'2012-09-14') and (bks.starttime <= E'2012-09-15') and (((mems.memid = 0) and ((bks.slots * facs.guestcost) > 30)) or ((not (mems.memid = 0)) and ((bks.slots * facs.membercost) > 30))))) ORDER BY cost DESC)")) + + ;; Natural Inner Join + (is (equal (sql (:select '* :from 't1 :natural :inner-join 't2)) + "(SELECT * FROM t1 NATURAL INNER JOIN t2)")) + + ;; Left Join (also known as left outer join + (is (equal (sql (:select '* :from 't1 :left-join 't2 :on (:= 't1.num 't2.num))) + "(SELECT * FROM t1 LEFT JOIN t2 ON (t1.num = t2.num))")) + + ;; from https://www.pgexercises.com/questions/joins/self2.html + (is (equal (sql (:order-by (:select (:as 'mems.firstname 'memfname) + (:as 'mems.surname 'memsname) + (:as 'recs.firstname 'recfname) + (:as 'recs.surname 'recsname) + :from (:as 'cd.members 'mems) + :left-join (:as 'cd.members 'recs) + :on (:= 'recs.memid 'mems.recommendedby)) + 'memsname 'memfname)) + "((SELECT mems.firstname AS memfname, mems.surname AS memsname, recs.firstname AS recfname, recs.surname AS recsname FROM cd.members AS mems LEFT JOIN cd.members AS recs ON (recs.memid = mems.recommendedby)) ORDER BY memsname, memfname)")) + ;; multiple inner join with column concatenate from https://www.pgexercises.com/questions/joins/threejoin.html + (is (equal (sql (:order-by (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) + (:as 'facs.name 'facility) + :distinct + :from (:as 'cd.members 'mems) + :inner-join (:as 'cd.bookings 'bks) :on (:= 'mems.memid 'bks.memid) + :inner-join (:as 'cd.facilities 'facs) :on (:= 'bks.facid 'facs.facid) + :where (:in 'bks.facid (:set 0 1))) + 'member)) + "((SELECT DISTINCT (mems.firstname || E' ' || mems.surname) AS member, facs.name AS facility FROM cd.members AS mems INNER JOIN cd.bookings AS bks ON (mems.memid = bks.memid) INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) WHERE (bks.facid IN (0, 1))) ORDER BY member)")) + ;; Right Join + (is (equal (sql (:select '* :from 't1 :right-join 't2 :on (:= 't1.num 't2.num))) + "(SELECT * FROM t1 RIGHT JOIN t2 ON (t1.num = t2.num))")) + + ;; Full Outer Join + (is (equal (sql (:select '* :from 't1 :outer-join 't2 :on (:= 't1.num 't2.num))) + "(SELECT * FROM t1 FULL OUTER JOIN t2 ON (t1.num = t2.num))"))) (test subselects - "Testing subselects" -;; From https://www.pgexercises.com/questions/joins/sub.html - (is (equal (sql (:order-by (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) - (:select (:as (:|| 'recs.firstname " " 'recs.surname) 'recommender) - :from (:as 'cd.members 'recs) - :where (:= 'recs.memid 'mems.recommendedby)) :distinct - :from (:as 'cd.members 'mems)) - 'member)) - "((SELECT DISTINCT (mems.firstname || E' ' || mems.surname) AS member, (SELECT (recs.firstname || E' ' || recs.surname) AS recommender FROM cd.members AS recs WHERE (recs.memid = mems.recommendedby)) FROM cd.members AS mems) ORDER BY member)")) - - (is (equal (sql (:order-by (:select 'member 'facility 'cost - :from - (:as (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) - (:as 'facs.name 'facility) - (:as (:case ((:= 'mems.memid 0 ) (:* 'bks.slots 'facs.guestcost)) - (:else (:* 'bks.slots 'facs.membercost))) - 'cost) - :from (:as 'cd.members 'mems) - :inner-join (:as 'cd.bookings 'bks) - :on (:= 'mems.memid 'bks.memid) - :inner-join (:as 'cd.facilities 'facs) - :on (:= 'bks.facid 'facs.facid) - :where - (:and (:>= 'bks.starttime "2012-09-14") - (:<= 'bks.starttime "2012-09-15"))) - 'bookings) - :where (:> 'cost 30)) - (:desc 'cost))) - "((SELECT member, facility, cost FROM (SELECT (mems.firstname || E' ' || mems.surname) AS member, facs.name AS facility, CASE WHEN (mems.memid = 0) THEN (bks.slots * facs.guestcost) ELSE (bks.slots * facs.membercost) END AS cost FROM cd.members AS mems INNER JOIN cd.bookings AS bks ON (mems.memid = bks.memid) INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) WHERE ((bks.starttime >= E'2012-09-14') and (bks.starttime <= E'2012-09-15'))) AS bookings WHERE (cost > 30)) ORDER BY cost DESC)"))) + "Testing subselects" + ;; From https://www.pgexercises.com/questions/joins/sub.html + (is (equal + (sql + (:order-by + (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) + (:select (:as (:|| 'recs.firstname " " 'recs.surname) 'recommender) + :from (:as 'cd.members 'recs) + :where (:= 'recs.memid 'mems.recommendedby)) :distinct + :from (:as 'cd.members 'mems)) + 'member)) + "((SELECT DISTINCT (mems.firstname || E' ' || mems.surname) AS member, (SELECT (recs.firstname || E' ' || recs.surname) AS recommender FROM cd.members AS recs WHERE (recs.memid = mems.recommendedby)) FROM cd.members AS mems) ORDER BY member)")) + + (is (equal + (sql + (:order-by + (:select 'member 'facility 'cost + :from + (:as (:select (:as (:|| 'mems.firstname " " 'mems.surname) 'member) + (:as 'facs.name 'facility) + (:as (:case ((:= 'mems.memid 0 ) (:* 'bks.slots 'facs.guestcost)) + (:else (:* 'bks.slots 'facs.membercost))) + 'cost) + :from (:as 'cd.members 'mems) + :inner-join (:as 'cd.bookings 'bks) + :on (:= 'mems.memid 'bks.memid) + :inner-join (:as 'cd.facilities 'facs) + :on (:= 'bks.facid 'facs.facid) + :where + (:and (:>= 'bks.starttime "2012-09-14") + (:<= 'bks.starttime "2012-09-15"))) + 'bookings) + :where (:> 'cost 30)) + (:desc 'cost))) + "((SELECT member, facility, cost FROM (SELECT (mems.firstname || E' ' || mems.surname) AS member, facs.name AS facility, CASE WHEN (mems.memid = 0) THEN (bks.slots * facs.guestcost) ELSE (bks.slots * facs.membercost) END AS cost FROM cd.members AS mems INNER JOIN cd.bookings AS bks ON (mems.memid = bks.memid) INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) WHERE ((bks.starttime >= E'2012-09-14') and (bks.starttime <= E'2012-09-15'))) AS bookings WHERE (cost > 30)) ORDER BY cost DESC)"))) (test select-case - "Testing case statements from https://www.pgexercises.com/questions/basic/classify.html" - (is (equal (sql (:select 'name (:as (:case ((:> 'monthlymaintenance 100) "expensive") - (:else "cheap")) 'cost) - :from 'cd.facilities)) - "(SELECT name, CASE WHEN (monthlymaintenance > 100) THEN E'expensive' ELSE E'cheap' END AS cost FROM cd.facilities)"))) + "Testing case statements from https://www.pgexercises.com/questions/basic/classify.html" + (is (equal (sql (:select 'name (:as (:case ((:> 'monthlymaintenance 100) "expensive") + (:else "cheap")) + 'cost) + :from 'cd.facilities)) + "(SELECT name, CASE WHEN (monthlymaintenance > 100) THEN E'expensive' ELSE E'cheap' END AS cost FROM cd.facilities)"))) (test select-dates - "Testing date selection from https://www.pgexercises.com/questions/basic/date.html" - (is (equal (sql (:select 'memid 'surname 'firstname 'joindate :from 'cd.members :where (:>= 'joindate "2012-09-01"))) - "(SELECT memid, surname, firstname, joindate FROM cd.members WHERE (joindate >= E'2012-09-01'))"))) + "Testing date selection from https://www.pgexercises.com/questions/basic/date.html" + (is (equal (sql (:select 'memid 'surname 'firstname 'joindate :from 'cd.members :where (:>= 'joindate "2012-09-01"))) + "(SELECT memid, surname, firstname, joindate FROM cd.members WHERE (joindate >= E'2012-09-01'))"))) (test select-group-by - "https://www.postgresql.org/docs/current/static/sql-select.html + "https://www.postgresql.org/docs/current/static/sql-select.html To sum the column len of all films and group the results by kind:" - (is (equal (sql (:select 'kind (:as (:sum 'len) 'total) :from 'films :group-by 'kind)) - "(SELECT kind, SUM(len) AS total FROM films GROUP BY kind)"))) + (is (equal (sql (:select 'kind (:as (:sum 'len) 'total) :from 'films :group-by 'kind)) + "(SELECT kind, SUM(len) AS total FROM films GROUP BY kind)"))) (test select-except - "Testing the use of except in two select statements. Except removes all matches. Except all is slightly different. If the first select statement has two rows that match a single row in the second select statement, only one is removed." - (is (equal (sql (:except (:select 'id 'name - :from 'countries - :where (:like 'name "%New%")) - (:select 'id 'name - :from 'countries - :where (:like 'name "%Zealand%")))) - "((SELECT id, name FROM countries WHERE (name like E'%New%')) except (SELECT id, name FROM countries WHERE (name like E'%Zealand%')))")) - (is (equal (sql (:except-all (:select '* :from 'clients) (:select '* :from 'vips))) - "((SELECT * FROM clients) except all (SELECT * FROM vips))"))) + "Testing the use of except in two select statements. Except removes all matches. Except all is slightly different. If the first select statement has two rows that match a single row in the second select statement, only one is removed." + (is (equal (sql (:except (:select 'id 'name + :from 'countries + :where (:like 'name "%New%")) + (:select 'id 'name + :from 'countries + :where (:like 'name "%Zealand%")))) + "((SELECT id, name FROM countries WHERE (name like E'%New%')) except (SELECT id, name FROM countries WHERE (name like E'%Zealand%')))")) + (is (equal (sql (:except-all (:select '* :from 'clients) (:select '* :from 'vips))) + "((SELECT * FROM clients) except all (SELECT * FROM vips))"))) (test select-intersect - "Testing the intersect in two select clauses. Note that intersect removes duplicates and intersect-all does not remove duplicates." - (is (equal (sql (:intersect-all (:select '* :from 'clients) (:select '* :from 'vips))) - "((SELECT * FROM clients) intersect all (SELECT * FROM vips))")) - (is (equal (sql (:intersect (:select '* :from 'clients) (:select '* :from 'vips))) - "((SELECT * FROM clients) intersect (SELECT * FROM vips))"))) + "Testing the intersect in two select clauses. Note that intersect removes duplicates and intersect-all does not remove duplicates." + (is (equal (sql (:intersect-all (:select '* :from 'clients) (:select '* :from 'vips))) + "((SELECT * FROM clients) intersect all (SELECT * FROM vips))")) + (is (equal (sql (:intersect (:select '* :from 'clients) (:select '* :from 'vips))) + "((SELECT * FROM clients) intersect (SELECT * FROM vips))"))) ;;; Aggregate Tests (test avg-test "Testing the avg aggregate functions" - (is (equal (sql (:select (:as (:round (:avg 'replacement-cost) 2) 'avg-replacement-cost) :from 'film )) + (is (equal (sql (:select (:as (:round (:avg 'replacement-cost) 2) 'avg-replacement-cost) + :from 'film )) "(SELECT round(AVG(replacement_cost), 2) AS avg_replacement_cost FROM film)"))) (test count-test "Testing the count aggregate function" -;; From https://www.pgexercises.com/questions/aggregates/count.html - (is (equal (sql (:select (:count '*) :from 'cd.facilities)) - "(SELECT COUNT(*) FROM cd.facilities)")) - (is (equal (sql (:select 'facid (:select (:count '*) :from 'cd.facilities) :from 'cd.facilities)) - "(SELECT facid, (SELECT COUNT(*) FROM cd.facilities) FROM cd.facilities)")) - ;; From https://www.pgexercises.com/questions/aggregates/count2.html - (is (equal (sql (:select (:count '*) :from 'cd.facilities :where (:>= 'guestcost 10))) - "(SELECT COUNT(*) FROM cd.facilities WHERE (guestcost >= 10))")) - ;; From https://www.pgexercises.com/questions/aggregates/count3.html - (is (equal (sql (:order-by (:select 'recommendedby (:count '*) - :from 'cd.members - :where (:not (:is-null 'recommendedby)) - :group-by 'recommendedby) - 'recommendedby)) - "((SELECT recommendedby, COUNT(*) FROM cd.members WHERE (not (recommendedby IS NULL)) GROUP BY recommendedby) ORDER BY recommendedby)")) - ;; From https://www.pgexercises.com/questions/aggregates/members1.html - (is (equal (sql (:select (:count 'memid :distinct) :from 'cd.bookings)) - "(SELECT COUNT(DISTINCT memid) FROM cd.bookings)")) - (is (equal (sql (:select (:as (:count '*) 'unfiltered) (:as (:count '* :filter (:= 1 'bid)) 'filtered) :from 'testtable)) - "(SELECT COUNT(*) AS unfiltered, COUNT(*) FILTER (WHERE (1 = bid)) AS filtered FROM testtable)")) - (is (equal (sql (:select (:as (:count '* :distinct) 'unfiltered) (:as (:count '* :filter (:= 1 'bid)) 'filtered) :from 'testtable)) - "(SELECT COUNT(DISTINCT *) AS unfiltered, COUNT(*) FILTER (WHERE (1 = bid)) AS filtered FROM testtable)")) - (is (equal (with-test-connection (pomo:query (:select (:as (:count '*) 'unfiltered) (:as (:count '* :filter (:< 'i 5)) 'filtered) - :from (:as (:generate-series 1 10) 's 'i)))) - '((10 4))))) + ;; From https://www.pgexercises.com/questions/aggregates/count.html + (is (equal (sql (:select (:count '*) :from 'cd.facilities)) + "(SELECT COUNT(*) FROM cd.facilities)")) + (is (equal (sql (:select 'facid (:select (:count '*) :from 'cd.facilities) :from 'cd.facilities)) + "(SELECT facid, (SELECT COUNT(*) FROM cd.facilities) FROM cd.facilities)")) + ;; From https://www.pgexercises.com/questions/aggregates/count2.html + (is (equal (sql (:select (:count '*) :from 'cd.facilities :where (:>= 'guestcost 10))) + "(SELECT COUNT(*) FROM cd.facilities WHERE (guestcost >= 10))")) + ;; From https://www.pgexercises.com/questions/aggregates/count3.html + (is (equal (sql (:order-by (:select 'recommendedby (:count '*) + :from 'cd.members + :where (:not (:is-null 'recommendedby)) + :group-by 'recommendedby) + 'recommendedby)) + "((SELECT recommendedby, COUNT(*) FROM cd.members WHERE (not (recommendedby IS NULL)) GROUP BY recommendedby) ORDER BY recommendedby)")) + ;; From https://www.pgexercises.com/questions/aggregates/members1.html + (is (equal (sql (:select (:count 'memid :distinct) :from 'cd.bookings)) + "(SELECT COUNT(DISTINCT memid) FROM cd.bookings)")) + (is (equal (sql (:select (:as (:count '*) 'unfiltered) + (:as (:count '* :filter (:= 1 'bid)) + 'filtered) + :from 'testtable)) + "(SELECT COUNT(*) AS unfiltered, COUNT(*) FILTER (WHERE (1 = bid)) AS filtered FROM testtable)")) + (is (equal (sql (:select (:as (:count '* :distinct) 'unfiltered) + (:as (:count '* :filter (:= 1 'bid)) 'filtered) + :from 'testtable)) + "(SELECT COUNT(DISTINCT *) AS unfiltered, COUNT(*) FILTER (WHERE (1 = bid)) AS filtered FROM testtable)")) + + (is (equal (with-test-connection + (pomo:query (:select (:as (:count '*) 'unfiltered) + (:as (:count '* :filter (:< 'i 5)) + 'filtered) + :from (:as (:generate-series 1 10) + 's 'i)))) + '((10 4))))) (test sum-test "Testing the sum aggregate function" ;; From https://www.pgexercises.com/questions/aggregates/fachours.html - (is (equal (sql (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) - :from 'cd.bookings - :group-by 'facid) - 'facid)) - "((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings GROUP BY facid) ORDER BY facid)")) -;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth.html - (is (equal (sql (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) - :from 'cd.bookings - :where (:and (:>= 'starttime "2012-09-01") - (:< 'starttime "2012-10-01")) - :group-by 'facid) - (:sum 'slots))) - "((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings WHERE ((starttime >= E'2012-09-01') and (starttime < E'2012-10-01')) GROUP BY facid) ORDER BY SUM(slots))")) - ;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth2.html - (is (equal (sql (:order-by (:select 'facid (:as (:extract 'month 'starttime) 'month) - (:as (:sum 'slots) 'total-slots) - :from 'cd.bookings - :where (:and (:>= 'starttime "2012-01-01") - (:< 'starttime "2013-01-01")) - :group-by 'facid 'month) - 'facid 'month)) - "((SELECT facid, EXTRACT(month FROM starttime) AS month, SUM(slots) AS total_slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY facid, month) ORDER BY facid, month)")) - - - -;; From https://www.pgexercises.com/questions/aggregates/fachours1a.html - (is (equal (sql (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) - :from 'cd.bookings - :group-by 'facid - :having (:> (:sum 'slots) - 1000)) - 'facid)) - "((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings GROUP BY facid HAVING (SUM(slots) > 1000)) ORDER BY facid)")) - ;; From https://www.pgexercises.com/questions/aggregates/facrev.html - (is (equal (sql (:order-by (:select 'facs.name (:as (:sum (:* 'slots - (:case ((:= 'memid 0) 'facs.guestcost) - (:else 'facs.membercost)))) - 'revenue) + (is (equal (sql (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) + :from 'cd.bookings + :group-by 'facid) + 'facid)) + "((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings GROUP BY facid) ORDER BY facid)")) + ;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth.html + (is (equal (sql (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) + :from 'cd.bookings + :where (:and (:>= 'starttime "2012-09-01") + (:< 'starttime "2012-10-01")) + :group-by 'facid) + (:sum 'slots))) + "((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings WHERE ((starttime >= E'2012-09-01') and (starttime < E'2012-10-01')) GROUP BY facid) ORDER BY SUM(slots))")) + ;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth2.html + (is (equal (sql (:order-by (:select 'facid (:as (:extract 'month 'starttime) 'month) + (:as (:sum 'slots) 'total-slots) + :from 'cd.bookings + :where (:and (:>= 'starttime "2012-01-01") + (:< 'starttime "2013-01-01")) + :group-by 'facid 'month) + 'facid 'month)) + "((SELECT facid, EXTRACT(month FROM starttime) AS month, SUM(slots) AS total_slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY facid, month) ORDER BY facid, month)")) + + + + ;; From https://www.pgexercises.com/questions/aggregates/fachours1a.html + (is (equal (sql (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) + :from 'cd.bookings + :group-by 'facid + :having (:> (:sum 'slots) + 1000)) + 'facid)) + "((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings GROUP BY facid HAVING (SUM(slots) > 1000)) ORDER BY facid)")) + ;; From https://www.pgexercises.com/questions/aggregates/facrev.html + (is (equal (sql (:order-by + (:select 'facs.name (:as (:sum (:* 'slots + (:case ((:= 'memid 0) 'facs.guestcost) + (:else 'facs.membercost)))) + 'revenue) + :from (:as 'cd.bookings 'bks) + :inner-join (:as 'cd.facilities 'facs) + :on (:= 'bks.facid 'facs.facid) + :group-by 'facs.name) + 'revenue)) + "((SELECT facs.name, SUM((slots * CASE WHEN (memid = 0) THEN facs.guestcost ELSE facs.membercost END)) AS revenue FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name) ORDER BY revenue)")) + + ;; From https://www.pgexercises.com/questions/aggregates/facrev2.html + ;; V1 + (is (equal + (sql (:order-by + (:select 'name 'revenue + :from (:as (:select 'facs.name + (:as (:sum (:case ((:= 'memid 0) + (:* 'slots 'facs.guestcost)) + (:else (:* 'slots 'membercost)))) + 'revenue) :from (:as 'cd.bookings 'bks) :inner-join (:as 'cd.facilities 'facs) :on (:= 'bks.facid 'facs.facid) :group-by 'facs.name) - 'revenue)) - "((SELECT facs.name, SUM((slots * CASE WHEN (memid = 0) THEN facs.guestcost ELSE facs.membercost END)) AS revenue FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name) ORDER BY revenue)")) - - ;; From https://www.pgexercises.com/questions/aggregates/facrev2.html - ;; V1 - (is (equal (sql (:order-by - (:select 'name 'revenue - :from (:as (:select 'facs.name - (:as (:sum (:case ((:= 'memid 0) (:* 'slots 'facs.guestcost)) - (:else (:* 'slots 'membercost)))) - 'revenue) - :from (:as 'cd.bookings 'bks) - :inner-join (:as 'cd.facilities 'facs) - :on (:= 'bks.facid 'facs.facid) - :group-by 'facs.name) - 'agg) - :where (:< 'revenue 1000)) - 'revenue)) - "((SELECT name, revenue FROM (SELECT facs.name, SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) AS revenue FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name) AS agg WHERE (revenue < 1000)) ORDER BY revenue)")) - ;; V2 - (is (equal (sql (:order-by - (:select 'facs.name (:as (:sum (:case ((:= 'memid 0) (:* 'slots 'facs.guestcost)) - (:else (:* 'slots 'membercost)))) - 'revenue) - :from (:as 'cd.bookings 'bks) - :inner-join (:as 'cd.facilities 'facs) - :on (:= 'bks.facid 'facs.facid) - :group-by 'facs.name - :having (:< (:sum (:case ((:= 'memid 0) (:* 'slots 'facs.guestcost)) + 'agg) + :where (:< 'revenue 1000)) + 'revenue)) + "((SELECT name, revenue FROM (SELECT facs.name, SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) AS revenue FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name) AS agg WHERE (revenue < 1000)) ORDER BY revenue)")) + ;; V2 + (is (equal (sql (:order-by + (:select 'facs.name (:as (:sum (:case ((:= 'memid 0) (:* 'slots 'facs.guestcost)) (:else (:* 'slots 'membercost)))) - 1000)) - 'revenue)) - "((SELECT facs.name, SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) AS revenue FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name HAVING (SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) < 1000)) ORDER BY revenue)")) - -;; From https://www.pgexercises.com/questions/aggregates/fachours2.html - ;; V1 - (is (equal (sql (:limit (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) - :from 'cd.bookings - :group-by 'facid) - (:desc (:sum 'slots))) - 1)) - "(((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings GROUP BY facid) ORDER BY SUM(slots) DESC) LIMIT 1)")) - - ;; V2 - (is (equal (sql (:select 'facid (:as (:sum 'slots) 'totalslots) - :from 'cd.bookings - :group-by 'facid - :having (:= (:sum 'slots) (:select (:max 'sum2.totalslots) - :from (:as (:select (:as (:sum 'slots ) 'totalslots) - :from 'cd.bookings - :group-by 'facid) - 'sum2))))) - "(SELECT facid, SUM(slots) AS totalslots FROM cd.bookings GROUP BY facid HAVING (SUM(slots) = (SELECT MAX(sum2.totalslots) FROM (SELECT SUM(slots) AS totalslots FROM cd.bookings GROUP BY facid) AS sum2)))")) - - ;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth3.html - ;; V1 - (is (equal (sql (:order-by (:select 'facid (:as (:extract 'month 'starttime) 'month) (:as (:sum 'slots) 'slots) - :from 'cd.bookings - :where (:and (:>= 'starttime "2012-01-01") - (:< 'starttime "2013-01-01")) - :group-by (:rollup 'facid 'month)) - 'facid 'month)) - "((SELECT facid, EXTRACT(month FROM starttime) AS month, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY rollup(facid, month)) ORDER BY facid, month)")) - - ;; V2 - (is (equal (sql (:order-by (:union-all (:select 'facid (:as (:extract 'month 'starttime) 'month) (:as (:sum 'slots) 'slots) - :from 'cd.bookings - :where (:and (:>= 'starttime "2012-01-01") - (:< 'starttime "2013-01-01")) - :group-by 'facid 'month) - (:select 'facid :null (:as (:sum 'slots) 'slots) - :from 'cd.bookings - :where (:and (:>= 'starttime "2012-01-01") - (:< 'starttime "2013-01-01")) - :group-by 'facid) - (:select :null :null (:as (:sum 'slots) 'slots) - :from 'cd.bookings - :where (:and (:>= 'starttime "2012-01-01") - (:< 'starttime "2013-01-01")))) - 'facid 'month)) - "(((SELECT facid, EXTRACT(month FROM starttime) AS month, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY facid, month) union all (SELECT facid, NULL, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY facid) union all (SELECT NULL, NULL, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')))) ORDER BY facid, month)"))) + 'revenue) + :from (:as 'cd.bookings 'bks) + :inner-join (:as 'cd.facilities 'facs) + :on (:= 'bks.facid 'facs.facid) + :group-by 'facs.name + :having (:< (:sum (:case ((:= 'memid 0) (:* 'slots 'facs.guestcost)) + (:else (:* 'slots 'membercost)))) + 1000)) + 'revenue)) + "((SELECT facs.name, SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) AS revenue FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name HAVING (SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) < 1000)) ORDER BY revenue)")) + + ;; From https://www.pgexercises.com/questions/aggregates/fachours2.html + ;; V1 + (is (equal (sql (:limit (:order-by (:select 'facid (:as (:sum 'slots) 'total-slots) + :from 'cd.bookings + :group-by 'facid) + (:desc (:sum 'slots))) + 1)) + "(((SELECT facid, SUM(slots) AS total_slots FROM cd.bookings GROUP BY facid) ORDER BY SUM(slots) DESC) LIMIT 1)")) + + ;; V2 + (is (equal (sql (:select 'facid (:as (:sum 'slots) 'totalslots) + :from 'cd.bookings + :group-by 'facid + :having (:= (:sum 'slots) (:select (:max 'sum2.totalslots) + :from (:as (:select (:as (:sum 'slots ) + 'totalslots) + :from 'cd.bookings + :group-by 'facid) + 'sum2))))) + "(SELECT facid, SUM(slots) AS totalslots FROM cd.bookings GROUP BY facid HAVING (SUM(slots) = (SELECT MAX(sum2.totalslots) FROM (SELECT SUM(slots) AS totalslots FROM cd.bookings GROUP BY facid) AS sum2)))")) + + ;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth3.html + ;; V1 + (is (equal (sql (:order-by + (:select 'facid (:as (:extract 'month 'starttime) 'month) + (:as (:sum 'slots) 'slots) + :from 'cd.bookings + :where (:and (:>= 'starttime "2012-01-01") + (:< 'starttime "2013-01-01")) + :group-by (:rollup 'facid 'month)) + 'facid 'month)) + "((SELECT facid, EXTRACT(month FROM starttime) AS month, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY rollup(facid, month)) ORDER BY facid, month)")) + + ;; V2 + (is (equal (sql + (:order-by + (:union-all + (:select 'facid (:as (:extract 'month 'starttime) 'month) (:as (:sum 'slots) 'slots) + :from 'cd.bookings + :where (:and (:>= 'starttime "2012-01-01") + (:< 'starttime "2013-01-01")) + :group-by 'facid 'month) + (:select 'facid :null (:as (:sum 'slots) 'slots) + :from 'cd.bookings + :where (:and (:>= 'starttime "2012-01-01") + (:< 'starttime "2013-01-01")) + :group-by 'facid) + (:select :null :null (:as (:sum 'slots) 'slots) + :from 'cd.bookings + :where (:and (:>= 'starttime "2012-01-01") + (:< 'starttime "2013-01-01")))) + 'facid 'month)) + "(((SELECT facid, EXTRACT(month FROM starttime) AS month, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY facid, month) union all (SELECT facid, NULL, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')) GROUP BY facid) union all (SELECT NULL, NULL, SUM(slots) AS slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')))) ORDER BY facid, month)"))) (test max-aggregation - "Testing aggregation functions." - (is (equal (sql (:select (:as (:max 'joindate) 'latest) :from 'cd.members)) - "(SELECT MAX(joindate) AS latest FROM cd.members)")) - (is (equal (sql (:select 'firstname 'surname 'joindate - :from 'cd.members - :where (:= 'joindate (:select (:max 'joindate) - :from 'cd.members)))) - "(SELECT firstname, surname, joindate FROM cd.members WHERE (joindate = (SELECT MAX(joindate) FROM cd.members)))"))) + "Testing aggregation functions." + (is (equal (sql (:select (:as (:max 'joindate) 'latest) :from 'cd.members)) + "(SELECT MAX(joindate) AS latest FROM cd.members)")) + (is (equal (sql (:select 'firstname 'surname 'joindate + :from 'cd.members + :where (:= 'joindate (:select (:max 'joindate) + :from 'cd.members)))) + "(SELECT firstname, surname, joindate FROM cd.members WHERE (joindate = (SELECT MAX(joindate) FROM cd.members)))"))) (test mode-aggregation-test "Testing the aggregate sql-op mode" @@ -886,82 +962,97 @@ To sum the column len of all films and group the results by kind:" (with-test-connection (unless (table-exists-p 'employee) (build-employee-table)) (is (equal (query (:order-by (:select 'id 'name 'city 'salary (:every (:like 'name "J%")) - :from 'employee - :group-by 'name 'id 'salary 'city) + :from 'employee + :group-by 'name 'id 'salary 'city) 'name)) - '((7 "Alison" "New York" 90620 NIL) (3 "Celia" "Toronto" 24020 NIL) - (8 "Chris" "Vancouver" 26020 NIL) (5 "David" "Vancouver" 80026 NIL) - (6 "James" "Toronto" 70060 T) (1 "Jason" "New York" 40420 T) - (4 "Linda" "New York" 40620 NIL) (9 "Mary" "Toronto" 60020 NIL) - (2 "Robert" "Vancouver" 14420 NIL)))) - (is (equal (query (:select 'id 'name 'city 'salary (:over (:every (:like 'name "J%")) - (:partition-by 'id)) - :from 'employee )) - '((1 "Jason" "New York" 40420 T) (2 "Robert" "Vancouver" 14420 NIL) - (3 "Celia" "Toronto" 24020 NIL) (4 "Linda" "New York" 40620 NIL) - (5 "David" "Vancouver" 80026 NIL) (6 "James" "Toronto" 70060 T) - (7 "Alison" "New York" 90620 NIL) (8 "Chris" "Vancouver" 26020 NIL) - (9 "Mary" "Toronto" 60020 NIL)))) - (is (equal (query (:select 'id 'name 'city 'salary (:over (:every (:ilike 'name "j%")) - (:partition-by 'id)) - :from 'employee )) - '((1 "Jason" "New York" 40420 T) (2 "Robert" "Vancouver" 14420 NIL) - (3 "Celia" "Toronto" 24020 NIL) (4 "Linda" "New York" 40620 NIL) - (5 "David" "Vancouver" 80026 NIL) (6 "James" "Toronto" 70060 T) - (7 "Alison" "New York" 90620 NIL) (8 "Chris" "Vancouver" 26020 NIL) - (9 "Mary" "Toronto" 60020 NIL)))))) + '((7 "Alison" "New York" 90620 NIL) (3 "Celia" "Toronto" 24020 NIL) + (8 "Chris" "Vancouver" 26020 NIL) (5 "David" "Vancouver" 80026 NIL) + (6 "James" "Toronto" 70060 T) (1 "Jason" "New York" 40420 T) + (4 "Linda" "New York" 40620 NIL) (9 "Mary" "Toronto" 60020 NIL) + (2 "Robert" "Vancouver" 14420 NIL)))) + (is (equal (query (:select 'id 'name 'city 'salary (:over (:every (:like 'name "J%")) + (:partition-by 'id)) + :from 'employee )) + '((1 "Jason" "New York" 40420 T) (2 "Robert" "Vancouver" 14420 NIL) + (3 "Celia" "Toronto" 24020 NIL) (4 "Linda" "New York" 40620 NIL) + (5 "David" "Vancouver" 80026 NIL) (6 "James" "Toronto" 70060 T) + (7 "Alison" "New York" 90620 NIL) (8 "Chris" "Vancouver" 26020 NIL) + (9 "Mary" "Toronto" 60020 NIL)))) + (is (equal (query (:select 'id 'name 'city 'salary (:over (:every (:ilike 'name "j%")) + (:partition-by 'id)) + :from 'employee )) + '((1 "Jason" "New York" 40420 T) (2 "Robert" "Vancouver" 14420 NIL) + (3 "Celia" "Toronto" 24020 NIL) (4 "Linda" "New York" 40620 NIL) + (5 "David" "Vancouver" 80026 NIL) (6 "James" "Toronto" 70060 T) + (7 "Alison" "New York" 90620 NIL) (8 "Chris" "Vancouver" 26020 NIL) + (9 "Mary" "Toronto" 60020 NIL)))))) (test grouping-sets-selects "Testing grouping sets in a select clause. Reminder requires postgresql 9.5 or later." - (is (equal (sql (:select 'c1 'c2 'c3 (:sum 'c4) :from 'table-name :group-by (:roll-up 'c1 'c2 'c3))) + (is (equal (sql (:select 'c1 'c2 'c3 (:sum 'c4) + :from 'table-name + :group-by (:roll-up 'c1 'c2 'c3))) "(SELECT c1, c2, c3, SUM(c4) FROM table_name GROUP BY roll_up(c1, c2, c3))")) - (is (equal (sql (:select 'c1 'c2 'c3 (:sum 'c4) :from 'table-name :group-by (:cube 'c1 'c2 'c3))) + (is (equal (sql (:select 'c1 'c2 'c3 (:sum 'c4) + :from 'table-name + :group-by (:cube 'c1 'c2 'c3))) "(SELECT c1, c2, c3, SUM(c4) FROM table_name GROUP BY cube(c1, c2, c3))")) (is (equal (sql (:select 'c1 'c2 'c3 (:string-agg 'c3) :from 'table-name :group-by (:grouping-sets (:set 'c1 'c2) (:set 'c1) (:set 'c2)))) "(SELECT c1, c2, c3, STRING_AGG(c3) FROM table_name GROUP BY GROUPING SETS (c1, c2), (c1), (c2))")) - (is (equal (sql (:select 'd1 'd2 'd3 (:sum 'v) :from 'test-cube :group-by (:grouping-sets (:set (:set 'd1) (:set 'd2 'd3) )))) + (is (equal (sql (:select 'd1 'd2 'd3 (:sum 'v) + :from 'test-cube + :group-by (:grouping-sets + (:set (:set 'd1) + (:set 'd2 'd3))))) "(SELECT d1, d2, d3, SUM(v) FROM test_cube GROUP BY GROUPING SETS ((d1), (d2, d3)))")) (is (equal (with-test-connection - (query (:select 'city (:as (:extract 'year 'start-date) 'joining-year) (:as (:count 1) 'employee_count) + (query (:select 'city (:as (:extract 'year 'start-date) 'joining-year) + (:as (:count 1) 'employee_count) :from 'employee :group-by (:grouping-sets (:set 'city (:extract 'year 'start-date)))))) '(("Vancouver" :NULL 3) ("New York" :NULL 3) ("Toronto" :NULL 3) - (:NULL 2001.0d0 1) (:NULL 1997.0d0 1) (:NULL 1994.0d0 1) (:NULL 2000.0d0 1) - (:NULL 2002.0d0 1) (:NULL 1996.0d0 1) (:NULL 1995.0d0 1) (:NULL 1998.0d0 1) + (:NULL 2001.0d0 1) (:NULL 1997.0d0 1) (:NULL 1994.0d0 1) (:NULL 2000.0d0 1) + (:NULL 2002.0d0 1) (:NULL 1996.0d0 1) (:NULL 1995.0d0 1) (:NULL 1998.0d0 1) (:NULL 1999.0d0 1)))) - (is (equal (sql (:select 'appnumber 'day (:sum 'inserts) (:sum 'updates) (:sum 'deletes) (:sum 'transactions) - :from 'db-details - :group-by (:grouping-sets (:set 'appnumber 'day) ))) - "(SELECT appnumber, day, SUM(inserts), SUM(updates), SUM(deletes), SUM(transactions) FROM db_details GROUP BY GROUPING SETS (appnumber, day))")) + (is (equal (sql (:select 'appnumber 'day (:sum 'inserts) (:sum 'updates) + (:sum 'deletes) (:sum 'transactions) + :from 'db-details + :group-by (:grouping-sets (:set 'appnumber 'day) ))) + "(SELECT appnumber, day, SUM(inserts), SUM(updates), SUM(deletes), SUM(transactions) FROM db_details GROUP BY GROUPING SETS (appnumber, day))")) - (is (equal (sql (:select 'appnumber 'day (:sum 'inserts) (:sum 'updates) (:sum 'deletes) (:sum 'transactions) + (is (equal (sql (:select 'appnumber 'day (:sum 'inserts) (:sum 'updates) + (:sum 'deletes) (:sum 'transactions) :from 'db-details :group-by (:grouping-sets (:set 'appnumber 'day (:empty-set)) ))) - "(SELECT appnumber, day, SUM(inserts), SUM(updates), SUM(deletes), SUM(transactions) FROM db_details GROUP BY GROUPING SETS (appnumber, day, ()))"))) + "(SELECT appnumber, day, SUM(inserts), SUM(updates), SUM(deletes), SUM(transactions) FROM db_details GROUP BY GROUPING SETS (appnumber, day, ()))"))) (test string-agg "Testing string-agg sql-op" (with-test-connection - (is (equal (sql (:select (:as (:string-agg 'bp.step-type "," ) 'step-summary) :from 'business-process)) + (is (equal (sql (:select (:as (:string-agg 'bp.step-type "," ) 'step-summary) + :from 'business-process)) "(SELECT STRING_AGG(bp.step_type, E',') AS step_summary FROM business_process)")) (is (equal (sql (:select 'mid (:as (:string-agg 'y "," :distinct) 'words) :from 'moves)) "(SELECT mid, STRING_AGG(DISTINCT y, E',') AS words FROM moves)")) - (is (equal (sql (:select 'mid (:as (:string-agg 'y "," :distinct :order-by (:desc 'y) ) 'words) :from 'moves)) + (is (equal (sql (:select 'mid (:as (:string-agg 'y "," :distinct :order-by (:desc 'y)) 'words) + :from 'moves)) "(SELECT mid, STRING_AGG(DISTINCT y, E',' ORDER BY y DESC) AS words FROM moves)")) (unless (table-exists-p 'employee) (build-employee-table)) (is (equal - (query (:select (:string-agg 'name "," :order-by (:desc 'name) :filter (:< 'id 4)) :from 'employee)) - '(("Robert,Jason,Celia")))))) + (query (:select (:string-agg 'name "," :order-by (:desc 'name) :filter (:< 'id 4)) + :from 'employee)) + '(("Robert,Jason,Celia")))))) (test percentile-cont "Testing percentile-cont." (is (equal (sql (:select (:percentile-cont :fraction 0.5 :order-by 'number-of-staff) - :from 'schools)) + :from 'schools)) "(SELECT PERCENTILE_CONT(0.5) WITHIN GROUP (ORDER BY number_of_staff) FROM schools)")) - (is (equal (sql (:select (:percentile-cont :fraction array[0.25 0.5 0.75 1] :order-by 'number-of-staff) - :from 'schools)) + (is (equal (sql (:select (:percentile-cont :fraction array[0.25 0.5 0.75 1] + :order-by 'number-of-staff) + :from 'schools)) "(SELECT PERCENTILE_CONT(ARRAY[0.25 0.5 0.75 1]) WITHIN GROUP (ORDER BY number_of_staff) FROM schools)")) (is (equal (sql (:order-by (:select 'day @@ -973,18 +1064,19 @@ To sum the column len of all films and group the results by kind:" (:partition-by 'day)) (:over (:percentile-cont :fraction 0.85 :order-by (:asc 'duration)) (:partition-by 'day)) - :from 'query-durations - :group-by 1 ) + :from 'query-durations + :group-by 1 ) 1)) "((SELECT day, (PERCENTILE_CONT(0.25) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)), (PERCENTILE_CONT(0.5) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)), (PERCENTILE_CONT(0.75) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)), (PERCENTILE_CONT(0.85) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day)) FROM query_durations GROUP BY 1) ORDER BY 1)"))) (test percentile-dist "Testing percentile-dist sql-op" (is (equal (sql (:select (:percentile-dist :fraction 0.5 :order-by 'number-of-staff) - :from 'schools)) + :from 'schools)) "(SELECT PERCENTILE_DIST(0.5) WITHIN GROUP (ORDER BY number_of_staff) FROM schools)")) - (is (equal (sql (:select (:percentile-dist :fraction array[0.25 0.5 0.75 1] :order-by 'number-of-staff) - :from 'schools)) + (is (equal (sql (:select (:percentile-dist :fraction array[0.25 0.5 0.75 1] + :order-by 'number-of-staff) + :from 'schools)) "(SELECT PERCENTILE_DIST(ARRAY[0.25 0.5 0.75 1]) WITHIN GROUP (ORDER BY number_of_staff) FROM schools)"))) (test corr @@ -995,36 +1087,39 @@ To sum the column len of all films and group the results by kind:" (test covar-pop "Testing population covariance." - (is (equal (sql (:select (:covar-pop 'height 'weight) :from 'people)) - "(SELECT COVAR_POP(height , weight) FROM people)"))) + (is (equal (sql (:select (:covar-pop 'height 'weight) :from 'people)) + "(SELECT COVAR_POP(height , weight) FROM people)"))) (test covar-samp "Testing sample covariance." - (is (equal (sql (:select (:covar-samp 'height 'weight) :from 'people)) + (is (equal (sql (:select (:covar-samp 'height 'weight) :from 'people)) "(SELECT COVAR_SAMP(height , weight) FROM people)"))) (test stddev1 "Testing statistical functions 1" (with-test-connection (unless (table-exists-p 'employee) (build-employee-table)) - (is (equal (format nil "~,6f" (query (:select (:stddev 'salary) :from 'employee) :single)) - "26805.934000")) - (is (equal (query (:select (:variance 'salary) :from 'employee) :single) - 718558064)) - (is (equal (query (:select (:var-pop 'salary) :from 'employee) :single) - 63871827911111111/100000000)) - (is (equal (query (:select (:var-samp 'salary) :from 'employee) :single) - 718558064)) - (is (equal (format nil "~,4f" (query (:select (:stddev-samp 'salary) :from 'employee) :single)) - "26805.9340")) - (is (equal (format nil "~,4f" (query (:select (:stddev-pop 'salary) :from 'employee) :single)) - "25272.8770")) - (is (equal (format nil "~,4f" (query (:select (:avg 'salary) :from 'employee) :single)) - "49580.6680")) - (is (equal (format nil "~,4f" (query (:select (:max 'salary) :from 'employee) :single)) - "90620.0000")) - (is (equal (format nil "~,4f" (query (:select (:min 'salary) :from 'employee) :single)) - "14420.0000")))) + (is (equal (format nil "~,6f" + (query (:select (:stddev 'salary) :from 'employee) :single)) + "26805.934000")) + (is (equal (query (:select (:variance 'salary) :from 'employee) :single) + 718558064)) + (is (equal (query (:select (:var-pop 'salary) :from 'employee) :single) + 63871827911111111/100000000)) + (is (equal (query (:select (:var-samp 'salary) :from 'employee) :single) + 718558064)) + (is (equal (format nil "~,4f" + (query (:select (:stddev-samp 'salary) :from 'employee) :single)) + "26805.9340")) + (is (equal (format nil "~,4f" + (query (:select (:stddev-pop 'salary) :from 'employee) :single)) + "25272.8770")) + (is (equal (format nil "~,4f" (query (:select (:avg 'salary) :from 'employee) :single)) + "49580.6680")) + (is (equal (format nil "~,4f" (query (:select (:max 'salary) :from 'employee) :single)) + "90620.0000")) + (is (equal (format nil "~,4f" (query (:select (:min 'salary) :from 'employee) :single)) + "14420.0000")))) (test regr-functions "Testing standard deviation functions" @@ -1042,7 +1137,8 @@ To sum the column len of all films and group the results by kind:" 9)) (is (equal (query (:select (:regr-count 'age 'salary) :from 'employee) :single) 9)) - (is (equal (round (query (:select (:regr-intercept 'salary 'age) :from 'employee) :single)) + (is (equal (round (query (:select (:regr-intercept 'salary 'age) :from 'employee) + :single)) (round -62911.0363153233d0))) ;; using round because postgresql 12 generates a slightly different number than postgresql 11 (is (equal (query (:select (:regr-intercept 'age 'salary) :from 'employee) :single) 19.451778623108986d0)) @@ -1067,60 +1163,107 @@ To sum the column len of all films and group the results by kind:" (is (equal (round (query (:select (:regr-syy 'age 'salary) :from 'employee) :single)) (round 250.88888888888889d0))))) ;; using round because postgresql 12 generates a slightly different number than postgresql 11 -(test select-union - "testing basic union." +(test union + "testing basic union." ;;; https://www.postgresql.org/docs/current/static/typeconv-union-case.html - (is (equal (sql (:union (:select (:as "a" 'text) ) (:select "b"))) - "((SELECT E'a' AS text) union (SELECT E'b'))")) - (is (equal (sql (:union (:select (:as 1.2 "numeric")) (:select 1))) - "((SELECT 1.2 AS E'numeric') union (SELECT 1))")) + (is (equal (sql (:union (:select (:as "a" 'text) ) (:select "b"))) + "((SELECT E'a' AS text) union (SELECT E'b'))")) + (is (equal (sql (:union (:select (:as 1.2 "numeric")) (:select 1))) + "((SELECT 1.2 AS E'numeric') union (SELECT 1))")) ;;; This shows how to obtain the union of the tables distributors and actors, restricting the results to those that begin with the letter W in each table. Only distinct rows are wanted, so the key word ALL is omitted. https://www.postgresql.org/docs/current/static/sql-select.html - (is (equal (sql (:union (:select 'distributors.name - :from 'distributors - :where (:like 'distributors.name "W%")) - (:select 'actors.name - :from 'actors - :where (:like 'actors.name "W%")))) - "((SELECT distributors.name FROM distributors WHERE (distributors.name like E'W%')) union (SELECT actors.name FROM actors WHERE (actors.name like E'W%')))")) + (is (equal (sql (:union (:select 'distributors.name + :from 'distributors + :where (:like 'distributors.name "W%")) + (:select 'actors.name + :from 'actors + :where (:like 'actors.name "W%")))) + "((SELECT distributors.name FROM distributors WHERE (distributors.name like E'W%')) union (SELECT actors.name FROM actors WHERE (actors.name like E'W%')))")) ;;; Union-all with a simple with clause https://www.postgresql.org/docs/current/static/sql-select.html - (is (equal (sql (:union-all - (:with (:as 't1 (:select (:as (:random) 'x) - :from (:generate-series 1 3))) - (:select '* :from 't1)) (:select '* :from 't1))) - "(WITH t1 AS (SELECT random() AS x FROM generate_series(1, 3))(SELECT * FROM t1) union all (SELECT * FROM t1))"))) -(test select-with - "Testing select having a CTE with function From https://www.pgexercises.com/questions/aggregates/fachours2.html" - (is (equal (sql (:with (:as 'sum (:select 'facid (:as (:sum 'slots) 'totalslots) - :from 'cd.bookings - :group-by 'facid)) - (:select 'facid 'totalslots - :from 'sum - :where (:= 'totalslots (:select (:max 'totalslots) :from 'sum))))) - "WITH sum AS (SELECT facid, SUM(slots) AS totalslots FROM cd.bookings GROUP BY facid)(SELECT facid, totalslots FROM sum WHERE (totalslots = (SELECT MAX(totalslots) FROM sum)))")) - - ;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth3.html - (is (equal (sql (:order-by (:with (:as 'bookings (:select 'facid (:as (:extract 'month 'starttime) 'month) 'slots - :from 'cd.bookings - :where (:and (:>= 'starttime "2012-01-01") - (:< 'starttime "2013-01-01")))) - (:union-all (:select 'facid 'month (:sum 'slots) :from 'bookings :group-by 'facid 'month) - (:select 'facid :null (:sum 'slots) :from 'bookings :group-by 'facid) - (:select :null :null (:sum 'slots) :from 'bookings))) 'facid 'month)) - "(WITH bookings AS (SELECT facid, EXTRACT(month FROM starttime) AS month, slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')))((SELECT facid, month, SUM(slots) FROM bookings GROUP BY facid, month) union all (SELECT facid, NULL, SUM(slots) FROM bookings GROUP BY facid) union all (SELECT NULL, NULL, SUM(slots) FROM bookings)) ORDER BY facid, month)")) - - (is (equal (sql (:order-by (:select 'facs.facid 'facs.name - (:as (:trim (:to-char (:/ (:sum 'bks.slots) 2.0) "9999999999999999D99")) 'total-hours) - :from (:as 'cd.bookings 'bks) - :inner-join (:as 'cd.facilities 'facs) - :on (:= 'facs.facid 'bks.facid) - :group-by 'facs.facid 'facs.name) - 'facs.facid)) -"((SELECT facs.facid, facs.name, trim(to_char((SUM(bks.slots) / 2.0), E'9999999999999999D99')) AS total_hours FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (facs.facid = bks.facid) GROUP BY facs.facid, facs.name) ORDER BY facs.facid)")) - ) + (is (equal (sql (:union-all + (:with (:as 't1 (:select (:as (:random) 'x) + :from (:generate-series 1 3))) + (:select '* :from 't1)) (:select '* :from 't1))) + "(WITH t1 AS (SELECT random() AS x FROM generate_series(1, 3))(SELECT * FROM t1) union all (SELECT * FROM t1))"))) + +(test with + "Testing select having a CTE with function From https://www.pgexercises.com/questions/aggregates/fachours2.html" + (is + (equal + (sql + (:with (:as 'regional-sales (:select 'region (:as (:sum 'amount) 'total-sales) + :from 'orders :group-by 'region)) + (:as 'top-regions (:select 'region + :from 'regional-sales + :where (:> 'total-sales + (:select (:/ (:sum 'total-sales) 10) + :from 'regional-sales)))) + (:select 'region 'product (:as (:sum 'quantity) 'product-units) + (:as (:sum 'amount) 'product-sales) + :from 'orders + :where (:in 'region (:select 'region :from 'top-regions)) + :group-by 'region 'product))) + "WITH regional_sales AS (SELECT region, SUM(amount) AS total_sales FROM orders GROUP BY region), top_regions AS (SELECT region FROM regional_sales WHERE (total_sales > (SELECT (SUM(total_sales) / 10) FROM regional_sales)))(SELECT region, product, SUM(quantity) AS product_units, SUM(amount) AS product_sales FROM orders WHERE (region IN (SELECT region FROM top_regions)) GROUP BY region, product)")) + (is + (equal + (sql + (:with (:as (:movies-by-tags 'tag-id 'name 'created-at 'rank) + (:select 'tag-id 'name 'created-at + (:over (:row-number) + (:partition-by 'tag-id :order-by 'tag-id + (:desc 'created-at))) + :from 'movies)) + (:select '* + :from (:as 'movies-by-tags 'mbt) + :where (:< 'mbt.rank 3)))) + "WITH movies_by_tags(tag_id, name, created_at, rank) AS (SELECT tag_id, name, created_at, (row_number() OVER (PARTITION BY tag_id ORDER BY tag_id, created_at DESC)) FROM movies)(SELECT * FROM movies_by_tags AS mbt WHERE (mbt.rank < 3))")) + (is + (equal + (sql + (:with (:as 'sum (:select 'facid (:as (:sum 'slots) 'totalslots) + :from 'cd.bookings + :group-by 'facid)) + (:select 'facid 'totalslots + :from 'sum + :where (:= 'totalslots (:select (:max 'totalslots) + :from 'sum))))) + "WITH sum AS (SELECT facid, SUM(slots) AS totalslots FROM cd.bookings GROUP BY facid)(SELECT facid, totalslots FROM sum WHERE (totalslots = (SELECT MAX(totalslots) FROM sum)))")) + + ;; From https://www.pgexercises.com/questions/aggregates/fachoursbymonth3.html + (is + (equal + (sql + (:order-by (:with (:as 'bookings + (:select 'facid + (:as (:extract 'month 'starttime) 'month) 'slots + :from 'cd.bookings + :where (:and (:>= 'starttime "2012-01-01") + (:< 'starttime "2013-01-01")))) + (:union-all (:select 'facid 'month (:sum 'slots) + :from 'bookings :group-by 'facid 'month) + (:select 'facid :null (:sum 'slots) + :from 'bookings :group-by 'facid) + (:select :null :null (:sum 'slots) + :from 'bookings))) + 'facid 'month)) + "(WITH bookings AS (SELECT facid, EXTRACT(month FROM starttime) AS month, slots FROM cd.bookings WHERE ((starttime >= E'2012-01-01') and (starttime < E'2013-01-01')))((SELECT facid, month, SUM(slots) FROM bookings GROUP BY facid, month) union all (SELECT facid, NULL, SUM(slots) FROM bookings GROUP BY facid) union all (SELECT NULL, NULL, SUM(slots) FROM bookings)) ORDER BY facid, month)")) + + (is + (equal + (sql + (:order-by (:select 'facs.facid 'facs.name + (:as (:trim (:to-char (:/ (:sum 'bks.slots) 2.0) + "9999999999999999D99")) + 'total-hours) + :from (:as 'cd.bookings 'bks) + :inner-join (:as 'cd.facilities 'facs) + :on (:= 'facs.facid 'bks.facid) + :group-by 'facs.facid 'facs.name) + 'facs.facid)) + "((SELECT facs.facid, facs.name, trim(to_char((SUM(bks.slots) / 2.0), E'9999999999999999D99')) AS total_hours FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (facs.facid = bks.facid) GROUP BY facs.facid, facs.name) ORDER BY facs.facid)"))) (test select-order-by @@ -1139,7 +1282,7 @@ To sum the column len of all films and group the results by kind:" "((SELECT id, name FROM users) ORDER BY name ASC)")) (is (equal (sql (:order-by (:select 'firstname 'surname - :from 'cd.members) + :from 'cd.members) 'surname)) "((SELECT firstname, surname FROM cd.members) ORDER BY surname)")) (is (equal (sql (:select (:over (:first-value 'x) (:order-by 'x)) @@ -1157,86 +1300,241 @@ To sum the column len of all films and group the results by kind:" "(SELECT STRING_AGG(a, E',' ORDER BY a DESC) FROM tiny)"))) -(test select-over +(test over "Testing with over and partition by. From https://www.pgexercises.com/questions/aggregates/countmembers.html" - (is (equal (sql (:order-by - (:select (:over (:count '*)) 'firstname 'surname - :from 'cd.members) - 'joindate)) - "((SELECT (COUNT(*) OVER ()) , firstname, surname FROM cd.members) ORDER BY joindate)")) - - (is (equal (sql (:order-by (:select (:over (:count '*) - (:partition-by (:date-trunc "month" 'joindate))) - 'firstname 'surname - :from 'cd.members ) - 'joindate)) - "((SELECT (COUNT(*) OVER (PARTITION BY date_trunc(E'month', joindate))), firstname, surname FROM cd.members) ORDER BY joindate)")) -;; From https://www.pgexercises.com/questions/aggregates/nummembers.html - (is (equal (sql (:order-by - (:select (:over (:row-number) (:order-by 'joindate)) 'firstname 'surname - :from 'cd.members) - 'joindate)) - "((SELECT (row_number() OVER ( ORDER BY joindate)), firstname, surname FROM cd.members) ORDER BY joindate)")) + (is (equal (sql (:over (:sum 'salary))) + "(SUM(salary) OVER ()) ")) + (is (equal (sql (:over (:sum 'salary) 'w)) + "(SUM(salary) OVER w)")) + (is (equal (sql (:over (:count '*) + (:partition-by (:date-trunc "month" 'joindate)))) + "(COUNT(*) OVER (PARTITION BY date_trunc(E'month', joindate)))")) + (is (equal (sql (:over (:rank) (:order-by (:desc 'total)))) + "(rank() OVER ( ORDER BY total DESC))")) + (is (equal (sql (:over (:percentile-cont :fraction 0.25 :order-by (:asc 'duration)) + (:partition-by 'day))) + "(PERCENTILE_CONT(0.25) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day))")) + (is (equal (sql (:select 'tag-id 'name 'created-at + (:over (:row-number) + (:partition-by 'tag-id + :order-by 'tag-id + (:desc 'created-at))) + :from 'movies)) + "(SELECT tag_id, name, created_at, (row_number() OVER (PARTITION BY tag_id ORDER BY tag_id, created_at DESC)) FROM movies)")) + (is (equal + (sql (:order-by + (:select (:over (:count '*)) 'firstname 'surname + :from 'cd.members) + 'joindate)) + "((SELECT (COUNT(*) OVER ()) , firstname, surname FROM cd.members) ORDER BY joindate)")) + + (is (equal + (sql (:order-by (:select (:over (:count '*) + (:partition-by (:date-trunc "month" 'joindate))) + 'firstname 'surname + :from 'cd.members ) + 'joindate)) + "((SELECT (COUNT(*) OVER (PARTITION BY date_trunc(E'month', joindate))), firstname, surname FROM cd.members) ORDER BY joindate)")) + ;; From https://www.pgexercises.com/questions/aggregates/nummembers.html + (is (equal + (sql (:order-by + (:select (:over (:row-number) (:order-by 'joindate)) 'firstname 'surname + :from 'cd.members) + 'joindate)) + "((SELECT (row_number() OVER ( ORDER BY joindate)), firstname, surname FROM cd.members) ORDER BY joindate)")) ;;From https://www.pgexercises.com/questions/aggregates/fachours4.html - (is (equal (sql (:select 'facid 'total - :from (:as (:select 'facid (:as (:sum 'slots) 'total) - (:as (:over (:rank) (:order-by (:desc (:sum 'slots)))) - 'rank) - :from 'cd.bookings - :group-by 'facid) - 'ranked) - :where (:= 'rank 1))) - "(SELECT facid, total FROM (SELECT facid, SUM(slots) AS total, (rank() OVER ( ORDER BY SUM(slots) DESC)) AS rank FROM cd.bookings GROUP BY facid) AS ranked WHERE (rank = 1))")) - - (is (equal (sql (:select 'facid 'total - :from (:as (:select 'facid 'total (:as (:over (:rank) (:order-by (:desc 'total))) - 'rank) - :from (:as (:select 'facid (:as (:sum 'slots) 'total) - :from 'cd.bookings - :group-by 'facid) 'sumslots)) - 'ranked) - :where (:= 'rank 1))) - "(SELECT facid, total FROM (SELECT facid, total, (rank() OVER ( ORDER BY total DESC)) AS rank FROM (SELECT facid, SUM(slots) AS total FROM cd.bookings GROUP BY facid) AS sumslots) AS ranked WHERE (rank = 1))")) + (is (equal + (sql (:select 'facid 'total + :from (:as (:select 'facid (:as (:sum 'slots) 'total) + (:as (:over (:rank) + (:order-by (:desc (:sum 'slots)))) + 'rank) + :from 'cd.bookings + :group-by 'facid) + 'ranked) + :where (:= 'rank 1))) + "(SELECT facid, total FROM (SELECT facid, SUM(slots) AS total, (rank() OVER ( ORDER BY SUM(slots) DESC)) AS rank FROM cd.bookings GROUP BY facid) AS ranked WHERE (rank = 1))")) + + (is (equal + (sql (:select 'facid 'total + :from (:as (:select 'facid 'total + (:as (:over (:rank) (:order-by (:desc 'total))) + 'rank) + :from (:as (:select 'facid (:as (:sum 'slots) 'total) + :from 'cd.bookings + :group-by 'facid) + 'sumslots)) + 'ranked) + :where (:= 'rank 1))) + "(SELECT facid, total FROM (SELECT facid, total, (rank() OVER ( ORDER BY total DESC)) AS rank FROM (SELECT facid, SUM(slots) AS total FROM cd.bookings GROUP BY facid) AS sumslots) AS ranked WHERE (rank = 1))")) ;; from https://www.pgexercises.com/questions/aggregates/classify.html - (is (equal (sql (:order-by (:select 'name (:as (:case ((:= 'class 1) "high") - ((:= 'class 2) "average") - (:else "low")) - 'revenue) - :from (:as - (:select (:as 'facs.name 'name) - (:as (:over (:ntile 3) - (:order-by - (:desc - (:sum (:case - ((:= 'memid 0) (:* 'slots 'facs.guestcost)) - (:else (:* 'slots 'membercost))))))) - 'class) - :from (:as 'cd.bookings 'bks) - :inner-join (:as 'cd.facilities 'facs) - :on (:= 'bks.facid 'facs.facid) - :group-by 'facs.name) - 'subq)) - 'class 'name)) - "((SELECT name, CASE WHEN (class = 1) THEN E'high' WHEN (class = 2) THEN E'average' ELSE E'low' END AS revenue FROM (SELECT facs.name AS name, (ntile(3) OVER ( ORDER BY SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) DESC)) AS class FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name) AS subq) ORDER BY class, name)"))) - -(test select-with-recursive - "Testing with recursive. When working with recursive queries it is important to be sure that the recursive part of the query will eventually return no tuples, or else the query will loop indefinitely. Sometimes, using UNION instead of UNION ALL can accomplish this by discarding rows that duplicate previous output rows. However, often a cycle does not involve output rows that are completely duplicate: it may be necessary to check just one or a few fields to see if the same point has been reached before. The standard method for handling such situations is to compute an array of the already-visited values." - - (is (equal (with-test-connection - (query - (:with-recursive - (:as (:t1 'n) - (:union-all (:values (:set 1)) - (:select (:+ 'n 1) - :from 't1 - :where (:< 'n 100)))) - (:select (:sum 'n) :from 't1)) - :single)) - 5050)) - -;; the following query that searches a table graph using a link field: + (is (equal + (sql (:order-by (:select 'name (:as (:case ((:= 'class 1) "high") + ((:= 'class 2) "average") + (:else "low")) + 'revenue) + :from (:as + (:select (:as 'facs.name 'name) + (:as (:over (:ntile 3) + (:order-by + (:desc + (:sum (:case + ((:= 'memid 0) + (:* 'slots 'facs.guestcost)) + (:else (:* 'slots 'membercost))))))) + 'class) + :from (:as 'cd.bookings 'bks) + :inner-join (:as 'cd.facilities 'facs) + :on (:= 'bks.facid 'facs.facid) + :group-by 'facs.name) + 'subq)) + 'class 'name)) + "((SELECT name, CASE WHEN (class = 1) THEN E'high' WHEN (class = 2) THEN E'average' ELSE E'low' END AS revenue FROM (SELECT facs.name AS name, (ntile(3) OVER ( ORDER BY SUM(CASE WHEN (memid = 0) THEN (slots * facs.guestcost) ELSE (slots * membercost) END) DESC)) AS class FROM cd.bookings AS bks INNER JOIN cd.facilities AS facs ON (bks.facid = facs.facid) GROUP BY facs.name) AS subq) ORDER BY class, name)"))) + +(test between + (is (equal (sql (:between 'latitude -10 10)) + "(latitude BETWEEN -10 AND 10)")) + (is (equal (sql (:between (:- 'population.year 'ma-population.year) 0 2)) + "((population.year - ma_population.year) BETWEEN 0 AND 2)"))) + +(test over-range-between + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country :unbounded-preceding + :unbounded-following)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country RANGE BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:range-between :order-by 'country :current-row + :unbounded-following)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country RANGE BETWEEN CURRENT ROW AND UNBOUNDED FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) + +(test over-row-between + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :preceding 2 + :following 2)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN 2 PRECEDING AND 2 FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :current-row + :following 2)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN CURRENT ROW AND 2 FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'country 'country-name) + (:as 'population 'country-population) + (:as (:over (:sum 'population) + (:rows-between :order-by 'country :preceding 2 + :current-row)) + 'global-population) + :from 'population + :where (:and (:not-null 'iso2) + (:= 'year 1976))) + 5)) + "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN 2 PRECEDING AND CURRENT ROW )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) + +(test over-with-partition-with-range-or-row-between + (is (equal + (sql (:limit + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'population.country + :range-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976))) + 5)) + "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY population.country RANGE BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql (:limit + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'region-name + :range-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976))) + 5)) + "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY region_name RANGE BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) + (is (equal + (sql + (:limit + (:select (:as 'population.country 'country-name) + (:as 'population 'country-population) + 'region-name + (:as (:over (:sum 'population) + (:partition-by 'region-name :order-by 'region-name + :rows-between :unbounded-preceding :current-row)) + 'regional-population) + :from 'population + :inner-join 'regions + :on (:= 'population.iso3 'regions.iso3) + :where (:and (:not-null 'population.iso2) + (:= 'year 1976))) + 5)) + "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY region_name ROWS BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) + +(test with-recursive + "Testing with recursive. When working with recursive queries it is important to be sure that the recursive part of the query will eventually return no tuples, or else the query will loop indefinitely. Sometimes, using UNION instead of UNION ALL can accomplish this by discarding rows that duplicate previous output rows. However, often a cycle does not involve output rows that are completely duplicate: it may be necessary to check just one or a few fields to see if the same point has been reached before. The standard method for handling such situations is to compute an array of the already-visited values." + + (is (equal (with-test-connection + (query + (:with-recursive + (:as (:t1 'n) + (:union-all (:values (:set 1)) + (:select (:+ 'n 1) + :from 't1 + :where (:< 'n 100)))) + (:select (:sum 'n) :from 't1)) + :single)) + 5050)) + + ;; the following query that searches a table graph using a link field: (is (equal (sql (:with-recursive (:as (:search-graph 'id 'link 'data 'depth) @@ -1244,133 +1542,344 @@ To sum the column len of all films and group the results by kind:" :from (:as 'graph 'g)) (:select 'g.id 'g.link 'g.data (:= 'sg.depth 1) :from (:as 'graph 'g) (:as 'search-graph 'sg) - :where (:= 'g.id 'sg.link)))) + :where (:= 'g.id 'sg.link)))) (:select '* :from 'search-graph))) "WITH RECURSIVE search_graph(id, link, data, depth) AS ((SELECT g.id, g.link, g.data, 1 FROM graph AS g) union all (SELECT g.id, g.link, g.data, (sg.depth = 1) FROM graph AS g, search_graph AS sg WHERE (g.id = sg.link)))(SELECT * FROM search_graph)")) - ;; Recursive queries are typically used to deal with hierarchical or tree-structured data. A useful example is this query to find all the direct and indirect sub-parts of a product, given only a table that shows immediate inclusions: + ;; Recursive queries are typically used to deal with hierarchical or tree-structured data. A useful example is this query to find all the direct and indirect sub-parts of a product, given only a table that shows immediate inclusions: - (is (equal (sql - (:with-recursive - (:as (:included-parts 'sub-part 'part 'quantity) + (is (equal (sql + (:with-recursive + (:as (:included-parts 'sub-part 'part 'quantity) + (:union-all + (:select 'sub-part 'part 'quantity + :from 'parts + :where (:= 'part "our-product")) + (:select 'p.sub-part 'p.part 'p.quantity + :from (:as 'included-parts 'pr) + (:as 'parts 'p) + :where (:= 'p.part 'pr.sub-part)))) + (:select 'sub-part (:as (:sum 'quantity) 'total-quantity) + :from 'included-parts + :group-by 'sub-part))) + "WITH RECURSIVE included_parts(sub_part, part, quantity) AS ((SELECT sub_part, part, quantity FROM parts WHERE (part = E'our-product')) union all (SELECT p.sub_part, p.part, p.quantity FROM included_parts AS pr, parts AS p WHERE (p.part = pr.sub_part)))(SELECT sub_part, SUM(quantity) AS total_quantity FROM included_parts GROUP BY sub_part)")) + + ;; This query will loop if the link relationships contain cycles. Because we require a “depth” output, just changing UNION ALL to UNION would not eliminate the looping. Instead we need to recognize whether we have reached the same row again while following a particular path of links. We add two columns path and cycle to the loop-prone query: + + ;; In the general case where more than one field needs to be checked to recognize a cycle, use an array of rows. For example, if we needed to compare fields f1 and f2: + + (is (equal + (sql + (:with-recursive + (:as (:search-graph 'id 'link 'data'depth 'path 'cycle) + (:union-all + (:select 'g.id 'g.link 'g.data 1 + (:[] 'g.f1 'g.f2) nil + :from (:as 'graph 'g)) + (:select 'g.id 'g.link 'g.data (:= 'sg.depth 1) + (:|| 'path (:row 'g.f1 'g.f2)) + (:= (:row 'g.f1 'g.f2) + (:any* 'path)) + :from (:as 'graph 'g) + (:as 'search-graph 'sg) + :where (:and (:= 'g.id 'sg.link) + (:not 'cycle))))) + (:select '* :from 'search-graph))) + "WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS ((SELECT g.id, g.link, g.data, 1, (g.f1)[g.f2], false FROM graph AS g) union all (SELECT g.id, g.link, g.data, (sg.depth = 1), (path || row(g.f1, g.f2)), (row(g.f1, g.f2) = ANY(path)) FROM graph AS g, search_graph AS sg WHERE ((g.id = sg.link) and (not cycle))))(SELECT * FROM search_graph)")) + + ;; Aside from preventing cycles, the array value is often useful in its own right as representing the “path” taken to reach any particular row. + + (is (equal (sql + (:with-recursive + (:as 'children + (:union + (:select 'depended-on :from 'dependencies :where (:= 'depends-on '$1)) + (:select 'a.depended-on :from (:as 'dependencies 'a) + :inner-join (:as 'children 'b) + :on (:= 'a.depends-on 'b.depended-on)))) + (:select '* :from 'children))) + "WITH RECURSIVE children AS ((SELECT depended_on FROM dependencies WHERE (depends_on = $1)) union (SELECT a.depended_on FROM dependencies AS a INNER JOIN children AS b ON (a.depends_on = b.depended_on)))(SELECT * FROM children)")) + + + ;; https://www.postgresql.org/docs/current/static/sql-select.html + ;; This example uses WITH RECURSIVE to find all subordinates (direct or indirect) of the employee Mary, and their level of indirectness, from a table that shows only direct subordinates: + (is (equal (sql (:with-recursive + (:as (:employee-recursive 'distance 'employee-name 'manager-name) (:union-all - (:select 'sub-part 'part 'quantity - :from 'parts - :where (:= 'part "our-product")) - (:select 'p.sub-part 'p.part 'p.quantity - :from (:as 'included-parts 'pr) - (:as 'parts 'p) - :where (:= 'p.part 'pr.sub-part)))) - (:select 'sub-part (:as (:sum 'quantity) 'total-quantity) - :from 'included-parts - :group-by 'sub-part))) - "WITH RECURSIVE included_parts(sub_part, part, quantity) AS ((SELECT sub_part, part, quantity FROM parts WHERE (part = E'our-product')) union all (SELECT p.sub_part, p.part, p.quantity FROM included_parts AS pr, parts AS p WHERE (p.part = pr.sub_part)))(SELECT sub_part, SUM(quantity) AS total_quantity FROM included_parts GROUP BY sub_part)")) - - ;; This query will loop if the link relationships contain cycles. Because we require a “depth” output, just changing UNION ALL to UNION would not eliminate the looping. Instead we need to recognize whether we have reached the same row again while following a particular path of links. We add two columns path and cycle to the loop-prone query: - -;; In the general case where more than one field needs to be checked to recognize a cycle, use an array of rows. For example, if we needed to compare fields f1 and f2: - - (is (equal - (sql - (:with-recursive - (:as (:search-graph 'id 'link 'data'depth 'path 'cycle) - (:union-all - (:select 'g.id 'g.link 'g.data 1 - (:[] 'g.f1 'g.f2) nil - :from (:as 'graph 'g)) - (:select 'g.id 'g.link 'g.data (:= 'sg.depth 1) - (:|| 'path (:row 'g.f1 'g.f2)) - (:= (:row 'g.f1 'g.f2) - (:any* 'path)) - :from (:as 'graph 'g) - (:as 'search-graph 'sg) - :where (:and (:= 'g.id 'sg.link) - (:not 'cycle))))) - (:select '* :from 'search-graph))) - "WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS ((SELECT g.id, g.link, g.data, 1, (g.f1)[g.f2], false FROM graph AS g) union all (SELECT g.id, g.link, g.data, (sg.depth = 1), (path || row(g.f1, g.f2)), (row(g.f1, g.f2) = ANY(path)) FROM graph AS g, search_graph AS sg WHERE ((g.id = sg.link) and (not cycle))))(SELECT * FROM search_graph)")) - - ;; Aside from preventing cycles, the array value is often useful in its own right as representing the “path” taken to reach any particular row. - - (is (equal (sql - (:with (:as 'regional-sales (:select 'region (:as (:sum 'amount) 'total-sales) - :from 'orders :group-by 'region)) - (:as 'top-regions (:select 'region - :from 'regional-sales - :where (:> 'total-sales (:select (:/ (:sum 'total-sales) 10) - :from 'regional-sales)))) - (:select 'region 'product (:as (:sum 'quantity) 'product-units) - (:as (:sum 'amount) 'product-sales) - :from 'orders - :where (:in 'region (:select 'region :from 'top-regions)) - :group-by 'region 'product))) - "WITH regional_sales AS (SELECT region, SUM(amount) AS total_sales FROM orders GROUP BY region), top_regions AS (SELECT region FROM regional_sales WHERE (total_sales > (SELECT (SUM(total_sales) / 10) FROM regional_sales)))(SELECT region, product, SUM(quantity) AS product_units, SUM(amount) AS product_sales FROM orders WHERE (region IN (SELECT region FROM top_regions)) GROUP BY region, product)")) - - (is (equal (sql - (:with-recursive - (:as 'children - (:union - (:select 'depended-on :from 'dependencies :where (:= 'depends-on '$1)) - (:select 'a.depended-on :from (:as 'dependencies 'a) - :inner-join (:as 'children 'b) - :on (:= 'a.depends-on 'b.depended-on)))) - (:select '* :from 'children))) - "WITH RECURSIVE children AS ((SELECT depended_on FROM dependencies WHERE (depends_on = $1)) union (SELECT a.depended_on FROM dependencies AS a INNER JOIN children AS b ON (a.depends_on = b.depended_on)))(SELECT * FROM children)")) - - -;; https://www.postgresql.org/docs/current/static/sql-select.html -;; This example uses WITH RECURSIVE to find all subordinates (direct or indirect) of the employee Mary, and their level of indirectness, from a table that shows only direct subordinates: - (is (equal (sql (:with-recursive - (:as (:employee-recursive 'distance 'employee-name 'manager-name) - (:union-all - (:select 1 'employee-name 'manager-name :from 'employee :where (:= 'manager-name "Mary")) - (:select (:+ 'er.distance 1) 'e.employee-name 'e.manager-name - :from (:as 'employee-recursive 'er) (:as 'employee 'e) - :where (:= 'er.employee-name 'e.manager-name)))) - (:select 'distance 'employee-name :from 'employee-recursive))) -"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS ((SELECT 1, employee_name, manager_name FROM employee WHERE (manager_name = E'Mary')) union all (SELECT (er.distance + 1), e.employee_name, e.manager_name FROM employee_recursive AS er, employee AS e WHERE (er.employee_name = e.manager_name)))(SELECT distance, employee_name FROM employee_recursive)"))) + (:select 1 'employee-name 'manager-name + :from 'employee + :where (:= 'manager-name "Mary")) + (:select (:+ 'er.distance 1) 'e.employee-name 'e.manager-name + :from (:as 'employee-recursive 'er) (:as 'employee 'e) + :where (:= 'er.employee-name 'e.manager-name)))) + (:select 'distance 'employee-name :from 'employee-recursive))) + "WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS ((SELECT 1, employee_name, manager_name FROM employee WHERE (manager_name = E'Mary')) union all (SELECT (er.distance + 1), e.employee_name, e.manager_name FROM employee_recursive AS er, employee AS e WHERE (er.employee_name = e.manager_name)))(SELECT distance, employee_name FROM employee_recursive)"))) + +(test ordinality + (with-test-connection + (when (pomo:table-exists-p 'pets) + (execute (:drop-table 'pets :cascade))) + (query "CREATE TABLE pets(pet varchar(100) PRIMARY KEY, tags text[])") + (query "INSERT INTO pets(pet, tags) + VALUES ('dog', '{big, furry, friendly, eats steak}'::text[]), + ('cat', '{small, snob, eats greenbeans, plays with mouse}'::text[]), + ('mouse', '{very small, fits in pocket, eat peanuts, watches cat}'::text[]), + ('fish', NULL);") + + (is (equal (sql (:select '* + :from (:generate-series 4 1 -1) + :with-ordinality-as (:t1 'x 'y))) + "(SELECT * FROM generate_series(4, 1, -1) WITH ORDINALITY AS t1(x, y))")) + (is (equal (sql (:select '* + :from (:generate-series 4 1 -1) + :with-ordinality)) + "(SELECT * FROM generate_series(4, 1, -1) WITH ORDINALITY )")) + (is (equal (sql (:select '* + :from (:json-object-keys "{\"a1\":\"1\",\"a2\":\"2\",\"a3\":\"3\"}") + :with-ordinality-as (:t1 'keys 'n))) + "(SELECT * FROM json_object_keys(E'{\"a1\":\"1\",\"a2\":\"2\",\"a3\":\"3\"}') WITH ORDINALITY AS t1(keys, n))")) + + (is (equal + (sql (:limit (:select '* :from 'pets (:unnest 'tags) :with-ordinality) 3)) + "((SELECT * FROM pets, unnest(tags) WITH ORDINALITY ) LIMIT 3)")) + + (is (equal (sql (:select 'pet 'sort-order 'tag + :from 'pets + :left-join-lateral (:unnest 'tags) + :with-ordinality-as (:f 'tag 'sort-order) + :on (:= 1 1))) + "(SELECT pet, sort_order, tag FROM pets LEFT JOIN LATERAL unnest(tags) WITH ORDINALITY AS f(tag, sort_order) ON (1 = 1))")) + + (is (equal (sql (:select 't1.id 'a.elem 'a.nr + :from (:as 't12 't1) + :left-join (:unnest (:string-to-array 't1.elements ",")) + :with-ordinality + :on (:= 't1.id 'a.id) + :left-join 't14 + :on (:= 't2.id 'a.id))) + "(SELECT t1.id, a.elem, a.nr FROM t12 AS t1 LEFT JOIN unnest(string_to_array(t1.elements, E',')) WITH ORDINALITY ON (t1.id = a.id) LEFT JOIN t14 ON (t2.id = a.id))")) + + (is (equal (sql (:select 't1.id 'a.elem 'a.nr + :from (:as 't12 't1) + :left-join (:unnest (:string-to-array 't1.elements ",")) + :with-ordinality-as (:a 'elem 'nr) + :on (:= 1 1))) + "(SELECT t1.id, a.elem, a.nr FROM t12 AS t1 LEFT JOIN unnest(string_to_array(t1.elements, E',')) WITH ORDINALITY AS a(elem, nr) ON (1 = 1))")) + (is (equal (sql (:select 't1.id 'a.elem 'a.nr + :from (:as 't12 't1) + :left-join (:unnest (:string-to-array 't1.elements ",")) + :with-ordinality-as (:a 'elem 'nr) + :on 't)) + "(SELECT t1.id, a.elem, a.nr FROM t12 AS t1 LEFT JOIN unnest(string_to_array(t1.elements, E',')) WITH ORDINALITY AS a(elem, nr) ON true)")) + + (is (equal (sql (:select 'pet 'ordinality 'tag + :from 'pets + :left-join-lateral (:unnest 'tags) + :with-ordinality + :on (:= 1 1))) + "(SELECT pet, ordinality, tag FROM pets LEFT JOIN LATERAL unnest(tags) WITH ORDINALITY ON (1 = 1))")) + + (is (equal (query (:select 'pet 'sort-order 'tag + :from 'pets + :left-join-lateral (:unnest 'tags) + :with-ordinality-as (:f 'tag 'sort-order) + :on (:= 1 1))) + '(("dog" 1 "big") ("dog" 2 "furry") ("dog" 3 "friendly") ("dog" 4 "eats steak") + ("cat" 1 "small") ("cat" 2 "snob") ("cat" 3 "eats greenbeans") + ("cat" 4 "plays with mouse") ("mouse" 1 "very small") + ("mouse" 2 "fits in pocket") ("mouse" 3 "eat peanuts") + ("mouse" 4 "watches cat") ("fish" :NULL :NULL)))) + + (is (equal (query (:select 'pet 'sort-order 'tag + :from 'pets (:unnest 'tags) + :with-ordinality-as (:f 'tag 'sort-order))) + '(("dog" 1 "big") ("dog" 2 "furry") ("dog" 3 "friendly") ("dog" 4 "eats steak") + ("cat" 1 "small") ("cat" 2 "snob") ("cat" 3 "eats greenbeans") + ("cat" 4 "plays with mouse") ("mouse" 1 "very small") + ("mouse" 2 "fits in pocket") ("mouse" 3 "eat peanuts") + ("mouse" 4 "watches cat")))))) + +(test lateral + (is + (equal + (sql + (:select 'x 'y + :from (:as (:values (:set 1) (:set 2) (:set 3)) + (:t1 'x)) + :lateral (:generate-series 0 't.x) (:u 'y))) + "(SELECT x, y FROM (VALUES (1), (2), (3)) AS t1(x) , LATERAL generate_series(0, t.x), u(y))")) + (is + (equal + (sql + (:select '* + :from (:as 'tags 't1) + :join-lateral (:as + (:fetch + (:order-by + (:select 'm.* + :from (:as 'movies 'm) + :where (:= 'm.tag-id 't1.id)) + (:desc 'm.created-at)) + 2) + 'e1) + :on (:= 1 1))) + "(SELECT * FROM tags AS t1 JOIN LATERAL (((SELECT m.* FROM movies AS m WHERE (m.tag_id = t1.id)) ORDER BY m.created_at DESC) FETCH FIRST 2 ROWS ONLY) AS e1 ON (1 = 1))")) + (is (equal + (sql + (:select '* + :from (:as 'tags 't1) + :inner-join-lateral (:as + (:fetch + (:order-by + (:select 'm.* + :from (:as 'movies 'm) + :where (:= 'm.tag-id 't1.id)) + (:desc 'm.created-at)) + 2) + 'e1) + :on 't)) + "(SELECT * FROM tags AS t1 INNER JOIN LATERAL (((SELECT m.* FROM movies AS m WHERE (m.tag_id = t1.id)) ORDER BY m.created_at DESC) FETCH FIRST 2 ROWS ONLY) AS e1 ON true)")) + (is (equal + (sql + (:select '* + :from (:as 'tags 't1) + :lateral (:as + (:fetch + (:order-by + (:select 'm.* + :from (:as 'movies 'm) + :where (:= 'm.tag-id 't1.id)) + (:desc 'm.created-at)) + 2) + 'e1))) + "(SELECT * FROM tags AS t1 , LATERAL (((SELECT m.* FROM movies AS m WHERE (m.tag_id = t1.id)) ORDER BY m.created_at DESC) FETCH FIRST 2 ROWS ONLY) AS e1)")) + (is + (equal + (sql + (:select '* + :from (:as 'tags 't1) + :cross-join-lateral (:as + (:fetch + (:order-by + (:select 'm.* + :from (:as 'movies 'm) + :where (:= 'm.tag-id 't1.id)) + (:desc 'm.created-at)) + 2) + 'e1))) + "(SELECT * FROM tags AS t1 CROSS JOIN LATERAL (((SELECT m.* FROM movies AS m WHERE (m.tag_id = t1.id)) ORDER BY m.created_at DESC) FETCH FIRST 2 ROWS ONLY) AS e1)")) + (is + (equal + (sql + (:select 'p.* (:as 'dads.id 'dad-id) (:as 'moms.id 'mom-id) + :from (:as 'people 'p) + :left-join-lateral (:as (:select '* + :from 'people + :where (:and (:= 'gender "m") + (:= 'surname-1 'p.surname-1) + (:<> 'pack-id 'p.pack-id))) + 'dads) + :on 't + :left-join-lateral (:as (:select '* + :from 'people + :where (:and (:= 'gender "f") + (:= 'surname-1 'p.surname-2) + (:<> 'pack-id 'p.pack-id) + (:<> 'pack-id 'dads.pack-id))) + 'moms) + :on 't)) + "(SELECT p.*, dads.id AS dad_id, moms.id AS mom_id FROM people AS p LEFT JOIN LATERAL (SELECT * FROM people WHERE ((gender = E'm') and (surname_1 = p.surname_1) and (pack_id <> p.pack_id))) AS dads ON true LEFT JOIN LATERAL (SELECT * FROM people WHERE ((gender = E'f') and (surname_1 = p.surname_2) and (pack_id <> p.pack_id) and (pack_id <> dads.pack_id))) AS moms ON true)")) + (is + (equal + (sql + (:select 'geo.zipcode 'geo.state 'movie.name + :from 'geo + :cross-join-lateral + (:as + (:limit + (:order-by + (:select 'movie-name + :from 'streams + :where (:= 'geo.zipcode 'streams.zipcode)) + (:desc 'streams.country)) + 5) + (:movie 'name)))) + "(SELECT geo.zipcode, geo.state, movie.name FROM geo CROSS JOIN LATERAL (((SELECT movie_name FROM streams WHERE (geo.zipcode = streams.zipcode)) ORDER BY streams.country DESC) LIMIT 5) AS movie(name))")) + ;; the following borrowed from + ;; https://popsql.com/learn-sql/postgresql/how-to-use-lateral-joins-in-postgresql#data-set + (is + (equal + (sql + (:select 'pledged-usd 'avg-pledge-usd 'amt-from-goal 'duration + (:as (:/ 'usd-from-goal 'duration) 'usd-needed-daily) + :from 'kickstarter-data + :lateral (:as (:select (:as (:/ 'pledged 'fx-rate) + 'pledged-usd)) + 'pu) + :lateral (:as (:select (:as (:/ 'pledged-usd 'backers-count) + 'avg-pledge-usd)) + 'apu) + :lateral (:as (:select (:as (:/ 'goal 'fx-rate) + 'goal-usd)) + 'gu) + :lateral (:as (:select (:as (:- 'goal-usd 'pledged-usd) + 'usd-from-goal)) + 'ufg) + :lateral (:as (:select (:as (:/ (:- 'deadline 'launched-at) 86400.00) + 'duration)) + 'dr))) + "(SELECT pledged_usd, avg_pledge_usd, amt_from_goal, duration, (usd_from_goal / duration) AS usd_needed_daily FROM kickstarter_data , LATERAL (SELECT (pledged / fx_rate) AS pledged_usd) AS pu , LATERAL (SELECT (pledged_usd / backers_count) AS avg_pledge_usd) AS apu , LATERAL (SELECT (goal / fx_rate) AS goal_usd) AS gu , LATERAL (SELECT (goal_usd - pledged_usd) AS usd_from_goal) AS ufg , LATERAL (SELECT ((deadline - launched_at) / 86400.0) AS duration) AS dr)"))) (test insert-into - "Testing insert into" - (is (equal (sql (:insert-into 'cd.facilities - :set 'facid 9 'name "Spa" 'membercost 20 'guestcost 30 - 'initialoutlay 100000 'monthlymaintenance 800)) - "INSERT INTO cd.facilities (facid, name, membercost, guestcost, initialoutlay, monthlymaintenance) VALUES (9, E'Spa', 20, 30, 100000, 800)")) - -;; Testing with a calculation in the value - (is (equal (sql (:insert-into 'test - :set 'id 15 'number-string "12" 'numeric-item 12.45 - 'ratio-item (/ 1 13) 'created-at "2018-02-01")) - "INSERT INTO test (id, number_string, numeric_item, ratio_item, created_at) VALUES (15, E'12', 12.45, 0.0769230769230769230769230769230769230, E'2018-02-01')")) - - ;; Testing select - (is (equal (sql (:insert-into 'users - (:select (:uuid-generate-v4) "Lucie" - "Hawkins""Lucie-Jones@gmail.com"))) - "INSERT INTO users (SELECT uuid_generate_v4(), E'Lucie', E'Hawkins', E'Lucie-Jones@gmail.com')")) - (is (equal (sql (:insert-into 't6 (:select 'id :from 't5))) - "INSERT INTO t6 (SELECT id FROM t5)")) -;; Testing select in insert statement -;; From https://www.pgexercises.com/questions/updates/insert3.html - (is (equal (sql (:insert-into 'cd.facilities - :set 'facid - (:select (:+ (:select (:max 'facid) - :from 'cd.facilities) - 1)) - 'name "Spa" 'membercost 20 'guestcost 30 - 'initialoutlay 100000 'monthlymaintenance 800)) - "INSERT INTO cd.facilities (facid, name, membercost, guestcost, initialoutlay, monthlymaintenance) VALUES ((SELECT ((SELECT MAX(facid) FROM cd.facilities) + 1)), E'Spa', 20, 30, 100000, 800)")) -;; Testing overriding-user-value - (is (equal (sql (:insert-into 'employee - :set 'id 1 'name "Paul" - :overriding-user-value - :on-conflict-do-nothing)) - "INSERT INTO employee (id, name) OVERRIDING USER VALUE VALUES (1, E'Paul') ON CONFLICT DO NOTHING")) - ;; Testing overriding system-value - (is (equal (sql (:insert-into 'employee - :set 'id 1 'name "Paul" - :overriding-system-value - :on-conflict-do-nothing)) - "INSERT INTO employee (id, name) OVERRIDING SYSTEM VALUE VALUES (1, E'Paul') ON CONFLICT DO NOTHING"))) + "Testing insert into" + (is (equal (sql (:insert-into 'cd.facilities + :set 'facid 9 'name "Spa" 'membercost 20 'guestcost 30 + 'initialoutlay 100000 'monthlymaintenance 800)) + "INSERT INTO cd.facilities (facid, name, membercost, guestcost, initialoutlay, monthlymaintenance) VALUES (9, E'Spa', 20, 30, 100000, 800)")) + + ;; Testing with a calculation in the value + (is (equal (sql (:insert-into 'test + :set 'id 15 'number-string "12" 'numeric-item 12.45 + 'ratio-item (/ 1 13) 'created-at "2018-02-01")) + "INSERT INTO test (id, number_string, numeric_item, ratio_item, created_at) VALUES (15, E'12', 12.45, 0.0769230769230769230769230769230769230, E'2018-02-01')")) + + ;; Testing select + (is (equal + (sql (:insert-into 'users + (:select (:uuid-generate-v4) "Lucie" + "Hawkins""Lucie-Jones@gmail.com"))) + "INSERT INTO users (SELECT uuid_generate_v4(), E'Lucie', E'Hawkins', E'Lucie-Jones@gmail.com')")) + (is (equal (sql (:insert-into 't11 + :columns 'region 'subregion 'country + (:select (:as 'region-name 'region) + (:as 'sub-region-name 'subregion) + 'country + :from 'regions))) + "INSERT INTO t11 (region, subregion, country) (SELECT region_name AS region, sub_region_name AS subregion, country FROM regions)")) + (is (equal (sql (:insert-into 't6 (:select 'id :from 't5))) + "INSERT INTO t6 (SELECT id FROM t5)")) + ;; Testing select in insert statement + ;; From https://www.pgexercises.com/questions/updates/insert3.html + (is (equal (sql (:insert-into 'cd.facilities + :set 'facid + (:select (:+ (:select (:max 'facid) + :from 'cd.facilities) + 1)) + 'name "Spa" 'membercost 20 'guestcost 30 + 'initialoutlay 100000 'monthlymaintenance 800)) + "INSERT INTO cd.facilities (facid, name, membercost, guestcost, initialoutlay, monthlymaintenance) VALUES ((SELECT ((SELECT MAX(facid) FROM cd.facilities) + 1)), E'Spa', 20, 30, 100000, 800)")) + ;; Testing overriding-user-value + (is (equal (sql (:insert-into 'employee + :set 'id 1 'name "Paul" + :overriding-user-value + :on-conflict-do-nothing)) + "INSERT INTO employee (id, name) OVERRIDING USER VALUE VALUES (1, E'Paul') ON CONFLICT DO NOTHING")) + ;; Testing overriding system-value + (is (equal (sql (:insert-into 'employee + :set 'id 1 'name "Paul" + :overriding-system-value + :on-conflict-do-nothing)) + "INSERT INTO employee (id, name) OVERRIDING SYSTEM VALUE VALUES (1, E'Paul') ON CONFLICT DO NOTHING"))) (test insert-into-on-conflict-do-nothing (is (equal (sql (:insert-into 'distributors @@ -1422,17 +1931,18 @@ To sum the column len of all films and group the results by kind:" (test insert-into-on-conflict-update ;; Testing On Conflict update - (is (equal (sql (:insert-into 'test-table - :set 'column-A '$1 'column-B '$2 - :on-conflict-update 'column-A - :update-set 'column-B '$2 - :where (:= 'test-table.column-A '$1))) - "INSERT INTO test_table (column_a, column_b) VALUES ($1, $2) ON CONFLICT (column_a) DO UPDATE SET column_b = $2 WHERE (test_table.column_a = $1)")) - ;; basic version single row - (is (equal (sql (:insert-into 'users - (:select (:uuid-generate-v4) "Lucie" "Hawkins" "Lucie-Jones@gmail.com") - :on-conflict-update 'email - :update-set 'first-name 'excluded.first-name 'last-name 'excluded.last-name)) + (is (equal (sql (:insert-into 'test-table + :set 'column-A '$1 'column-B '$2 + :on-conflict-update 'column-A + :update-set 'column-B '$2 + :where (:= 'test-table.column-A '$1))) + "INSERT INTO test_table (column_a, column_b) VALUES ($1, $2) ON CONFLICT (column_a) DO UPDATE SET column_b = $2 WHERE (test_table.column_a = $1)")) + ;; basic version single row + (is (equal + (sql (:insert-into 'users + (:select (:uuid-generate-v4) "Lucie" "Hawkins" "Lucie-Jones@gmail.com") + :on-conflict-update 'email + :update-set 'first-name 'excluded.first-name 'last-name 'excluded.last-name)) "INSERT INTO users (SELECT uuid_generate_v4(), E'Lucie', E'Hawkins', E'Lucie-Jones@gmail.com') ON CONFLICT (email) DO UPDATE SET first_name = excluded.first_name, last_name = excluded.last_name")) ;; Basic version multiple row and specified columns (is (equal (sql (:insert-into 'distributors @@ -1441,18 +1951,20 @@ To sum the column len of all films and group the results by kind:" :update-set 'dname 'excluded.dname)) "INSERT INTO distributors (did, dname) VALUES (5, E'Gizmo Transglobal') ON CONFLICT (did) DO UPDATE SET dname = excluded.dname")) ;; with where clause - (is (equal (sql (:insert-into 'users - (:select (:uuid-generate-v4) "Lucie" "Hawkins" "Lucie-Jones@gmail.com") - :on-conflict-update 'email - :update-set 'first-name 'excluded.first-name 'last-name 'excluded.last-name - :where (:<> 'u.first-name "Lucie"))) + (is (equal + (sql (:insert-into 'users + (:select (:uuid-generate-v4) "Lucie" "Hawkins" "Lucie-Jones@gmail.com") + :on-conflict-update 'email + :update-set 'first-name 'excluded.first-name 'last-name 'excluded.last-name + :where (:<> 'u.first-name "Lucie"))) "INSERT INTO users (SELECT uuid_generate_v4(), E'Lucie', E'Hawkins', E'Lucie-Jones@gmail.com') ON CONFLICT (email) DO UPDATE SET first_name = excluded.first_name, last_name = excluded.last_name WHERE (u.first_name <> E'Lucie')")) ;; with concatenation function in the update-set clause - (is (equal (sql (:insert-into 'distributors - :set 'did 8 'dname "Anvil Distribution" - :on-conflict-update 'did - :update-set 'dname (:|| 'excluded.dname " (formerly " 'd.dname ")") - :where (:<> 'd.zipcode "21201"))) + (is (equal + (sql (:insert-into 'distributors + :set 'did 8 'dname "Anvil Distribution" + :on-conflict-update 'did + :update-set 'dname (:|| 'excluded.dname " (formerly " 'd.dname ")") + :where (:<> 'd.zipcode "21201"))) "INSERT INTO distributors (did, dname) VALUES (8, E'Anvil Distribution') ON CONFLICT (did) DO UPDATE SET dname = (excluded.dname || E' (formerly ' || d.dname || E')') WHERE (d.zipcode <> E'21201')")) ;; with on-conflict-on-constraint (is (equal (sql (:insert-into 'test @@ -1467,7 +1979,7 @@ To sum the column len of all films and group the results by kind:" :update-set 'some-val 'excluded.some-val :returning '*)) "INSERT INTO test (some_key, some_val) VALUES (E'a', 2) ON CONFLICT ON CONSTRAINT somekey DO UPDATE SET some_val = excluded.some_val RETURNING *")) -;; on-conflict-on-constraint with addition function in the update-set clause + ;; on-conflict-on-constraint with addition function in the update-set clause (is (equal (sql (:insert-into 'test :set 'some-key "a" :on-conflict-on-constraint 'somekey @@ -1476,20 +1988,20 @@ To sum the column len of all films and group the results by kind:" ;; with select clause which returns a single row (is (equal (sql (:insert-into 'attendence :set 'event-id (:select 'id - :from 'event + :from 'event :where (:= (:lower 'event-dt) "2020-01-11 17:00:00")) - 'client-id 3 'attend-status "No Show" + 'client-id 3 'attend-status "No Show" :on-conflict-on-constraint 'attendance-pkey :update-set 'attend-status 'excluded.attend_status)) "INSERT INTO attendence (event_id, client_id, attend_status) VALUES ((SELECT id FROM event WHERE (lower(event_dt) = E'2020-01-11 17:00:00')), 3, E'No Show') ON CONFLICT ON CONSTRAINT attendance_pkey DO UPDATE SET attend_status = excluded.attend_status"))) (test insert-rows-into -;; Testing basic inserting-rows-into + ;; Testing basic inserting-rows-into (is (equal (sql (:insert-rows-into 'my-table :values '((42 "foobar") (23 "foobaz")))) "INSERT INTO my_table VALUES (42, E'foobar'), (23, E'foobaz')")) -;; Testing columns -;; From https://www.pgexercises.com/questions/updates/insert2.html + ;; Testing columns + ;; From https://www.pgexercises.com/questions/updates/insert2.html (is (equal (sql (:insert-rows-into 'cd.facilities :columns 'facid 'name 'membercost 'guestcost 'initialoutlay 'monthlymaintenance :values '((9 "Spa" 20 30 100000 800) (10 "Squash Court 2" 3.5 17.5 5000 80)))) @@ -1500,9 +2012,9 @@ To sum the column len of all films and group the results by kind:" :values '(((:select 'id :from 't5))))) "INSERT INTO t6 (tags) VALUES ((SELECT id FROM t5))")) -;; Now using rows https://www.pgexercises.com/questions/updates/insert3.html + ;; Now using rows https://www.pgexercises.com/questions/updates/insert3.html (is (equal (sql (:insert-rows-into 'cd.facilities - :columns 'facid 'name 'membercost 'guestcost 'initialoutlay 'monthlymaintenance + :columns 'facid 'name 'membercost 'guestcost 'initialoutlay 'monthlymaintenance :values '(((:select (:+ (:select (:max 'facid) :from 'cd.facilities) 1)) @@ -1515,17 +2027,17 @@ To sum the column len of all films and group the results by kind:" "INSERT INTO table1 (c1, c2) OVERRIDING SYSTEM VALUE VALUES (1, E'a'), (2, E'b')"))) (test insert-rows-into-on-conflict-do-nothing -;; Testing inserting rows with on conflict do nothing + ;; Testing inserting rows with on conflict do nothing (is (equal (sql (:insert-rows-into 'distributors :columns 'did 'dname :values '((7 "Readline GmbH")) :on-conflict-do-nothing)) "INSERT INTO distributors (did, dname) VALUES (7, E'Readline GmbH') ON CONFLICT DO NOTHING")) -;; basic :on-conflict with separate :do-nothing keyword + ;; basic :on-conflict with separate :do-nothing keyword (is (equal (sql (:insert-rows-into 'test :columns 'some-key 'some-val - :values '(("a" 5) ("b" 6) ("c" 7)) - :on-conflict 'some-key - :do-nothing)) + :values '(("a" 5) ("b" 6) ("c" 7)) + :on-conflict 'some-key + :do-nothing)) "INSERT INTO test (some_key, some_val) VALUES (E'a', 5), (E'b', 6), (E'c', 7) ON CONFLICT (some_key) DO NOTHING ")) ;; With where condition (is (equal (sql (:insert-rows-into 'distributors @@ -1535,34 +2047,34 @@ To sum the column len of all films and group the results by kind:" :do-nothing :where 'is-active)) "INSERT INTO distributors (did, dname) VALUES (10, E'Conrad International') ON CONFLICT (did) WHERE is_active DO NOTHING ")) -;; With returning + ;; With returning (is (equal (sql (:insert-rows-into 'distributors :columns 'did 'dname - :values '((8 "Readline GmbH")) - :on-conflict 'did 'dname - :do-nothing - :returning 'id)) + :values '((8 "Readline GmbH")) + :on-conflict 'did 'dname + :do-nothing + :returning 'id)) "INSERT INTO distributors (did, dname) VALUES (8, E'Readline GmbH') ON CONFLICT (did, dname) DO NOTHING RETURNING id")) ;; With on-conflict-on-constraint and do-nothing as a separate operator (is (equal (sql (:insert-rows-into 'distributors :columns 'did 'dname - :values '((10 "Readline GmbH")) - :on-conflict-on-constraint 'distributors-pkey - :do-nothing - :returning 'id)) + :values '((10 "Readline GmbH")) + :on-conflict-on-constraint 'distributors-pkey + :do-nothing + :returning 'id)) "INSERT INTO distributors (did, dname) VALUES (10, E'Readline GmbH') ON CONFLICT ON CONSTRAINT distributors_pkey DO NOTHING RETURNING id")) ;; basic :on-conflict with separate :do-nothing keyword and returning (is (equal (sql (:insert-rows-into 'test :columns 'some-key 'some-val - :values '(("a" 4) ("b" 6) ("c" 7)) - :on-conflict 'some-key - :do-nothing - :returning '*)) + :values '(("a" 4) ("b" 6) ("c" 7)) + :on-conflict 'some-key + :do-nothing + :returning '*)) "INSERT INTO test (some_key, some_val) VALUES (E'a', 4), (E'b', 6), (E'c', 7) ON CONFLICT (some_key) DO NOTHING RETURNING *")) ;; multiple values basic :on-conflict-on-constraint with separate :do-nothing keyword and returning (is (equal (sql (:insert-rows-into 'test :columns 'some-key 'some-val - :values '(("a" 3) ("b" 6) ("c" 7)) - :on-conflict-on-constraint 'somekey - :do-nothing - :returning '*)) + :values '(("a" 3) ("b" 6) ("c" 7)) + :on-conflict-on-constraint 'somekey + :do-nothing + :returning '*)) "INSERT INTO test (some_key, some_val) VALUES (E'a', 3), (E'b', 6), (E'c', 7) ON CONFLICT ON CONSTRAINT somekey DO NOTHING RETURNING *"))) (test insert-rows-into-on-conflict-update @@ -1617,7 +2129,7 @@ To sum the column len of all films and group the results by kind:" :update-set 'some-val 'excluded.some-val :returning '*)) "INSERT INTO test (some_key, some_val) VALUES (E'a', 2), (E'b', 6), (E'c', 7) ON CONFLICT ON CONSTRAINT somekey DO UPDATE SET some_val = excluded.some_val RETURNING *")) -;; on-conflict-on-constraint with addition function in the update-set clause + ;; on-conflict-on-constraint with addition function in the update-set clause (is (equal (sql (:insert-rows-into 'test :columns 'some-key :values '(("a")) @@ -1631,55 +2143,115 @@ To sum the column len of all films and group the results by kind:" :where (:= (:lower 'event-dt) "2020-01-11 17:00:00")) 3 "No Show")) - :on-conflict-on-constraint 'attendance-pkey + :on-conflict-on-constraint 'attendance-pkey :update-set 'attend-status 'excluded.attend_status)) "INSERT INTO attendence (event_id, client_id, attend_status) VALUES ((SELECT id FROM event WHERE (lower(event_dt) = E'2020-01-11 17:00:00')), 3, E'No Show') ON CONFLICT ON CONSTRAINT attendance_pkey DO UPDATE SET attend_status = excluded.attend_status"))) (test update - "Testing updates" -;; From https://www.pgexercises.com/questions/updates/update.html - (is (equal (sql (:update 'cd.facilities :set 'initialoutlay 10000 :where (:= 'facid 1))) - "UPDATE cd.facilities SET initialoutlay = 10000 WHERE (facid = 1)")) -;; From https://www.pgexercises.com/questions/updates/updatemultiple.html - (is (equal (sql (:update 'cd.facilities :set 'membercost 6 'guestcost 30 :where (:in 'facid (:set 0 1)))) - "UPDATE cd.facilities SET membercost = 6, guestcost = 30 WHERE (facid IN (0, 1))")) - ;; From https://www.pgexercises.com/questions/updates/updatecalculated.html - (is (equal (sql (:update (:as 'cd.facilities 'facs) - :set 'membercost (:select (:* 'membercost 1.1) - :from 'cd.facilities - :where (:= 'facid 0)) - 'guestcost (:select (:* 'guestcost 1.1) - :from 'cd.facilities - :where (:= 'facid 0)) - :where (:= 'facs.facid 1))) - "UPDATE cd.facilities AS facs SET membercost = (SELECT (membercost * 1.1) FROM cd.facilities WHERE (facid = 0)), guestcost = (SELECT (guestcost * 1.1) FROM cd.facilities WHERE (facid = 0)) WHERE (facs.facid = 1)")) - - ;; Version 2 - (is (equal (sql (:update (:as 'cd.facilities 'facs) - :set 'membercost (:* 'facs2.membercost 1.1) - 'guestcost (:* 'facs2.guestcost 1.1) - :from (:as (:select '* - :from 'cd.facilities - :where (:= 'facid 0)) - 'facs2) - :where (:= 'facs.facid 1))) - - "UPDATE cd.facilities AS facs SET membercost = (facs2.membercost * 1.1), guestcost = (facs2.guestcost * 1.1) FROM (SELECT * FROM cd.facilities WHERE (facid = 0)) AS facs2 WHERE (facs.facid = 1)"))) + "Testing updates" + ;; From Postgresql documentation https://www.postgresql.org/docs/current/sql-update.html + (is (equal (sql (:update 'films :set 'kind "Dramatic" :where (:= 'kind "Drama"))) + "UPDATE films SET kind = E'Dramatic' WHERE (kind = E'Drama')")) + (is (equal (sql (:update 'weather + :set 'temp-lo (:+ 'temp-lo 1) 'temp-hi (:+ 'temp-lo 15) 'prcp :default + :where (:and (:= 'city "San Francisco") + (:= 'date "2003-07-03")))) + "UPDATE weather SET temp_lo = (temp_lo + 1), temp_hi = (temp_lo + 15), prcp = DEFAULT WHERE ((city = E'San Francisco') and (date = E'2003-07-03'))")) + (is (equal (sql (:update 'weather + :set 'temp-lo (:+ 'temp-lo 1) 'temp-hi (:+ 'temp-lo 15) 'prcp :default + :where (:and (:= 'city "San Francisco") (:= 'date "2003-07-03")) + :returning 'temp-lo 'temp-hi 'prcp)) + "UPDATE weather SET temp_lo = (temp_lo + 1), temp_hi = (temp_lo + 15), prcp = DEFAULT WHERE ((city = E'San Francisco') and (date = E'2003-07-03')) RETURNING temp_lo, temp_hi, prcp")) + (is (equal (sql (:update 'weather + :columns 'temp-lo 'temp-hi 'prcp + (:set (:+ 'temp-lo 1) (:+ 'temp-lo 15) :DEFAULT) + :where (:and (:= 'city "San Francisco") + (:= 'date "2003-07-03")))) + "UPDATE weather SET (temp_lo, temp_hi, prcp) = ((temp_lo + 1), (temp_lo + 15), DEFAULT ) WHERE ((city = E'San Francisco') and (date = E'2003-07-03'))")) + (is (equal (sql (:update'employees :set 'sales-count (:+ 'sales-count 1) + :from 'accounts + :where (:and (:= 'accounts.name "Acme Corporation") + (:= 'employees.id 'accounts.sales-person)))) + "UPDATE employees SET sales_count = (sales_count + 1) FROM accounts WHERE ((accounts.name = E'Acme Corporation') and (employees.id = accounts.sales_person))")) + (is (equal (sql (:update 'employees :set 'sales-count (:+ 'sales-count 1) + :where (:= 'id (:select 'sales-person + :from 'accounts + :where (:= 'name "Acme Corporation"))))) + "UPDATE employees SET sales_count = (sales_count + 1) WHERE (id = (SELECT sales_person FROM accounts WHERE (name = E'Acme Corporation')))")) + (is (equal (sql (:update 't1 :columns 'database-name 'encoding + (:select 'x.datname 'x.encoding + :from (:as 'pg-database 'x) + :where (:= 'x.oid 't1.oid)))) + "UPDATE t1 SET (database_name, encoding) = (SELECT x.datname, x.encoding FROM pg_database AS x WHERE (x.oid = t1.oid))")) + (is (equal (sql (:update 'accounts + :columns 'contact-first-name 'contact-last-name + (:select 'first-name 'last-name + :from 'salesmen + :where (:= 'salesman.id 'accounts.sales-id)))) + "UPDATE accounts SET (contact_first_name, contact_last_name) = (SELECT first_name, last_name FROM salesmen WHERE (salesman.id = accounts.sales_id))")) + (is (equal (sql (:update 'accounts + :set 'contact-first-name 'first-name 'contact-last-name 'last-name + :from 'salesmen + :where (:= 'salesmen.id 'accounts.sales-id))) + "UPDATE accounts SET contact_first_name = first_name, contact_last_name = last_name FROM salesmen WHERE (salesmen.id = accounts.sales_id)")) + (is (equal (sql (:update (:as 'summary 's) + :columns 'sum-x 'sum-y 'avg-x 'avg-y + (:select (:sum 'x) (:sum 'y) (:avg 'x) (:avg 'y) + :from (:as 'data 'd) + :where (:= 'd.group-id 's.group-id)))) + "UPDATE summary AS s SET (sum_x, sum_y, avg_x, avg_y) = (SELECT SUM(x), SUM(y), AVG(x), AVG(y) FROM data AS d WHERE (d.group_id = s.group_id))")) + + ;; From https://www.pgexercises.com/questions/updates/update.html + (is (equal (sql (:update 'cd.facilities + :set 'initialoutlay 10000 + :where (:= 'facid 1))) + "UPDATE cd.facilities SET initialoutlay = 10000 WHERE (facid = 1)")) + ;; From https://www.pgexercises.com/questions/updates/updatemultiple.html + (is (equal (sql (:update 'cd.facilities + :set 'membercost 6 'guestcost 30 + :where (:in 'facid (:set 0 1)))) + "UPDATE cd.facilities SET membercost = 6, guestcost = 30 WHERE (facid IN (0, 1))")) + ;; From https://www.pgexercises.com/questions/updates/updatecalculated.html + (is (equal (sql (:update (:as 'cd.facilities 'facs) + :set 'membercost (:select (:* 'membercost 1.1) + :from 'cd.facilities + :where (:= 'facid 0)) + 'guestcost (:select (:* 'guestcost 1.1) + :from 'cd.facilities + :where (:= 'facid 0)) + :where (:= 'facs.facid 1))) + "UPDATE cd.facilities AS facs SET membercost = (SELECT (membercost * 1.1) FROM cd.facilities WHERE (facid = 0)), guestcost = (SELECT (guestcost * 1.1) FROM cd.facilities WHERE (facid = 0)) WHERE (facs.facid = 1)")) + + ;; Version 2 + (is (equal + (sql (:update (:as 'cd.facilities 'facs) + :set 'membercost (:* 'facs2.membercost 1.1) + 'guestcost (:* 'facs2.guestcost 1.1) + :from (:as (:select '* + :from 'cd.facilities + :where (:= 'facid 0)) + 'facs2) + :where (:= 'facs.facid 1))) + + "UPDATE cd.facilities AS facs SET membercost = (facs2.membercost * 1.1), guestcost = (facs2.guestcost * 1.1) FROM (SELECT * FROM cd.facilities WHERE (facid = 0)) AS facs2 WHERE (facs.facid = 1)"))) (test delete - "Testing deletes" - (is (equal (sql (:delete-from 'cd.bookings :where (:= 'id 5))) - "DELETE FROM cd.bookings WHERE (id = 5)")) - ;; From https://www.pgexercises.com/questions/updates/deletewh2.html - (is (equal (sql (:delete-from 'cd.members - :where (:not (:in 'memid (:select 'memid :from 'cd.bookings))))) - "DELETE FROM cd.members WHERE (not (memid IN (SELECT memid FROM cd.bookings)))")) - - (is (equal (sql (:delete-from (:as 'cd.members 'mems) - :where (:not (:exists (:select 1 - :from 'cd.bookings - :where (:= 'memid 'mems.memid)))))) - "DELETE FROM cd.members AS mems WHERE (not (EXISTS (SELECT 1 FROM cd.bookings WHERE (memid = mems.memid))))"))) + "Testing deletes" + (is (equal + (sql (:delete-from 'cd.bookings :where (:= 'id 5))) + "DELETE FROM cd.bookings WHERE (id = 5)")) + ;; From https://www.pgexercises.com/questions/updates/deletewh2.html + (is (equal + (sql (:delete-from 'cd.members + :where (:not (:in 'memid (:select 'memid :from 'cd.bookings))))) + "DELETE FROM cd.members WHERE (not (memid IN (SELECT memid FROM cd.bookings)))")) + + (is (equal + (sql (:delete-from (:as 'cd.members 'mems) + :where (:not (:exists (:select 1 + :from 'cd.bookings + :where (:= 'memid 'mems.memid)))))) + "DELETE FROM cd.members AS mems WHERE (not (EXISTS (SELECT 1 FROM cd.bookings WHERE (memid = mems.memid))))"))) (test truncate "Testing Truncate" @@ -1701,7 +2273,7 @@ To sum the column len of all films and group the results by kind:" Here is an example of a function with an ordinality column added: -SELECT * FROM unnest(ARRAY['a','b','c','d','e','f']) WITH ORDINALITY; +SELECT * FROM unnest(ARRAY['a','b','c','d','e','f']) WITHORD INALITY; https://www.postgresql.org/docs/current/static/sql-select.html @@ -1718,57 +2290,63 @@ FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true; |# (test dissect-type-0 - "Testing dissect-type" - (multiple-value-bind (type null?) - (s-sql::dissect-type 'char) - (is (eq type 'char)) - (is (not null?)))) + "Testing dissect-type" + (multiple-value-bind (type null?) + (s-sql::dissect-type 'char) + (is (eq type 'char)) + (is (not null?)))) (test dissect-type-1 - "Testing dissect-type" - (multiple-value-bind (type null?) - (s-sql::dissect-type '(or char db-null)) - (is (eq type 'char)) - (is (equal null? t)))) + "Testing dissect-type" + (multiple-value-bind (type null?) + (s-sql::dissect-type '(or char db-null)) + (is (eq type 'char)) + (is (equal null? t)))) (test dissect-type-2 - "Testing dissect-type" - (multiple-value-bind (type null?) - (s-sql::dissect-type '(or "char(5)" db-null)) - (is (equal type "char(5)")) - (is (eq null? t)))) + "Testing dissect-type" + (multiple-value-bind (type null?) + (s-sql::dissect-type '(or "char(5)" db-null)) + (is (equal type "char(5)")) + (is (eq null? t)))) (test create-index - "Testing create-index. Available parameters - in order after name - are :concurrently, :on, :using, :fields -and :where.The advantage to using the keyword :concurrently is that writes to the table + "Testing create-index. Available parameters - in order after name - +are :concurrently, :on, :using, :fields and :where.The advantage to using the +keyword :concurrently is that writes to the table from other sessions are not locked out while the index is is built. The disadvantage is that the table will need to be scanned twice. Everything is a trade-off." - (is (equal (sql (:create-index 'films_idx :on 'films :fields 'title)) - "CREATE INDEX films_idx ON films (title)")) - (is (equal (sql (:create-index 'films-idx :on "films" :fields 'title)) - "CREATE INDEX films_idx ON films (title)")) - (is (equal (sql (:create-index 'films-idx :on "films" :fields 'title 'id)) - "CREATE INDEX films_idx ON films (title, id)")) - (is (equal (sql (:create-index 'films_idx :on "films" :using gin :fields 'title)) - "CREATE INDEX films_idx ON films USING gin (title)")) - (is (equal (sql (:create-index 'doc-tags-id-tags :on "doc-tags-array" :using gin :fields 'tags)) - "CREATE INDEX doc_tags_id_tags ON doc_tags_array USING gin (tags)")) - (is (equal (sql (:create-unique-index 'doc-tags-id-doc-id :on "doc-tags-array" :fields 'doc-id)) - "CREATE UNIQUE INDEX doc_tags_id_doc_id ON doc_tags_array (doc_id)")) - (is (equal (sql (:create-index 'films-idx :concurrently :on "films" :using 'btree :fields 'created-at)) - "CREATE INDEX CONCURRENTLY films_idx ON films USING btree (created_at)")) - (is (equal (sql (:create-index 'films-idx :unique :concurrently :on "films" :using 'btree :fields 'created-at)) - "CREATE UNIQUE INDEX CONCURRENTLY films_idx ON films USING btree (created_at)")) - (is (equal (sql (:create-index (:if-not-exists 'test-uniq-1-idx) :on test-uniq :fields 'name)) - "CREATE INDEX IF NOT EXISTS test_uniq_1_idx ON test_uniq (name)")) - (with-test-connection - (query (:drop-table :if-exists 'george :cascade)) - (is (eq (table-exists-p 'george) nil)) - (query (:create-table 'george ((id :type integer)))) - (is (eq (table-exists-p 'george) t)) - (query (:create-index 'george-idx :on 'george :fields 'id)) - (is (pomo:index-exists-p 'george-idx)) - (is (pomo:index-exists-p "george-idx")))) + (is (equal (sql (:create-index 'films_idx :on 'films :fields 'title)) + "CREATE INDEX films_idx ON films (title)")) + (is (equal (sql (:create-index 'films-idx :on "films" :fields 'title)) + "CREATE INDEX films_idx ON films (title)")) + (is (equal (sql (:create-index 'films-idx :on "films" :fields 'title 'id)) + "CREATE INDEX films_idx ON films (title, id)")) + (is (equal (sql (:create-index 'films_idx :on "films" :using gin :fields 'title)) + "CREATE INDEX films_idx ON films USING gin (title)")) + (is (equal (sql (:create-index 'doc-tags-id-tags + :on "doc-tags-array" :using gin :fields 'tags)) + "CREATE INDEX doc_tags_id_tags ON doc_tags_array USING gin (tags)")) + (is (equal (sql (:create-unique-index 'doc-tags-id-doc-id + :on "doc-tags-array" :fields 'doc-id)) + "CREATE UNIQUE INDEX doc_tags_id_doc_id ON doc_tags_array (doc_id)")) + (is (equal (sql (:create-index 'films-idx :concurrently + :on "films" :using 'btree :fields 'created-at)) + "CREATE INDEX CONCURRENTLY films_idx ON films USING btree (created_at)")) + (is (equal (sql (:create-index 'films-idx :unique :concurrently :on "films" + :using 'btree :fields 'created-at)) + "CREATE UNIQUE INDEX CONCURRENTLY films_idx ON films USING btree (created_at)")) + (is (equal (sql (:create-index (:if-not-exists 'test-uniq-1-idx) + :on test-uniq :fields 'name)) + "CREATE INDEX IF NOT EXISTS test_uniq_1_idx ON test_uniq (name)")) + (with-test-connection + (query (:drop-table :if-exists 'george :cascade)) + (is (eq (table-exists-p 'george) nil)) + (query (:create-table 'george ((id :type integer)))) + (is (eq (table-exists-p 'george) t)) + (query (:create-index 'george-idx :on 'george :fields 'id)) + (is (pomo:index-exists-p 'george-idx)) + (is (pomo:index-exists-p "george-idx")))) (test create-view @@ -1809,54 +2387,90 @@ that the table will need to be scanned twice. Everything is a trade-off." (execute (:drop-table 'iceland-cities :cascade))) (query (:create-table 'iceland-cities ((id :type serial) - (name :type (or (varchar 100) db-null) :unique t)))) - - (query (:create-table 'from-test-data1 - ((id :type serial) - (flight :type (or integer db-null)) - (from :type (or (varchar 100) db-null) :references ((iceland-cities name))) - (to-destination :type (or (varchar 100) db-null))) - (:primary-key id) - (:constraint iceland-city-name-fkey :foreign-key (to-destination) (iceland-cities name)))) + (name :type (or (varchar 100) db-null) + :unique t)))) + (query + (:create-table 'from-test-data1 + ((id :type serial) + (flight :type (or integer db-null)) + (from :type (or (varchar 100) db-null) + :references ((iceland-cities name))) + (to-destination :type (or (varchar 100) db-null))) + (:primary-key id) + (:constraint iceland-city-name-fkey + :foreign-key (to-destination) (iceland-cities name)))) (query (:insert-into 'iceland-cities :set 'name "Reykjavík")) - (query (:insert-rows-into 'iceland-cities :columns 'name :values '(("Seyðisfjörður") ("Stykkishólmur") ("Bolungarvík") - ("Kópavogur")))) + (query (:insert-rows-into 'iceland-cities + :columns 'name + :values '(("Seyðisfjörður") ("Stykkishólmur") ("Bolungarvík") + ("Kópavogur")))) ;; test insert-into - (query (:insert-into 'from-test-data1 :set 'flight 1 'from "Reykjavík" 'to-destination "Seyðisfjörður")) + (query (:insert-into 'from-test-data1 + :set 'flight 1 'from "Reykjavík" 'to-destination "Seyðisfjörður")) ;; test query select - (is (equal (query (:select 'from 'to-destination :from 'from-test-data1 :where (:= 'flight 1)) :row) + (is (equal (query (:select 'from 'to-destination + :from 'from-test-data1 + :where (:= 'flight 1)) + :row) '("Reykjavík" "Seyðisfjörður"))) - (is (equal (query (:select 'flight :from 'from-test-data1 :where (:and (:= 'from "Reykjavík") - (:= 'to-destination "Seyðisfjörður"))) :single) + (is (equal (query (:select 'flight + :from 'from-test-data1 + :where (:and (:= 'from "Reykjavík") + (:= 'to-destination "Seyðisfjörður"))) + :single) 1)) ;; test insert-rows-into - (query (:insert-rows-into 'from-test-data1 :columns 'flight 'from 'to-destination :values '((2 "Stykkishólmur" "Reykjavík")))) - (is (equal (query (:select 'from 'to-destination :from 'from-test-data1 :where (:= 'flight 2)) :row) + (query (:insert-rows-into 'from-test-data1 + :columns 'flight 'from 'to-destination + :values '((2 "Stykkishólmur" "Reykjavík")))) + (is (equal (query (:select 'from 'to-destination + :from 'from-test-data1 + :where (:= 'flight 2)) + :row) '("Stykkishólmur" "Reykjavík"))) - (is (equal (query (:select 'flight :from 'from-test-data1 :where (:and (:= 'from "Stykkishólmur") - (:= 'to-destination "Reykjavík"))) :single) + (is (equal (query (:select 'flight + :from 'from-test-data1 + :where (:and (:= 'from "Stykkishólmur") + (:= 'to-destination "Reykjavík"))) + :single) 2)) (query (:alter-table 'from-test-data1 :rename-column 'from 'origin)) - (is (equal (query (:select 'flight :from 'from-test-data1 :where (:= 'origin "Stykkishólmur")) :single) + (is (equal (query (:select 'flight + :from 'from-test-data1 + :where (:= 'origin "Stykkishólmur")) + :single) 2)) ;; test alter-table (query (:alter-table 'from-test-data1 :rename-column 'origin 'from )) - (is (equal (query (:select 'flight :from 'from-test-data1 :where (:and (:= 'from "Stykkishólmur") - (:= 'to-destination "Reykjavík"))) :single) + (is (equal (query (:select 'flight + :from 'from-test-data1 + :where (:and (:= 'from "Stykkishólmur") + (:= 'to-destination "Reykjavík"))) + :single) 2)) ;; test constraint - (signals error (query (:insert-into 'from-test-data1 :set 'flight 1 'from "Reykjavík" 'to-destination "Akureyri"))) - (signals error (query (:insert-into 'from-test-data1 :set 'flight 1 'from "Akureyri" 'to-destination "Reykjavík"))) + (signals error (query (:insert-into 'from-test-data1 + :set 'flight 1 'from "Reykjavík" 'to-destination "Akureyri"))) + (signals error (query (:insert-into 'from-test-data1 + :set 'flight 1 'from "Akureyri" 'to-destination "Reykjavík"))) ;; test update - (query (:update 'from-test-data1 :set 'from "Kópavogur" :where (:= 'to-destination "Seyðisfjörður"))) - (is (equal (query (:select 'flight :from 'from-test-data1 :where (:and (:= 'from "Kópavogur") - (:= 'to-destination "Seyðisfjörður"))) + (query (:update 'from-test-data1 + :set 'from "Kópavogur" + :where (:= 'to-destination "Seyðisfjörður"))) + (is (equal (query (:select 'flight + :from 'from-test-data1 + :where (:and (:= 'from "Kópavogur") + (:= 'to-destination "Seyðisfjörður"))) :single) 1)) - (query (:update 'from-test-data1 :set 'to-destination "Kópavogur" :where (:= 'from "Stykkishólmur"))) - (is (equal (query (:select 'flight :from 'from-test-data1 :where (:and (:= 'to-destination "Kópavogur") - (:= 'from "Stykkishólmur"))) + (query (:update 'from-test-data1 + :set 'to-destination "Kópavogur" + :where (:= 'from "Stykkishólmur"))) + (is (equal (query (:select 'flight + :from 'from-test-data1 + :where (:and (:= 'to-destination "Kópavogur") + (:= 'from "Stykkishólmur"))) :single) 2)) (execute (:drop-table 'from-test-data1 :cascade)) @@ -1865,7 +2479,7 @@ that the table will need to be scanned twice. Everything is a trade-off." (test posix-regex (with-test-connection (is (equalp (query (:select (:regexp_match "foobarbequebaz" "bar.*que")) :single) - #("barbeque"))) + #("barbeque"))) (is (equal (query (:select (:regexp_match "foobarbequebaz" "bar.~que")) :single) :NULL)) (is (equal (query (:select (:~ "foobarbequebaz" "bar.*que") ) :single) @@ -1898,10 +2512,12 @@ that the table will need to be scanned twice. Everything is a trade-off." (is (equalp (query (:select 'id (:regexp-matches 'text "(s[A-z]+)") :from 'text-search)) '((1 #("son")) (2 #("sly")) (3 #("stupidity")) (4 #("shark")) (5 #("swore"))))) - (is (equalp (query (:select 'id (:regexp-matches 'text "(s[A-z]+)" "g") :from 'text-search)) + (is (equalp (query (:select 'id (:regexp-matches 'text "(s[A-z]+)" "g") + :from 'text-search)) '((1 #("son")) (2 #("sly")) (3 #("stupidity")) (4 #("shark")) (5 #("swore")) (5 #("st")) (5 #("saw")) (5 #("sushi"))))) - (is (equalp (query (:select 'id (:regexp-replace 'text "(s[A-z]+)" "g") :from 'text-search)) + (is (equalp (query (:select 'id (:regexp-replace 'text "(s[A-z]+)" "g") + :from 'text-search)) '((1 "Each perg who knows you has a different perception of who you are.") (2 "Nothing is as cautioug cuddly as a pet porcupine.") (3 "Courage and g were all that he had.") (4 "Hit me with your pet g!") @@ -1916,9 +2532,6 @@ that the table will need to be scanned twice. Everything is a trade-off." (is (equal (let ((column 'latitude) (table 'countries)) (sql (:select column :from table))) "(SELECT latitude FROM countries)")) - (is (equal (let ((column 'latitude) (table "countries")) ; Note that the escapes mean this will not work with postgresql - (s-sql::sql-expand '(:select column :from table))) - '("(SELECT " (SQL-ESCAPE COLUMN) " FROM " (SQL-ESCAPE TABLE) ")"))) (is (equal (let ((select 'countries.name)) (sql (:select select :from 'countries 'regions @@ -1959,51 +2572,51 @@ that the table will need to be scanned twice. Everything is a trade-off." (is-false (table-exists-p "table_1")) (query (:create-table (:if-not-exists "table_1") ((id :type integer)))) (is-true (table-exists-p "table_1")))) - (with-test-connection - (query (:drop-table :if-exists "table_1")) - (create-and-check) - (is (equal (sql (:drop-table :if-exists table-var1 :cascade)) - "DROP TABLE IF EXISTS table_1 CASCADE")) - (is (equal (sql (:drop-table :if-exists "table-1" :cascade)) - "DROP TABLE IF EXISTS table_1 CASCADE")) - (is (equal (sql (:drop-table :if-exists 'table-1 :cascade)) - "DROP TABLE IF EXISTS table_1 CASCADE")) - (is (equal (sql (:drop-table :if-exists table-var2 :cascade)) - "DROP TABLE IF EXISTS table_1 CASCADE")) - (is (equal (sql (:drop-table (:if-exists "table-1") :cascade)) - "DROP TABLE IF EXISTS table_1 CASCADE")) - (is (equal (sql (:drop-table :if-exists table-var1)) - "DROP TABLE IF EXISTS table_1")) - (is (equal (sql (:drop-table :if-exists "table-1")) - "DROP TABLE IF EXISTS table_1")) - (is (equal (sql (:drop-table :if-exists 'table-1)) - "DROP TABLE IF EXISTS table_1")) - (is (equal (sql (:drop-table :if-exists table-var2)) - "DROP TABLE IF EXISTS table_1")) - (is (equal (sql (:drop-table (:if-exists "table-1"))) - "DROP TABLE IF EXISTS table_1")) - (is (equal (sql (:drop-table table-var1 :cascade)) - "DROP TABLE table_1 CASCADE")) - (is (equal (sql (:drop-table "table-1" :cascade)) - "DROP TABLE table_1 CASCADE")) - (is (equal (sql (:drop-table 'table-1 :cascade)) - "DROP TABLE table_1 CASCADE")) - (is (equal (sql (:drop-table table-var2 :cascade)) - "DROP TABLE table_1 CASCADE")) - (is (equal (sql (:drop-table "table-1" :cascade)) - "DROP TABLE table_1 CASCADE")) - (is (equal (sql (:drop-table table-var1)) - "DROP TABLE table_1")) - (is (equal (sql (:drop-table "table-1")) - "DROP TABLE table_1")) - (is (equal (sql (:drop-table 'table-1)) - "DROP TABLE table_1")) - (is (equal (sql (:drop-table table-var2)) - "DROP TABLE table_1")) - (is (equal (sql (:drop-table 'table-1)) - "DROP TABLE table_1")) - (is (equal (sql (:drop-table "table-1")) - "DROP TABLE table_1")))))) + (with-test-connection + (query (:drop-table :if-exists "table_1")) + (create-and-check) + (is (equal (sql (:drop-table :if-exists table-var1 :cascade)) + "DROP TABLE IF EXISTS table_1 CASCADE")) + (is (equal (sql (:drop-table :if-exists "table-1" :cascade)) + "DROP TABLE IF EXISTS table_1 CASCADE")) + (is (equal (sql (:drop-table :if-exists 'table-1 :cascade)) + "DROP TABLE IF EXISTS table_1 CASCADE")) + (is (equal (sql (:drop-table :if-exists table-var2 :cascade)) + "DROP TABLE IF EXISTS table_1 CASCADE")) + (is (equal (sql (:drop-table (:if-exists "table-1") :cascade)) + "DROP TABLE IF EXISTS table_1 CASCADE")) + (is (equal (sql (:drop-table :if-exists table-var1)) + "DROP TABLE IF EXISTS table_1")) + (is (equal (sql (:drop-table :if-exists "table-1")) + "DROP TABLE IF EXISTS table_1")) + (is (equal (sql (:drop-table :if-exists 'table-1)) + "DROP TABLE IF EXISTS table_1")) + (is (equal (sql (:drop-table :if-exists table-var2)) + "DROP TABLE IF EXISTS table_1")) + (is (equal (sql (:drop-table (:if-exists "table-1"))) + "DROP TABLE IF EXISTS table_1")) + (is (equal (sql (:drop-table table-var1 :cascade)) + "DROP TABLE table_1 CASCADE")) + (is (equal (sql (:drop-table "table-1" :cascade)) + "DROP TABLE table_1 CASCADE")) + (is (equal (sql (:drop-table 'table-1 :cascade)) + "DROP TABLE table_1 CASCADE")) + (is (equal (sql (:drop-table table-var2 :cascade)) + "DROP TABLE table_1 CASCADE")) + (is (equal (sql (:drop-table "table-1" :cascade)) + "DROP TABLE table_1 CASCADE")) + (is (equal (sql (:drop-table table-var1)) + "DROP TABLE table_1")) + (is (equal (sql (:drop-table "table-1")) + "DROP TABLE table_1")) + (is (equal (sql (:drop-table 'table-1)) + "DROP TABLE table_1")) + (is (equal (sql (:drop-table table-var2)) + "DROP TABLE table_1")) + (is (equal (sql (:drop-table 'table-1)) + "DROP TABLE table_1")) + (is (equal (sql (:drop-table "table-1")) + "DROP TABLE table_1")))))) (test drop-table-variations-live (let ((table-var1 "table-1") @@ -2058,152 +2671,14 @@ that the table will need to be scanned twice. Everything is a trade-off." (query (:drop-table "table-1")) (is-false (table-exists-p "table_1")))))) -(test over - (is (equal (sql (:over (:sum 'salary))) - "(SUM(salary) OVER ()) ")) - (is (equal (sql (:over (:sum 'salary) 'w)) - "(SUM(salary) OVER w)")) - (is (equal (sql (:over (:count '*) - (:partition-by (:date-trunc "month" 'joindate)))) - "(COUNT(*) OVER (PARTITION BY date_trunc(E'month', joindate)))")) - (is (equal (sql (:over (:rank) (:order-by (:desc 'total)))) - "(rank() OVER ( ORDER BY total DESC))")) - (is (equal (sql (:over (:percentile-cont :fraction 0.25 :order-by (:asc 'duration)) - (:partition-by 'day))) - "(PERCENTILE_CONT(0.25) WITHIN GROUP (ORDER BY duration ASC) OVER (PARTITION BY day))"))) +(test generate-series + (is (equal (sql (:select 'x (:generate-series 0 'x) + :from (:as (:values (:set 1) (:set 2) (:set 3)) + (:t1 'x)))) + "(SELECT x, generate_series(0, x) FROM (VALUES (1), (2), (3)) AS t1(x))")) -(test between - (is (equal (sql (:between 'latitude -10 10)) - "(latitude BETWEEN -10 AND 10)")) - (is (equal (sql (:between (:- 'population.year 'ma-population.year) 0 2)) - "((population.year - ma_population.year) BETWEEN 0 AND 2)"))) - -(test over-range-between - (signals error - (sql (:limit - (:select (:as 'country 'country-name) - (:as 'population 'country-population) - (:as (:over (:sum 'population) - (:range-between :order-by 'country :preceding 2 :following 2)) - 'global-population) - :from 'population - :where (:and (:not-null 'iso2) - (:= 'year 1976))) - 5))) - (is (equal - (sql (:limit - (:select (:as 'country 'country-name) - (:as 'population 'country-population) - (:as (:over (:sum 'population) - (:range-between :order-by 'country :unbounded-preceding - :unbounded-following)) - 'global-population) - :from 'population - :where (:and (:not-null 'iso2) - (:= 'year 1976))) - 5)) - "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country RANGE BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) - (is (equal - (sql (:limit - (:select (:as 'country 'country-name) - (:as 'population 'country-population) - (:as (:over (:sum 'population) - (:range-between :order-by 'country :current-row - :unbounded-following)) - 'global-population) - :from 'population - :where (:and (:not-null 'iso2) - (:= 'year 1976))) - 5)) - "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country RANGE BETWEEN CURRENT ROW AND UNBOUNDED FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) - -(test over-row-between - (is (equal - (sql (:limit - (:select (:as 'country 'country-name) - (:as 'population 'country-population) - (:as (:over (:sum 'population) - (:rows-between :order-by 'country :preceding 2 - :following 2)) - 'global-population) - :from 'population - :where (:and (:not-null 'iso2) - (:= 'year 1976))) - 5)) - "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN 2 PRECEDING AND 2 FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) - (is (equal - (sql (:limit - (:select (:as 'country 'country-name) - (:as 'population 'country-population) - (:as (:over (:sum 'population) - (:rows-between :order-by 'country :current-row - :following 2)) - 'global-population) - :from 'population - :where (:and (:not-null 'iso2) - (:= 'year 1976))) - 5)) - "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN CURRENT ROW AND 2 FOLLOWING )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) - (is (equal - (sql (:limit - (:select (:as 'country 'country-name) - (:as 'population 'country-population) - (:as (:over (:sum 'population) - (:rows-between :order-by 'country :preceding 2 - :current-row)) - 'global-population) - :from 'population - :where (:and (:not-null 'iso2) - (:= 'year 1976))) - 5)) - "((SELECT country AS country_name, population AS country_population, (SUM(population) OVER (ORDER BY country ROWS BETWEEN 2 PRECEDING AND CURRENT ROW )) AS global_population FROM population WHERE ((iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) - -(test over-with-partition-with-range-or-row-between - (is (equal - (sql (:limit - (:select (:as 'population.country 'country-name) - (:as 'population 'country-population) - 'region-name - (:as (:over (:sum 'population) - (:partition-by 'region-name :order-by 'population.country - :range-between :unbounded-preceding :current-row)) - 'regional-population) - :from 'population - :inner-join 'regions - :on (:= 'population.iso3 'regions.iso3) - :where (:and (:not-null 'population.iso2) - (:= 'year 1976))) - 5)) - "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY population.country RANGE BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) - (is (equal - (sql (:limit - (:select (:as 'population.country 'country-name) - (:as 'population 'country-population) - 'region-name - (:as (:over (:sum 'population) - (:partition-by 'region-name :order-by 'region-name - :range-between :unbounded-preceding :current-row)) - 'regional-population) - :from 'population - :inner-join 'regions - :on (:= 'population.iso3 'regions.iso3) - :where (:and (:not-null 'population.iso2) - (:= 'year 1976))) - 5)) - "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY region_name RANGE BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)")) - (is (equal - (sql (:limit - (:select (:as 'population.country 'country-name) - (:as 'population 'country-population) - 'region-name - (:as (:over (:sum 'population) - (:partition-by 'region-name :order-by 'region-name - :rows-between :unbounded-preceding :current-row)) - 'regional-population) - :from 'population - :inner-join 'regions - :on (:= 'population.iso3 'regions.iso3) - :where (:and (:not-null 'population.iso2) - (:= 'year 1976))) - 5)) - "((SELECT population.country AS country_name, population AS country_population, region_name, (SUM(population) OVER (PARTITION BY region_name ORDER BY region_name ROWS BETWEEN UNBOUNDED PRECEDING AND CURRENT ROW )) AS regional_population FROM population INNER JOIN regions ON (population.iso3 = regions.iso3) WHERE ((population.iso2 IS NOT NULL) and (year = 1976))) LIMIT 5)"))) + (with-test-connection + (is (equal (query (:select 'x (:generate-series 0 'x) + :from (:as (:values (:set 0) (:set 1) (:set 2)) + (:t 'x)))) + '((0 0) (1 0) (1 1) (2 0) (2 1) (2 2)))))) From fad26bbdaaa4cb3f4f56e9379a654b244a193efb Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Thu, 14 Jan 2021 09:15:28 -0500 Subject: [PATCH 09/10] Minor formatting changes Also deletes extraneous old code that was just there for reference. --- s-sql/s-sql.lisp | 34 ++++------------------------------ 1 file changed, 4 insertions(+), 30 deletions(-) diff --git a/s-sql/s-sql.lisp b/s-sql/s-sql.lisp index f65ebef4..a861b9d0 100644 --- a/s-sql/s-sql.lisp +++ b/s-sql/s-sql.lisp @@ -1525,8 +1525,7 @@ to runtime. Used to create stored procedures." ,@(cond ((eq (car method) :set) (cond ((oddp (length (cdr method))) - (sql-error "Invalid amount of :set arguments -passed to insert-into sql operator")) + (sql-error "Invalid amount of :set arguments passed to insert-into sql operator")) ((null (cdr method)) '("DEFAULT VALUES")) (t `("(" ,@(sql-expand-list (loop :for (field nil) @@ -2092,32 +2091,6 @@ definition." (defun expand-composite-table-name (frm) "Helper function for building a composite table name" (strcat (list (to-sql-name (second frm)) " OF " (to-sql-name (third frm))))) -;; old expand-table-name -#| -(defun expand-table-name (name &optional (tableset nil)) - "Note: temporary tables are unlogged tables. Having both :temp and :unlogged -would be redundant." - (cond ((and name (stringp name)) - (concatenate 'string (unless tableset "TABLE ") (to-sql-name name))) - ((and name (symbolp name)) - (concatenate 'string (unless tableset "TABLE ") (to-sql-name name))) - ((and name (listp name)) - (case (car name) - (quote (concatenate 'string (unless tableset "TABLE ") - (to-sql-name (cadr name)))) - (:temp (concatenate 'string "TEMP TABLE " - (expand-table-name (cadr name) t))) - (:unlogged (concatenate 'string "UNLOGGED TABLE " - (expand-table-name (cadr name) t))) - (:if-not-exists (concatenate 'string (unless tableset "TABLE ") - "IF NOT EXISTS " - (expand-table-name (cadr name) t))) - (:of (concatenate 'string (unless tableset "TABLE ") - (expand-composite-table-name name))) - (t (concatenate 'string (unless tableset "TABLE ") - (to-sql-name (car name)))))) - (t (sql-error "Unknown table option: ~A" name)))) -|# (defun expand-table-name (name &optional (tableset nil)) "Note: temporary tables are unlogged tables. Having both :temp and :unlogged @@ -2136,8 +2109,9 @@ would be redundant." (expand-table-name (cdr name) t))) (:temporary (concatenate 'string "TEMP TABLE " (expand-table-name (cdr name) t))) - (:unlogged (if tableset (expand-table-name (cdr name) t) (concatenate 'string "UNLOGGED TABLE " - (expand-table-name (cdr name) t)))) + (:unlogged (if tableset (expand-table-name (cdr name) t) + (concatenate 'string "UNLOGGED TABLE " + (expand-table-name (cdr name) t)))) (:if-not-exists (concatenate 'string (unless tableset "TABLE ") "IF NOT EXISTS " (expand-table-name (cdr name) t))) From 7e12e14bc41e56525c5dd4cb55a1cd262c1ce17c Mon Sep 17 00:00:00 2001 From: Sabra Crolleton Date: Thu, 14 Jan 2021 09:17:08 -0500 Subject: [PATCH 10/10] Added two tests in s-sql test-arrays Also deleted extraneous language in s-sql/tests/tests.lisp --- s-sql/tests/test-arrays.lisp | 10 ++++++++++ s-sql/tests/tests.lisp | 19 ------------------- 2 files changed, 10 insertions(+), 19 deletions(-) diff --git a/s-sql/tests/test-arrays.lisp b/s-sql/tests/test-arrays.lisp index be5622a0..57e62c3a 100644 --- a/s-sql/tests/test-arrays.lisp +++ b/s-sql/tests/test-arrays.lisp @@ -143,6 +143,16 @@ equality tests with arrays requires equalp, not equal." ("pistachios") ("pita bread") ("raw meat") ("salt") ("spices") ("sugar syrup") ("tahini sauce") ("tomatoes") ("tomato paste") ("yogurt") ("zaatar")))) + (is (equal + (sql (:select '* + :from (:unnest (:type (:array[] "my" "dog" "eats" "dog food" ) + text[])))) + "(SELECT * FROM unnest(ARRAY[E'my', E'dog', E'eats', E'dog food']::TEXT[]))")) + (is (equal + (query (:select '* + :from (:unnest (:type (:array[] "my" "dog" "eats" "dog food" ) text[])))) + '(("my") ("dog") ("eats") ("dog food")))) + ;;; 8 counting each unique tag (is (equal (query (:order-by (:with (:as 'p (:select (:as (:unnest 'tags) 'tag) diff --git a/s-sql/tests/tests.lisp b/s-sql/tests/tests.lisp index ab879d78..fd275e65 100644 --- a/s-sql/tests/tests.lisp +++ b/s-sql/tests/tests.lisp @@ -2269,25 +2269,6 @@ To sum the column len of all films and group the results by kind:" "TRUNCATE ONLY bigtable, fattable CONTINUE IDENTITY CASCADE ")) (is (equal (sql (:truncate 'bigtable 'fattable :continue-identity :cascade )) "TRUNCATE bigtable, fattable CONTINUE IDENTITY CASCADE "))) -#| - -Here is an example of a function with an ordinality column added: - -SELECT * FROM unnest(ARRAY['a','b','c','d','e','f']) WITHORD INALITY; - - -https://www.postgresql.org/docs/current/static/sql-select.html -This example uses LATERAL to apply a set-returning function get_product_names() for each row of the manufacturers table: - -SELECT m.name AS mname, pname -FROM manufacturers m, LATERAL get_product_names(m.id) pname; - -Manufacturers not currently having any products would not appear in the result, since it is an inner join. If we wished to include the names of such manufacturers in the result, we could do: - -SELECT m.name AS mname, pname -FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true; - -|# (test dissect-type-0 "Testing dissect-type"