├── .github ├── FUNDING.yml └── workflows │ └── clojure.yml ├── .gitignore ├── test-resources └── eastwood.clj ├── test └── sqlingvo │ ├── spec_test.cljc │ ├── test.cljc │ ├── view_test.cljc │ ├── drop_table_test.cljc │ ├── test │ └── runner.cljs │ ├── schema_test.cljc │ ├── db_test.cljc │ ├── explain_test.cljc │ ├── types_test.cljc │ ├── copy_test.cljc │ ├── delete_test.cljc │ ├── truncate_test.cljc │ ├── url_test.cljc │ ├── util_test.cljc │ ├── materialized_view_test.cljc │ ├── values_test.cljc │ ├── compiler_test.cljc │ ├── with_test.cljc │ ├── update_test.cljc │ ├── core_test.cljc │ ├── create_table_test.cljc │ ├── expr_test.cljc │ └── insert_test.cljc ├── src └── sqlingvo │ ├── url.cljc │ ├── spec.cljc │ ├── db.cljc │ ├── util.cljc │ ├── expr.cljc │ ├── core.cljc │ └── compiler.cljc ├── project.clj ├── LICENSE └── README.org /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: [r0man] 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | *.jar 7 | *.class 8 | .lein-deps-sum 9 | .lein-failures 10 | .lein-plugins 11 | /pom.xml.asc 12 | /.nrepl-port 13 | /.cask/ 14 | /dist/ 15 | /README.html 16 | /.cljs_node_repl 17 | /docs 18 | /.eastwood 19 | -------------------------------------------------------------------------------- /test-resources/eastwood.clj: -------------------------------------------------------------------------------- 1 | ;; https://github.com/jonase/eastwood#eastwood-config-files 2 | 3 | ;; Disable some clojure.spec warnings 4 | 5 | (disable-warning 6 | {:linter :suspicious-expression 7 | :for-macro 'clojure.core/and 8 | :if-inside-macroexpansion-of 9 | #{'clojure.spec.alpha/keys}}) 10 | -------------------------------------------------------------------------------- /test/sqlingvo/spec_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.spec-test 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.test :refer [deftest]] 4 | [sqlingvo.spec :as spec])) 5 | 6 | (deftest test-column 7 | (s/exercise :sqlingvo/column)) 8 | 9 | (deftest test-table 10 | (s/exercise :sqlingvo/table)) 11 | -------------------------------------------------------------------------------- /.github/workflows/clojure.yml: -------------------------------------------------------------------------------- 1 | name: Clojure CI 2 | 3 | on: 4 | push: 5 | branches: [ master ] 6 | pull_request: 7 | branches: [ master ] 8 | 9 | jobs: 10 | build: 11 | 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - uses: actions/checkout@v2 16 | - name: Install dependencies 17 | run: lein deps 18 | - name: Run tests 19 | run: lein ci 20 | -------------------------------------------------------------------------------- /test/sqlingvo/test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.test 2 | (:require #?(:clj [clojure.test :refer :all] 3 | :cljs [cljs.test :refer-macros [is]]) 4 | [clojure.spec.alpha :as s] 5 | [clojure.spec.test.alpha :as stest] 6 | [sqlingvo.core :refer [sql]] 7 | [sqlingvo.db :as db])) 8 | 9 | (def db (db/db :postgresql)) 10 | 11 | (stest/instrument) 12 | 13 | (defn cljs-env? 14 | "Take the &env from a macro, and tell whether we are expanding into cljs." 15 | [env] 16 | (boolean (:ns env))) 17 | 18 | (defmacro if-cljs 19 | "Return then if we are generating cljs code and else for Clojure code. 20 | https://groups.google.com/d/msg/clojurescript/iBY5HaQda4A/w1lAQi9_AwsJ" 21 | [then else] 22 | (if (cljs-env? &env) then else)) 23 | 24 | (defmacro sql= 25 | "Compile `statement` into SQL and compare it to `expected`." 26 | [statement expected] 27 | `(if-cljs 28 | (cljs.test/is (= (sqlingvo.core/sql ~statement) ~expected)) 29 | (is (= (sql ~statement) ~expected)))) 30 | -------------------------------------------------------------------------------- /test/sqlingvo/view_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.view-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-drop-view 8 | (sql= (sql/drop-view :postgresql :order-summary) 9 | ["DROP VIEW \"order-summary\""]) 10 | (sql= (sql/drop-view db :order-summary) 11 | ["DROP VIEW \"order-summary\""]) 12 | (sql= (sql/drop-view db :order-summary 13 | (sql/if-exists true)) 14 | ["DROP VIEW IF EXISTS \"order-summary\""]) 15 | (sql= (sql/drop-view db :order-summary 16 | (sql/cascade true)) 17 | ["DROP VIEW \"order-summary\" CASCADE"]) 18 | (sql= (sql/drop-view db :order-summary 19 | (sql/restrict true)) 20 | ["DROP VIEW \"order-summary\" RESTRICT"]) 21 | (sql= (sql/drop-view db :order-summary 22 | (sql/if-exists true) 23 | (sql/cascade true)) 24 | ["DROP VIEW IF EXISTS \"order-summary\" CASCADE"])) 25 | -------------------------------------------------------------------------------- /test/sqlingvo/drop_table_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.drop-table-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-drop-table-keyword-db 8 | (sql= (sql/drop-table :postgresql [:continents]) 9 | ["DROP TABLE \"continents\""])) 10 | 11 | (deftest test-drop-continents 12 | (sql= (sql/drop-table db [:continents]) 13 | ["DROP TABLE \"continents\""])) 14 | 15 | (deftest test-drop-continents-and-countries 16 | (sql= (sql/drop-table db [:continents :countries]) 17 | ["DROP TABLE \"continents\", \"countries\""])) 18 | 19 | (deftest test-drop-continents-countries-if-exists-restrict 20 | (sql= (sql/drop-table db [:continents :countries] 21 | (sql/if-exists true) 22 | (sql/restrict true)) 23 | ["DROP TABLE IF EXISTS \"continents\", \"countries\" RESTRICT"])) 24 | 25 | (deftest test-drop-continents-if-exists 26 | (sql= (sql/drop-table db [:continents] 27 | (sql/if-exists true)) 28 | ["DROP TABLE IF EXISTS \"continents\""])) 29 | 30 | (deftest test-drop-continents-if-exists-false 31 | (sql= (sql/drop-table db [:continents] 32 | (sql/if-exists false)) 33 | ["DROP TABLE \"continents\""])) 34 | -------------------------------------------------------------------------------- /test/sqlingvo/test/runner.cljs: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.test.runner 2 | (:require [clojure.spec.test.alpha :as stest] 3 | [doo.runner :refer-macros [doo-tests]] 4 | [sqlingvo.compiler-test] 5 | [sqlingvo.copy-test] 6 | [sqlingvo.core-test] 7 | [sqlingvo.create-table-test] 8 | [sqlingvo.db-test] 9 | [sqlingvo.delete-test] 10 | [sqlingvo.drop-table-test] 11 | [sqlingvo.explain-test] 12 | [sqlingvo.expr-test] 13 | [sqlingvo.insert-test] 14 | [sqlingvo.materialized-view-test] 15 | [sqlingvo.select-test] 16 | [sqlingvo.spec-test] 17 | [sqlingvo.truncate-test] 18 | [sqlingvo.update-test] 19 | [sqlingvo.url-test] 20 | [sqlingvo.util-test] 21 | [sqlingvo.values-test] 22 | [sqlingvo.with-test])) 23 | 24 | (stest/instrument) 25 | 26 | (doo-tests 27 | 'sqlingvo.compiler-test 28 | 'sqlingvo.copy-test 29 | 'sqlingvo.core-test 30 | 'sqlingvo.create-table-test 31 | 'sqlingvo.db-test 32 | 'sqlingvo.delete-test 33 | 'sqlingvo.drop-table-test 34 | 'sqlingvo.explain-test 35 | 'sqlingvo.expr-test 36 | 'sqlingvo.insert-test 37 | 'sqlingvo.materialized-view-test 38 | 'sqlingvo.select-test 39 | 'sqlingvo.spec-test 40 | 'sqlingvo.truncate-test 41 | 'sqlingvo.update-test 42 | 'sqlingvo.util-test 43 | 'sqlingvo.url-test 44 | 'sqlingvo.values-test 45 | 'sqlingvo.with-test) 46 | -------------------------------------------------------------------------------- /test/sqlingvo/schema_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.schema-test 2 | #?@ 3 | (:clj 4 | [(:require 5 | [clojure.test :refer [deftest]] 6 | [sqlingvo.core :as sql] 7 | [sqlingvo.test :refer [db sql=]])] 8 | :cljs 9 | [(:require 10 | [clojure.test :refer [deftest]] 11 | [sqlingvo.core :as sql] 12 | [sqlingvo.test :refer [db] :refer-macros [sql=]])])) 13 | 14 | (deftest test-create-schema 15 | (sql= (sql/create-schema db :my-schema) 16 | ["CREATE SCHEMA \"my-schema\""])) 17 | 18 | (deftest test-create-schema-iof-no 19 | (sql= (sql/create-schema db :my-schema 20 | (sql/if-not-exists true)) 21 | ["CREATE SCHEMA IF NOT EXISTS \"my-schema\""])) 22 | 23 | (deftest test-drop-schema 24 | (sql= (sql/drop-schema db [:mood]) 25 | ["DROP SCHEMA \"mood\""])) 26 | 27 | (deftest test-drop-schemas 28 | (sql= (sql/drop-schema db [:schema-1 :schema-2]) 29 | ["DROP SCHEMA \"schema-1\", \"schema-2\""])) 30 | 31 | (deftest test-drop-schema-if-exists 32 | (sql= (sql/drop-schema db [:my-schema] 33 | (sql/if-exists true)) 34 | ["DROP SCHEMA IF EXISTS \"my-schema\""])) 35 | 36 | (deftest test-drop-schema-cascade 37 | (sql= (sql/drop-schema db [:my-schema] 38 | (sql/cascade true)) 39 | ["DROP SCHEMA \"my-schema\" CASCADE"])) 40 | 41 | (deftest test-drop-schema-restrict 42 | (sql= (sql/drop-schema db [:my-schema] 43 | (sql/restrict true)) 44 | ["DROP SCHEMA \"my-schema\" RESTRICT"])) 45 | -------------------------------------------------------------------------------- /src/sqlingvo/url.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.url 2 | (:refer-clojure :exclude [format]) 3 | (:require [no.en.core :as noencore])) 4 | 5 | (def regular-expression 6 | "The regular expression that matches a database URL." 7 | #"(([^:]+):)?([^:]+)://(([^:]+):([^@]+)@)?(([^:/]+)(:([0-9]+))?((/([^?]*))(\?(.*))?))") 8 | 9 | (defn parse 10 | "Parse the database `url` with `regular-expression` and return the 11 | database spec. Returns nil if the URL does not match." 12 | [url] 13 | (when-let [matches (re-matches regular-expression (str url))] 14 | (let [database (nth matches 13) 15 | server-name (nth matches 8) 16 | server-port (noencore/parse-integer (nth matches 10)) 17 | query-string (nth matches 15)] 18 | {:name database 19 | :password (nth matches 6) 20 | :pool (keyword (nth matches 2)) 21 | :query-params (noencore/parse-query-params query-string) 22 | :scheme (keyword (nth matches 3)) 23 | :server-name server-name 24 | :server-port server-port 25 | :username (nth matches 5)}))) 26 | 27 | (defn parse! 28 | "Parse the database `url` with `regular-expression` and return the 29 | database spec. Throws an exception if `url` does not match." 30 | [url] 31 | (or (parse url) 32 | (throw (ex-info (str "Can't parse database URL: " url) 33 | {:url url})))) 34 | 35 | (defn format 36 | "Format the `db` spec as a URL." 37 | [db] 38 | (->> (assoc db :uri (str "/" (:name db))) 39 | (noencore/format-url))) 40 | -------------------------------------------------------------------------------- /src/sqlingvo/spec.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.spec 2 | (:require [clojure.spec.alpha :as s])) 3 | 4 | (s/def ::identifier keyword?) 5 | 6 | (s/def ::keyword-identifer keyword?) 7 | 8 | ;; Schema 9 | 10 | (s/def :sqlingvo.schema/name ::keyword-identifer) 11 | 12 | ;; Alias 13 | 14 | (s/def :sqlingvo.alias/op #{:alias}) 15 | 16 | (s/def :sqlingvo/alias 17 | (s/keys :req-un [:sqlingvo.alias/op])) 18 | 19 | ;; Table 20 | 21 | (s/def :sqlingvo.table/name ::keyword-identifer) 22 | (s/def :sqlingvo.table/op #{:table}) 23 | (s/def :sqlingvo.table/schema :sqlingvo.schema/name) 24 | 25 | (s/def :sqlingvo.table/identifier 26 | (s/or :alias :sqlingvo/alias 27 | :keyword keyword? 28 | :string string? 29 | :table :sqlingvo/table)) 30 | 31 | (s/def :sqlingvo/table 32 | (s/keys :req-un [:sqlingvo.table/op 33 | :sqlingvo.table/name] 34 | :opt-un [:sqlingvo.table/schema])) 35 | 36 | ;; Column 37 | 38 | (s/def :sqlingvo.column/name ::keyword-identifer) 39 | (s/def :sqlingvo.column/op #{:column}) 40 | (s/def :sqlingvo.column/schema :sqlingvo.schema/name) 41 | (s/def :sqlingvo.column/table :sqlingvo.table/name) 42 | 43 | (s/def :sqlingvo.column/identifier 44 | (s/or :alias :sqlingvo/alias 45 | :keyword keyword? 46 | :string string? 47 | :table :sqlingvo/column)) 48 | 49 | (s/def :sqlingvo/column 50 | (s/keys :req-un [:sqlingvo.column/op 51 | :sqlingvo.column/name] 52 | :opt-un [:sqlingvo.column/schema 53 | :sqlingvo.column/table])) 54 | -------------------------------------------------------------------------------- /test/sqlingvo/db_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.db-test 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.test :refer [are deftest is]] 4 | [sqlingvo.compiler :as compiler] 5 | [sqlingvo.db :as db] 6 | [sqlingvo.util :as util])) 7 | 8 | (deftest test-db-invalid 9 | (are [spec] (thrown? #?(:clj Exception :cljs js/Error) (db/db spec)) 10 | nil "" "invalid" 1)) 11 | 12 | (deftest test-db-keyword 13 | (let [db (db/db :postgresql)] 14 | (is (s/valid? ::db/db db)) 15 | (is (instance? sqlingvo.db.Database db)) 16 | (is (= (:classname db) "org.postgresql.Driver")) 17 | (is (= (:eval-fn db) compiler/compile-stmt)) 18 | (is (= (:scheme db) :postgresql)) 19 | (is (= (:sql-name db) nil)) 20 | (is (= (:sql-quote db) util/sql-quote-double-quote)))) 21 | 22 | (deftest test-db-map-scheme 23 | (is (= (db/db {:scheme :postgresql}) 24 | (db/db {:scheme "postgresql"}) 25 | (db/db :postgresql)))) 26 | 27 | (deftest test-db-url 28 | (let [db (db/db "postgresql://tiger:scotch@localhost/sqlingvo?a=1&b=2")] 29 | (is (instance? sqlingvo.db.Database db)) 30 | (is (= (:classname db) "org.postgresql.Driver")) 31 | (is (= (:eval-fn db) compiler/compile-stmt)) 32 | (is (= (:name db) "sqlingvo")) 33 | (is (= (:password db) "scotch")) 34 | (is (= (:query-params db) {:a "1" :b "2"})) 35 | (is (= (:scheme db) :postgresql)) 36 | (is (= (:server-name db) "localhost" )) 37 | (is (= (:sql-name db) nil)) 38 | (is (= (:sql-quote db) util/sql-quote-double-quote)) 39 | (is (= (:username db) "tiger")) 40 | (is (nil? (:server-port db))))) 41 | 42 | (deftest test-db-idempotent 43 | (let [db (db/db :postgresql {:eval-fn identity})] 44 | (is (= (:eval-fn (db/db db)) identity)))) 45 | -------------------------------------------------------------------------------- /test/sqlingvo/explain_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.explain-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [clojure.string :as str] 6 | [sqlingvo.core :as sql])) 7 | 8 | (deftest test-explain-keyword-db 9 | (sql= (sql/explain :postgresql 10 | (sql/select :postgresql [:*] 11 | (sql/from :foo))) 12 | ["EXPLAIN SELECT * FROM \"foo\""])) 13 | 14 | (deftest test-explain 15 | (sql= (sql/explain db 16 | (sql/select db [:*] 17 | (sql/from :foo))) 18 | ["EXPLAIN SELECT * FROM \"foo\""])) 19 | 20 | (deftest test-explain-boolean-options 21 | (doseq [option [:analyze :buffers :costs :timing :verbose] 22 | value [true false]] 23 | (sql= (sql/explain db 24 | (sql/select db [:*] 25 | (sql/from :foo)) 26 | {option value}) 27 | [(str "EXPLAIN (" 28 | (str/upper-case (name option)) 29 | " " 30 | (str/upper-case (str value)) 31 | ") SELECT * FROM \"foo\"")]))) 32 | 33 | (deftest test-explain-multiple-options 34 | (sql= (sql/explain db 35 | (sql/select db [:*] 36 | (sql/from :foo)) 37 | {:analyze true 38 | :verbose true}) 39 | ["EXPLAIN (ANALYZE TRUE, VERBOSE TRUE) SELECT * FROM \"foo\""])) 40 | 41 | (deftest test-explain-format 42 | (doseq [value [:text :xml :json :yaml]] 43 | (sql= (sql/explain db 44 | (sql/select db [:*] 45 | (sql/from :foo)) 46 | {:format value}) 47 | [(str "EXPLAIN (FORMAT " 48 | (str/upper-case (name value)) 49 | ") SELECT * FROM \"foo\"")]))) 50 | -------------------------------------------------------------------------------- /test/sqlingvo/types_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.types-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-create-enum-type 8 | (sql= (sql/create-type db :mood 9 | (sql/enum ["sad" "ok" "happy"])) 10 | ["CREATE TYPE \"mood\" AS ENUM ('sad', 'ok', 'happy')"])) 11 | 12 | (deftest test-create-enum-type-schema 13 | (sql= (sql/create-type db :my-schema.mood 14 | (sql/enum ["sad" "ok" "happy"])) 15 | ["CREATE TYPE \"my-schema\".\"mood\" AS ENUM ('sad', 'ok', 'happy')"])) 16 | 17 | (deftest test-drop-type 18 | (sql= (sql/drop-type db [:mood]) 19 | ["DROP TYPE \"mood\""])) 20 | 21 | (deftest test-drop-types 22 | (sql= (sql/drop-type db [:type-1 :type-2]) 23 | ["DROP TYPE \"type-1\", \"type-2\""])) 24 | 25 | (deftest test-drop-type-if-exists 26 | (sql= (sql/drop-type db [:mood] 27 | (sql/if-exists true)) 28 | ["DROP TYPE IF EXISTS \"mood\""])) 29 | 30 | (deftest test-drop-type-cascade 31 | (sql= (sql/drop-type db [:mood] 32 | (sql/cascade true)) 33 | ["DROP TYPE \"mood\" CASCADE"])) 34 | 35 | (deftest test-drop-type-restrict 36 | (sql= (sql/drop-type db [:mood] 37 | (sql/restrict true)) 38 | ["DROP TYPE \"mood\" RESTRICT"])) 39 | 40 | (deftest test-create-enum-table 41 | (sql= (sql/create-table db :person 42 | (sql/column :name :text) 43 | (sql/column :mood :mood)) 44 | ["CREATE TABLE \"person\" (\"name\" TEXT, \"mood\" mood)"])) 45 | 46 | (deftest test-create-enum-table-schema 47 | (sql= (sql/create-table db :person 48 | (sql/column :name :text) 49 | (sql/column :mood :my-schema.mood)) 50 | ["CREATE TABLE \"person\" (\"name\" TEXT, \"mood\" \"my-schema\".\"mood\")"])) 51 | -------------------------------------------------------------------------------- /test/sqlingvo/copy_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.copy-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql] 6 | [sqlingvo.expr :as expr])) 7 | 8 | (deftest test-copy-keyword-db 9 | (sql= (sql/copy :postgresql :country [] 10 | (sql/from :stdin)) 11 | ["COPY \"country\" FROM STDIN"])) 12 | 13 | (deftest test-copy-stdin 14 | (sql= (sql/copy db :country [] 15 | (sql/from :stdin)) 16 | ["COPY \"country\" FROM STDIN"])) 17 | 18 | (deftest test-copy-country 19 | (sql= (sql/copy db :country [] 20 | (sql/from "/usr1/proj/bray/sql/country_data")) 21 | ["COPY \"country\" FROM ?" 22 | "/usr1/proj/bray/sql/country_data"])) 23 | 24 | (deftest test-copy-country-with-encoding 25 | (sql= (sql/copy db :country [] 26 | (sql/from "/usr1/proj/bray/sql/country_data") 27 | (sql/encoding "UTF-8")) 28 | ["COPY \"country\" FROM ? ENCODING ?" 29 | "/usr1/proj/bray/sql/country_data" "UTF-8"])) 30 | 31 | (deftest test-copy-country-with-delimiter 32 | (sql= (sql/copy db :country [] 33 | (sql/from "/usr1/proj/bray/sql/country_data") 34 | (sql/delimiter " ")) 35 | ["COPY \"country\" FROM ? DELIMITER ?" 36 | "/usr1/proj/bray/sql/country_data" " "])) 37 | 38 | (deftest test-copy-country-columns 39 | (sql= (sql/copy db :country [:id :name] 40 | (sql/from "/usr1/proj/bray/sql/country_data")) 41 | ["COPY \"country\" (\"id\", \"name\") FROM ?" 42 | "/usr1/proj/bray/sql/country_data"])) 43 | 44 | #?(:clj (deftest test-copy-from-expands-to-absolute-path 45 | (sql= (sql/copy db :country [] 46 | (sql/from (java.io.File. "country_data"))) 47 | ["COPY \"country\" FROM ?" 48 | (.getAbsolutePath (java.io.File. "country_data"))]))) 49 | -------------------------------------------------------------------------------- /test/sqlingvo/delete_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.delete-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-delete-keyword-db 8 | (sql= (sql/delete :postgresql :films) 9 | ["DELETE FROM \"films\""])) 10 | 11 | (deftest test-delete-films 12 | (sql= (sql/delete db :films) 13 | ["DELETE FROM \"films\""])) 14 | 15 | (deftest test-delete-all-films-but-musicals 16 | (sql= (sql/delete db :films 17 | (sql/where '(<> :kind "Musical"))) 18 | ["DELETE FROM \"films\" WHERE (\"kind\" <> ?)" "Musical"])) 19 | 20 | (deftest test-delete-completed-tasks-returning-all 21 | (sql= (sql/delete db :tasks 22 | (sql/where '(= :status "DONE")) 23 | (sql/returning :*)) 24 | ["DELETE FROM \"tasks\" WHERE (\"status\" = ?) RETURNING *" "DONE"])) 25 | 26 | (deftest test-delete-films-by-producer-name 27 | (sql= (sql/delete db :films 28 | (sql/where `(in :producer-id 29 | ~(sql/select db [:id] 30 | (sql/from :producers) 31 | (sql/where '(= :name "foo")))))) 32 | [(str "DELETE FROM \"films\" WHERE \"producer-id\" IN (SELECT \"id\" " 33 | "FROM \"producers\" WHERE (\"name\" = ?))") 34 | "foo"])) 35 | 36 | (deftest test-delete-quotes 37 | (sql= (sql/delete db :quotes 38 | (sql/where `(and (= :company-id 1) 39 | (> :date ~(sql/select db ['(min :date)] 40 | (sql/from :import))) 41 | (> :date ~(sql/select db ['(max :date)] 42 | (sql/from :import)))))) 43 | [(str "DELETE FROM \"quotes\" WHERE ((\"company-id\" = 1) and " 44 | "(\"date\" > (SELECT min(\"date\") FROM \"import\")) and " 45 | "(\"date\" > (SELECT max(\"date\") FROM \"import\")))")])) 46 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject sqlingvo "0.9.37-SNAPSHOT" 2 | :description "A Clojure DSL to create SQL statements" 3 | :url "http://github.com/r0man/sqlingvo" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :min-lein-version "2.5.2" 7 | :deploy-repositories [["releases" :clojars]] 8 | :dependencies [[noencore "0.3.7"] 9 | [org.clojure/clojure "1.11.3"]] 10 | :plugins [[jonase/eastwood "0.3.11"] 11 | [lein-cljsbuild "1.1.8"] 12 | [lein-difftest "2.0.0"] 13 | [lein-doo "0.1.11"]] 14 | :eastwood {:config-files ["test-resources/eastwood.clj"] 15 | :exclude-linters [:local-shadows-var]} 16 | :profiles 17 | {:dev 18 | {:dependencies [[org.clojure/test.check "1.1.1"]]} 19 | :provided 20 | {:dependencies [[org.clojure/clojurescript "1.11.132"]]} 21 | :repl 22 | {:dependencies [[com.cemerick/piggieback "0.2.2"] 23 | [reloaded.repl "0.2.4"]] 24 | :plugins [[figwheel-sidecar "0.5.20"]] 25 | :init-ns user 26 | :nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}} 27 | :aliases 28 | {"ci" ["do" 29 | ["clean"] 30 | ["difftest"] 31 | ["doo" "node" "node" "once"] 32 | ;; ["doo" "phantom" "none" "once"] 33 | ["doo" "node" "advanced" "once"] 34 | ["lint"]] 35 | "lint" ["do" ["eastwood"]]} 36 | :cljsbuild 37 | {:builds 38 | [{:id "none" 39 | :compiler 40 | {:main sqlingvo.test.runner 41 | :optimizations :none 42 | :output-dir "target/none" 43 | :output-to "target/none.js" 44 | :parallel-build true 45 | :pretty-print true 46 | :verbose false} 47 | :source-paths ["src" "test"]} 48 | {:id "node" 49 | :compiler 50 | {:main sqlingvo.test.runner 51 | :optimizations :none 52 | :output-dir "target/node" 53 | :output-to "target/node.js" 54 | :parallel-build true 55 | :pretty-print true 56 | :target :nodejs 57 | :verbose false} 58 | :source-paths ["src" "test"]} 59 | {:id "advanced" 60 | :compiler 61 | {:main sqlingvo.test.runner 62 | :optimizations :advanced 63 | :output-dir "target/advanced" 64 | :output-to "target/advanced.js" 65 | :parallel-build true 66 | :pretty-print true 67 | :target :nodejs 68 | :verbose false} 69 | :source-paths ["src" "test"]}]}) 70 | -------------------------------------------------------------------------------- /src/sqlingvo/db.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.db 2 | (:require [clojure.spec.alpha :as s] 3 | [sqlingvo.compiler :as compiler] 4 | [sqlingvo.url :as url] 5 | [sqlingvo.util :as util])) 6 | 7 | (s/def ::classname string?) 8 | (s/def ::eval-fn ifn?) 9 | (s/def ::sql-quote ifn?) 10 | 11 | (s/def ::db 12 | (s/keys :req-un [::classname ::eval-fn ::sql-quote])) 13 | 14 | (defprotocol IDatabase 15 | (-db [db] "Convert `db` to a database.")) 16 | 17 | (defrecord Database [scheme] 18 | IDatabase 19 | (-db [db] db)) 20 | 21 | (defmulti vendor 22 | "Returns a map of `vendor` specific database options." 23 | (fn [vendor] (keyword vendor))) 24 | 25 | (defmethod vendor :mysql [_] 26 | {:classname "com.mysql.cj.jdbc.Driver" 27 | :sql-quote util/sql-quote-backtick}) 28 | 29 | (defmethod vendor :postgresql [_] 30 | {:classname "org.postgresql.Driver" 31 | :sql-quote util/sql-quote-double-quote}) 32 | 33 | (defmethod vendor :oracle [_] 34 | {:classname "oracle.jdbc.driver.OracleDriver" 35 | :sql-quote util/sql-quote-double-quote}) 36 | 37 | (defmethod vendor :sqlite [_] 38 | {:classname "org.sqlite.JDBC" 39 | :sql-quote util/sql-quote-double-quote}) 40 | 41 | (defmethod vendor :sqlserver [_] 42 | {:classname "com.microsoft.sqlserver.jdbc.SQLServerDriver" 43 | :sql-quote util/sql-quote-double-quote}) 44 | 45 | (defmethod vendor :vertica [_] 46 | {:classname "com.vertica.jdbc.Driver" 47 | :sql-quote util/sql-quote-double-quote}) 48 | 49 | (defmethod vendor :default [vendor] 50 | (throw (ex-info (str "Unsupported database vendor: " (name vendor)) 51 | {:vendor vendor}))) 52 | 53 | (defn db 54 | "Return a database for `spec`." 55 | [spec & [opts]] 56 | (merge (-db spec) opts)) 57 | 58 | (s/fdef db 59 | :args (s/cat :spec any? :opts (s/? (s/nilable map?))) 60 | :ret ::db) 61 | 62 | (extend-protocol IDatabase 63 | 64 | #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword) 65 | (-db [k] 66 | (->> {:eval-fn compiler/compile-stmt :scheme k} 67 | (merge (vendor k)) 68 | (map->Database))) 69 | 70 | #?(:clj clojure.lang.IPersistentMap :cljs cljs.core/PersistentArrayMap) 71 | (-db [{:keys [scheme] :as spec}] 72 | (or (some->> scheme keyword -db (merge spec) map->Database) 73 | (throw (ex-info (str "Unsupported database spec." (pr-str spec)) 74 | {:spec spec})))) 75 | 76 | #?(:clj String :cljs string) 77 | (-db [url] 78 | (-db (url/parse! url)))) 79 | -------------------------------------------------------------------------------- /test/sqlingvo/truncate_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.truncate-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-truncate-keyword-db 8 | (sql= (sql/truncate :postgresql [:continents]) 9 | ["TRUNCATE TABLE \"continents\""])) 10 | 11 | (deftest test-truncate-continents 12 | (sql= (sql/truncate db [:continents]) 13 | ["TRUNCATE TABLE \"continents\""])) 14 | 15 | (deftest test-truncate-continents-and-countries 16 | (sql= (sql/truncate db [:continents :countries]) 17 | ["TRUNCATE TABLE \"continents\", \"countries\""])) 18 | 19 | (deftest test-truncate-continents-restart-restrict 20 | (sql= (sql/truncate db [:continents] 21 | (sql/restart-identity true) 22 | (sql/restrict true)) 23 | ["TRUNCATE TABLE \"continents\" RESTART IDENTITY RESTRICT"])) 24 | 25 | (deftest test-truncate-continents-continue-cascade 26 | (sql= (sql/truncate db [:continents] 27 | (sql/continue-identity true) 28 | (sql/cascade true)) 29 | ["TRUNCATE TABLE \"continents\" CONTINUE IDENTITY CASCADE"])) 30 | 31 | (deftest test-truncate-continue-identity 32 | (sql= (sql/truncate db [:continents] 33 | (sql/continue-identity true)) 34 | ["TRUNCATE TABLE \"continents\" CONTINUE IDENTITY"])) 35 | 36 | (deftest test-truncate-continue-identity-false 37 | (sql= (sql/truncate db [:continents] 38 | (sql/continue-identity false)) 39 | ["TRUNCATE TABLE \"continents\""])) 40 | 41 | (deftest test-truncate-cascade-true 42 | (sql= (sql/truncate db [:continents] 43 | (sql/cascade true)) 44 | ["TRUNCATE TABLE \"continents\" CASCADE"])) 45 | 46 | (deftest test-truncate-cascade-false 47 | (sql= (sql/truncate db [:continents] 48 | (sql/cascade false)) 49 | ["TRUNCATE TABLE \"continents\""])) 50 | 51 | (deftest test-truncate-restart-identity 52 | (sql= (sql/truncate db [:continents] 53 | (sql/restart-identity true)) 54 | ["TRUNCATE TABLE \"continents\" RESTART IDENTITY"])) 55 | 56 | (deftest test-truncate-restart-identity-false 57 | (sql= (sql/truncate db [:continents] 58 | (sql/restart-identity false)) 59 | ["TRUNCATE TABLE \"continents\""])) 60 | 61 | (deftest test-truncate-restrict 62 | (sql= (sql/truncate db [:continents] 63 | (sql/restrict false)) 64 | ["TRUNCATE TABLE \"continents\""])) 65 | 66 | (deftest test-truncate-restrict-false 67 | (sql= (sql/truncate db [:continents] 68 | (sql/restrict false)) 69 | ["TRUNCATE TABLE \"continents\""])) 70 | -------------------------------------------------------------------------------- /test/sqlingvo/url_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.url-test 2 | (:require [clojure.string :as str] 3 | [clojure.test :refer [are deftest is]] 4 | [clojure.test.check :as tc] 5 | [clojure.test.check.clojure-test #?(:clj :refer :cljs :refer-macros) [defspec]] 6 | [clojure.test.check.generators :as gen] 7 | [clojure.test.check.properties #?(:clj :refer :cljs :refer-macros) [for-all]] 8 | [sqlingvo.url :as url])) 9 | 10 | (def invalid-urls 11 | "The generator for invalid database URLs." 12 | (gen/elements [nil "" "x"])) 13 | 14 | (def urls 15 | "The generator for database URLs." 16 | (gen/elements 17 | ["mysql://localhost/sqlingvo" 18 | "postgresql://tiger:scotch@localhost:5432/sqlingvo?a=1&b=2"])) 19 | 20 | (def pools 21 | "The generator for database pool names." 22 | (gen/elements ["bonecp" "c3p0" "hikaricp"])) 23 | 24 | (deftest test-parse 25 | (let [db (url/parse "mysql://localhost:5432/sqlingvo")] 26 | (is (nil? (:pool db))) 27 | (is (= "localhost" (:server-name db))) 28 | (is (= 5432 (:server-port db))) 29 | (is (= "sqlingvo" (:name db))) 30 | (is (nil? (:query-params db))) 31 | (is (= :mysql (:scheme db))))) 32 | 33 | (defspec test-parse-scheme 34 | (for-all [url urls] (keyword? (:scheme (url/parse url))))) 35 | 36 | (defspec test-parse-server-name 37 | (for-all [url urls] (not (str/blank? (:server-name (url/parse url)))))) 38 | 39 | (defspec test-parse-name 40 | (for-all [url urls] (not (str/blank? (:name (url/parse url)))))) 41 | 42 | (defspec test-parse-invalid-url 43 | (for-all [url invalid-urls] (nil? (url/parse url)))) 44 | 45 | (defspec test-parse!-invalid-url 46 | (for-all 47 | [url invalid-urls] 48 | (try (url/parse! url) 49 | (assert false (str "Expected invalid URL, but was valid:" url)) 50 | (catch #?(:clj clojure.lang.ExceptionInfo 51 | :cljs js/Error) _ true)))) 52 | 53 | (defspec test-parse-with-pool 54 | (for-all 55 | [pool pools, url urls] 56 | (= (:pool (url/parse (str pool ":" url))) 57 | (keyword pool)))) 58 | 59 | (deftest test-parse-with-query-params 60 | (let [db (url/parse "postgresql://tiger:scotch@localhost:5432/sqlingvo?a=1&b=2")] 61 | (is (nil? (:pool db))) 62 | (is (= "tiger" (:username db))) 63 | (is (= "scotch" (:password db))) 64 | (is (= "localhost" (:server-name db))) 65 | (is (= 5432 (:server-port db))) 66 | (is (= "sqlingvo" (:name db))) 67 | (is (= {:a "1" :b "2"} (:query-params db))) 68 | (is (= :postgresql (:scheme db))))) 69 | 70 | (deftest test-format-url 71 | (let [url "postgresql://tiger:scotch@localhost/sqlingvo?a=1&b=2"] 72 | (is (= (url/format (url/parse url)) url))) 73 | (let [url "postgresql://tiger:scotch@localhost:5432/sqlingvo?a=1&b=2"] 74 | (is (= (url/format (url/parse "postgresql://tiger:scotch@localhost:5432/sqlingvo?a=1&b=2")) 75 | "postgresql://tiger:scotch@localhost/sqlingvo?a=1&b=2")))) 76 | -------------------------------------------------------------------------------- /test/sqlingvo/util_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.util-test 2 | (:require [clojure.test :refer [are deftest is]] 3 | [sqlingvo.db :as db] 4 | [sqlingvo.test :refer [db]] 5 | [sqlingvo.util :as util])) 6 | 7 | (deftest test-keyword-str 8 | (are [k expected] (= (util/keyword-str k) expected) 9 | nil nil 10 | :x "x" 11 | :x.y "x.y" 12 | :x/y "x/y")) 13 | 14 | (deftest test-sql-type 15 | (are [type expected] (= (util/sql-type-name db type) expected) 16 | nil nil 17 | :bit-varying "BIT VARYING" 18 | :character-varying "CHARACTER VARYING" 19 | :double-precision "DOUBLE PRECISION" 20 | :json "JSON" 21 | :jsonb "JSONB" 22 | :my-type "my_type" 23 | :smallint "SMALLINT" 24 | :time-with-time-zone "TIME WITH TIME ZONE" 25 | :timestamp-with-time-zone "TIMESTAMP WITH TIME ZONE")) 26 | 27 | (deftest test-sql-quote-backtick 28 | (are [x expected] 29 | (= expected (util/sql-quote-backtick x)) 30 | nil nil 31 | :continents "`continents`" 32 | :continents.name "`continents`.`name`" 33 | :continents.* "`continents`.*" 34 | :EXCLUDED.dname "EXCLUDED.`dname`")) 35 | 36 | (deftest test-sql-quote-double-quote 37 | (are [x expected] 38 | (= expected (util/sql-quote-double-quote x)) 39 | nil nil 40 | :continents "\"continents\"" 41 | :continents.name "\"continents\".\"name\"" 42 | :continents.* "\"continents\".*" 43 | :EXCLUDED.dname "EXCLUDED.\"dname\"")) 44 | 45 | (deftest test-sql-name 46 | (are [x expected] 47 | (and (= expected (util/sql-name (db/db :mysql) x)) 48 | (= expected (util/sql-name (db/db :postgresql) x)) 49 | (= expected (util/sql-name (db/db :vertica) x))) 50 | nil nil 51 | "" "" 52 | "country/id" "country/id" 53 | :a "a" 54 | :a-1 "a-1")) 55 | 56 | (deftest test-sql-keyword 57 | (are [x expected] 58 | (and (= expected (util/sql-keyword (db/db :mysql) x)) 59 | (= expected (util/sql-keyword (db/db :postgresql) x)) 60 | (= expected (util/sql-keyword (db/db :vertica) x))) 61 | nil nil 62 | "" (keyword "") 63 | "country/id" :country/id 64 | :a :a 65 | :a-1 :a-1 66 | :a_1 :a_1)) 67 | 68 | (deftest test-sql-quote 69 | (are [scheme x expected] 70 | (= expected (util/sql-quote (db/db scheme) x)) 71 | :mysql nil nil 72 | :mysql "" "``" 73 | :mysql :a "`a`" 74 | :mysql :a-1 "`a-1`" 75 | :postgresql "" "\"\"" 76 | :postgresql "country/id" "\"country/id\"" 77 | :postgresql :a "\"a\"" 78 | :postgresql :a-1 "\"a-1\"" 79 | :postgresql :EXCLUDED.dname "EXCLUDED.\"dname\"" 80 | :vertica"" "\"\"" 81 | :vertica :a "\"a\"" 82 | :vertica :a-1 "\"a-1\"")) 83 | 84 | (deftest test-sql-placeholder-constant 85 | (let [placeholder (util/sql-placeholder-constant)] 86 | (is (= (placeholder) "?")) 87 | (is (= (placeholder) "?"))) 88 | (let [placeholder (util/sql-placeholder-constant "$")] 89 | (is (= (placeholder) "$")) 90 | (is (= (placeholder) "$")))) 91 | 92 | (deftest test-sql-placeholder-count 93 | (let [placeholder (util/sql-placeholder-count)] 94 | (is (= (placeholder) "$1")) 95 | (is (= (placeholder) "$2"))) 96 | (let [placeholder (util/sql-placeholder-count "?")] 97 | (is (= (placeholder) "?1")) 98 | (is (= (placeholder) "?2")))) 99 | 100 | (deftest test-sql-quote-fn 101 | (are [x expected] 102 | (= (util/sql-quote-fn db x) expected) 103 | "" "\"\"" 104 | "_" "_" 105 | "x" "x" 106 | "1" "\"1\"" 107 | "a b" "\"a b\"")) 108 | -------------------------------------------------------------------------------- /test/sqlingvo/materialized_view_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.materialized-view-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-create-materialized-view-as-values 8 | (sql= (sql/create-materialized-view db :pseudo-source [:key :value] 9 | (sql/values [["a" 1] ["a" 2] ["a" 3] ["a" 4] ["b" 5] ["c" 6] ["c" 7]])) 10 | ["CREATE MATERIALIZED VIEW \"pseudo-source\" (\"key\", \"value\") AS VALUES (?, 1), (?, 2), (?, 3), (?, 4), (?, 5), (?, 6), (?, 7)" 11 | "a" "a" "a" "a" "b" "c" "c"])) 12 | 13 | (deftest test-create-materialized-view-as-select 14 | (sql= (sql/create-materialized-view db :key_sums [] 15 | (sql/select db [:key '(sum :value)] 16 | (sql/from :pseudo_source) 17 | (sql/group-by :key))) 18 | ["CREATE MATERIALIZED VIEW \"key_sums\" AS SELECT \"key\", sum(\"value\") FROM \"pseudo_source\" GROUP BY \"key\""])) 19 | 20 | (deftest test-create-materialized-view-if-not-exists 21 | (sql= (sql/create-materialized-view db :pseudo-source [:key :value] 22 | (sql/values [["a" 1]]) 23 | (sql/if-not-exists true)) 24 | ["CREATE MATERIALIZED VIEW IF NOT EXISTS \"pseudo-source\" (\"key\", \"value\") AS VALUES (?, 1)" "a"])) 25 | 26 | (deftest test-create-materialized-view-or-replace 27 | (sql= (sql/create-materialized-view db :pseudo-source [:key :value] 28 | (sql/values [["a" 1]]) 29 | (sql/or-replace true)) 30 | ["CREATE OR REPLACE MATERIALIZED VIEW \"pseudo-source\" (\"key\", \"value\") AS VALUES (?, 1)" "a"])) 31 | 32 | (deftest test-refresh-materialized-view 33 | (sql= (sql/refresh-materialized-view :postgresql :order-summary) 34 | ["REFRESH MATERIALIZED VIEW \"order-summary\""]) 35 | (sql= (sql/refresh-materialized-view db :order-summary) 36 | ["REFRESH MATERIALIZED VIEW \"order-summary\""]) 37 | (sql= (sql/refresh-materialized-view db :order-summary 38 | (sql/concurrently true)) 39 | ["REFRESH MATERIALIZED VIEW CONCURRENTLY \"order-summary\""]) 40 | (sql= (sql/refresh-materialized-view db :order-summary 41 | (sql/with-data true)) 42 | ["REFRESH MATERIALIZED VIEW \"order-summary\" WITH DATA"]) 43 | (sql= (sql/refresh-materialized-view db :order-summary 44 | (sql/with-data false)) 45 | ["REFRESH MATERIALIZED VIEW \"order-summary\" WITH NO DATA"]) 46 | (sql= (sql/refresh-materialized-view db :order-summary 47 | (sql/concurrently true) 48 | (sql/with-data false)) 49 | ["REFRESH MATERIALIZED VIEW CONCURRENTLY \"order-summary\" WITH NO DATA"])) 50 | 51 | (deftest test-drop-materialized-view 52 | (sql= (sql/drop-materialized-view :postgresql :order-summary) 53 | ["DROP MATERIALIZED VIEW \"order-summary\""]) 54 | (sql= (sql/drop-materialized-view db :order-summary) 55 | ["DROP MATERIALIZED VIEW \"order-summary\""]) 56 | (sql= (sql/drop-materialized-view db :order-summary 57 | (sql/if-exists true)) 58 | ["DROP MATERIALIZED VIEW IF EXISTS \"order-summary\""]) 59 | (sql= (sql/drop-materialized-view db :order-summary 60 | (sql/cascade true)) 61 | ["DROP MATERIALIZED VIEW \"order-summary\" CASCADE"]) 62 | (sql= (sql/drop-materialized-view db :order-summary 63 | (sql/restrict true)) 64 | ["DROP MATERIALIZED VIEW \"order-summary\" RESTRICT"]) 65 | (sql= (sql/drop-materialized-view db :order-summary 66 | (sql/if-exists true) 67 | (sql/cascade true)) 68 | ["DROP MATERIALIZED VIEW IF EXISTS \"order-summary\" CASCADE"])) 69 | -------------------------------------------------------------------------------- /test/sqlingvo/values_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.values-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-values-keyword-db 8 | (sql= (sql/values :postgresql [[1 "one"] [2 "two"] [3 "three"]]) 9 | ["VALUES (1, ?), (2, ?), (3, ?)" 10 | "one" "two" "three"])) 11 | 12 | (deftest test-values 13 | (sql= (sql/values db [[1 "one"] [2 "two"] [3 "three"]]) 14 | ["VALUES (1, ?), (2, ?), (3, ?)" 15 | "one" "two" "three"])) 16 | 17 | (deftest test-values-with-default 18 | (sql= (sql/values db :default) 19 | ["DEFAULT VALUES"])) 20 | 21 | (deftest test-values-with-maps 22 | (sql= (sql/values db [{:code "B6717" 23 | :title "Tampopo"} 24 | {:code "HG120" 25 | :title "The Dinner Game"}]) 26 | ["VALUES (?, ?), (?, ?)" 27 | "B6717" "Tampopo" 28 | "HG120" "The Dinner Game"])) 29 | 30 | (deftest test-values-with-namespaced-keys 31 | (sql= (sql/values db [{:sqlingvo/code "B6717" 32 | :sqlingvo/title "Tampopo"} 33 | {:sqlingvo/code "HG120" 34 | :sqlingvo/title "The Dinner Game"}]) 35 | ["VALUES (?, ?), (?, ?)" 36 | "B6717" "Tampopo" 37 | "HG120" "The Dinner Game"])) 38 | 39 | (deftest test-values-with-exprs 40 | (sql= (sql/values db [['(cast "192.168.0.1" :inet) 41 | "192.168.0.10" 42 | "192.168.1.43"]]) 43 | ["VALUES (CAST(? AS INET), ?, ?)" 44 | "192.168.0.1" 45 | "192.168.0.10" 46 | "192.168.1.43"])) 47 | 48 | (deftest test-select-in-values 49 | (sql= (sql/select db [:*] 50 | (sql/from :machines) 51 | (sql/where `(in :ip-address 52 | ~(sql/values [['(cast "192.168.0.1" :inet)] 53 | ["192.168.0.10"] 54 | ["192.168.1.43"]])))) 55 | [(str "SELECT * FROM \"machines\" WHERE \"ip-address\" " 56 | "IN (VALUES (CAST(? AS INET)), (?), (?))") 57 | "192.168.0.1" 58 | "192.168.0.10" 59 | "192.168.1.43"])) 60 | 61 | (deftest test-select-from-values 62 | (sql= (sql/select db [:f.*] 63 | (sql/from 64 | (sql/as :films :f) 65 | (sql/as (sql/values 66 | [["MGM" "Horror"] 67 | ["UA" "Sci-Fi"]]) 68 | :t [:studio :kind])) 69 | (sql/where 70 | '(and (= :f.studio :t.studio) 71 | (= :f.kind :t.kind)))) 72 | [(str "SELECT \"f\".* FROM \"films\" \"f\", " 73 | "(VALUES (?, ?), (?, ?)) " 74 | "AS \"t\" (\"studio\", \"kind\") " 75 | "WHERE ((\"f\".\"studio\" = \"t\".\"studio\") " 76 | "and (\"f\".\"kind\" = \"t\".\"kind\"))") 77 | "MGM" "Horror" "UA" "Sci-Fi"])) 78 | 79 | (deftest test-update-from-values 80 | (sql= (sql/update db :employees 81 | {:salary '(* :salary :v.increase)} 82 | (sql/from (sql/as 83 | (sql/values 84 | [[1 200000 1.2] 85 | [2 400000 1.4]]) 86 | :v [:depno :target :increase])) 87 | (sql/where 88 | '(and (= :employees.depno :v.depno) 89 | (>= :employees.sales :v.target)))) 90 | [(str "UPDATE \"employees\" " 91 | "SET \"salary\" = (\"salary\" * \"v\".\"increase\") " 92 | "FROM (VALUES (1, 200000, 1.2), (2, 400000, 1.4)) " 93 | "AS \"v\" (\"depno\", \"target\", \"increase\") " 94 | "WHERE ((\"employees\".\"depno\" = \"v\".\"depno\") " 95 | "and (\"employees\".\"sales\" >= \"v\".\"target\"))")])) 96 | -------------------------------------------------------------------------------- /test/sqlingvo/compiler_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.compiler-test 2 | (:require [clojure.test :refer [are deftest is]] 3 | [sqlingvo.compiler :as compiler :refer [compile-sql]] 4 | [sqlingvo.core :as sql] 5 | [sqlingvo.expr :as expr] 6 | [sqlingvo.test :refer [db]])) 7 | 8 | (deftest test-compile-column 9 | (are [ast expected] (= expected (compile-sql db ast)) 10 | (expr/parse-column :*) 11 | ["*"] 12 | 13 | (expr/parse-column :continents.*) 14 | ["\"continents\".*"] 15 | 16 | (expr/parse-column :created-at) 17 | ["\"created-at\""] 18 | 19 | (expr/parse-column :continents.created-at) 20 | ["\"continents\".\"created-at\""] 21 | 22 | (expr/parse-column :public.continents.created-at) 23 | ["\"public\".\"continents\".\"created-at\""] 24 | 25 | (sql/as (expr/parse-column :public.continents.created-at) :c) 26 | ["\"public\".\"continents\".\"created-at\" AS \"c\""])) 27 | 28 | (deftest test-compile-constant 29 | (are [ast expected] 30 | (= expected (compile-sql db ast)) 31 | {:op :constant 32 | :form 1 33 | :type :number 34 | :val 1} 35 | ["1"] 36 | {:op :constant 37 | :form 3.14 38 | :type :number 39 | :val 3.14} 40 | ["3.14"] 41 | {:op :constant 42 | :form "x" 43 | :type :string 44 | :val "x"} 45 | ["?" "x"])) 46 | 47 | (deftest test-compile-sql 48 | (are [ast expected] 49 | (= (compile-sql db (expr/parse-expr ast)) expected) 50 | nil 51 | ["NULL"] 52 | 1 53 | ["1"] 54 | :continents.created-at 55 | ["\"continents\".\"created-at\""] 56 | '(max :created-at) 57 | ["max(\"created-at\")"] 58 | '(greatest 1 2) 59 | ["greatest(1, 2)"] 60 | '(st_astext (st_centroid "MULTIPOINT(-1 0, -1 2, -1 3, -1 4, -1 7, 0 1, 0 3, 1 1, 2 0, 6 0, 7 8, 9 8, 10 6)")) 61 | ["st_astext(st_centroid(?))" "MULTIPOINT(-1 0, -1 2, -1 3, -1 4, -1 7, 0 1, 0 3, 1 1, 2 0, 6 0, 7 8, 9 8, 10 6)"])) 62 | 63 | (deftest test-compile-drop-table 64 | (are [ast expected] 65 | (= expected (compile-sql db ast)) 66 | {:op :drop-table :tables [{:op :table :name :continents}]} 67 | ["DROP TABLE \"continents\""] 68 | {:op :drop-table :tables [{:op :table :name :continents}] :cascade {:op :cascade :cascade true}} 69 | ["DROP TABLE \"continents\" CASCADE"] 70 | {:op :drop-table :tables [{:op :table :name :continents}] :restrict {:op :restrict :restrict true}} 71 | ["DROP TABLE \"continents\" RESTRICT"] 72 | {:op :drop-table :tables [{:op :table :name :continents}] :if-exists {:op :if-exists :if-exists true}} 73 | ["DROP TABLE IF EXISTS \"continents\""] 74 | {:op :drop-table :tables [{:op :table :name :continents}] 75 | :cascade {:op :cascade :cascade true} 76 | :restrict {:op :restrict :restrict true} 77 | :if-exists {:op :if-exists :if-exists true}} 78 | ["DROP TABLE IF EXISTS \"continents\" CASCADE RESTRICT"])) 79 | 80 | (deftest test-compile-table 81 | (are [ast expected] 82 | (= expected (compile-sql db ast)) 83 | {:op :table :name :continents} 84 | ["\"continents\""] 85 | {:op :table 86 | :schema :public 87 | :name :continents} 88 | ["\"public\".\"continents\""] 89 | {:op :alias 90 | :expr {:op :table :schema :public :name :continents} 91 | :name :c} 92 | ["\"public\".\"continents\" \"c\""])) 93 | 94 | (deftest test-wrap-stmt 95 | (are [stmt expected] 96 | (= (compiler/wrap-stmt stmt) expected) 97 | ["SELECT 1"] 98 | ["(SELECT 1)"] 99 | ["SELECT ?" "x"] 100 | ["(SELECT ?)" "x"])) 101 | 102 | (deftest test-unwrap-stmt 103 | (are [stmt expected] 104 | (= (compiler/unwrap-stmt stmt) expected) 105 | ["(SELECT 1)"] 106 | ["SELECT 1"] 107 | ["(SELECT ?)" "x"] 108 | ["SELECT ?" "x"])) 109 | 110 | (deftest test-compile-stmt-returns-vector 111 | (let [sql (compiler/compile-stmt (sql/ast (sql/select db [1])))] 112 | (is (vector? sql)) 113 | (is (= sql ["SELECT 1"])))) 114 | -------------------------------------------------------------------------------- /test/sqlingvo/with_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.with-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-with-keyword-db 8 | (sql= (sql/with :postgresql [:a (sql/select :postgresql [:*] (sql/from :b))] 9 | (sql/select :postgresql [:*] 10 | (sql/from :a) 11 | (sql/where '(= 1 1)))) 12 | ["WITH \"a\" AS (SELECT * FROM \"b\") SELECT * FROM \"a\" WHERE (1 = 1)"])) 13 | 14 | (deftest test-with-query 15 | (sql= (sql/with db [:regional-sales 16 | (sql/select db [:region (sql/as '(sum :amount) :total-sales)] 17 | (sql/from :orders) 18 | (sql/group-by :region)) 19 | :top-regions 20 | (sql/select db [:region] 21 | (sql/from :regional-sales) 22 | (sql/where `(> :total-sales 23 | ~(sql/select db ['(/ (sum :total-sales) 10)] 24 | (sql/from :regional-sales)))))] 25 | (sql/select db [:region :product 26 | (sql/as '(sum :quantity) :product-units) 27 | (sql/as '(sum :amount) :product-sales)] 28 | (sql/from :orders) 29 | (sql/where `(in :region 30 | ~(sql/select db [:region] 31 | (sql/from :top-regions)))) 32 | (sql/group-by :region :product))) 33 | [(str "WITH \"regional-sales\" AS (" 34 | "SELECT \"region\", sum(\"amount\") AS \"total-sales\" " 35 | "FROM \"orders\" GROUP BY \"region\"), " 36 | "\"top-regions\" AS (" 37 | "SELECT \"region\" " 38 | "FROM \"regional-sales\" " 39 | "WHERE (\"total-sales\" > (SELECT (sum(\"total-sales\") / 10) FROM \"regional-sales\"))) " 40 | "SELECT \"region\", \"product\", sum(\"quantity\") AS \"product-units\", sum(\"amount\") AS \"product-sales\" " 41 | "FROM \"orders\" " 42 | "WHERE \"region\" IN (SELECT \"region\" " 43 | "FROM \"top-regions\") " 44 | "GROUP BY \"region\", \"product\"")])) 45 | 46 | (deftest test-with-modify-data 47 | (sql= (sql/with db [:moved-rows 48 | (sql/delete db :products 49 | (sql/where '(and (>= :date "2010-10-01") 50 | (< :date "2010-11-01"))) 51 | (sql/returning :*))] 52 | (sql/insert db :product-logs [] 53 | (sql/select db [:*] (sql/from :moved-rows)))) 54 | [(str "WITH \"moved-rows\" AS (" 55 | "DELETE FROM \"products\" " 56 | "WHERE ((\"date\" >= ?) and (\"date\" < ?)) " 57 | "RETURNING *) " 58 | "INSERT INTO \"product-logs\" SELECT * FROM \"moved-rows\"") 59 | "2010-10-01" "2010-11-01"])) 60 | 61 | (deftest test-with-counter-update 62 | (sql= (sql/with db [:upsert (sql/update db :counter-table 63 | '((= counter counter+1)) 64 | (sql/where '(= :id "counter-name")) 65 | (sql/returning :*))] 66 | (sql/insert db :counter-table [:id :counter] 67 | (sql/select db ["counter-name" 1]) 68 | (sql/where `(not-exists 69 | ~(sql/select db [:*] 70 | (sql/from :upsert)))))) 71 | [(str "WITH \"upsert\" AS (" 72 | "UPDATE \"counter-table\" SET counter = counter+1 " 73 | "WHERE (\"id\" = ?) RETURNING *) " 74 | "INSERT INTO \"counter-table\" (\"id\", \"counter\") " 75 | "SELECT ?, 1 " 76 | "WHERE (NOT EXISTS (SELECT * FROM \"upsert\"))") 77 | "counter-name" "counter-name"])) 78 | 79 | (deftest test-with-delete 80 | (sql= (sql/with db [:t (sql/delete db :foo)] 81 | (sql/delete db :bar)) 82 | ["WITH \"t\" AS (DELETE FROM \"foo\") DELETE FROM \"bar\""])) 83 | 84 | (deftest test-with-compose 85 | (sql= (sql/with db [:a (sql/select db [:*] (sql/from :b))] 86 | (sql/compose 87 | (sql/select db [:*] (sql/from :a)) 88 | (sql/where '(= 1 1)))) 89 | ["WITH \"a\" AS (SELECT * FROM \"b\") SELECT * FROM \"a\" WHERE (1 = 1)"])) 90 | 91 | (deftest test-insert-from-with 92 | (sql= (sql/insert db :c [:id] 93 | (sql/with db [:a (sql/select db [:a.id] 94 | (sql/from :a))] 95 | (sql/select db [:b.id] 96 | (sql/from :b) 97 | (sql/where `(in :b.id 98 | ~(sql/select db [:a.id] 99 | (sql/from :a))))))) 100 | [(str "INSERT INTO \"c\" (\"id\") " 101 | "WITH \"a\" AS (SELECT \"a\".\"id\" FROM \"a\") " 102 | "SELECT \"b\".\"id\" FROM \"b\" WHERE \"b\".\"id\" " 103 | "IN (SELECT \"a\".\"id\" FROM \"a\")")])) 104 | -------------------------------------------------------------------------------- /test/sqlingvo/update_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.update-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-update-keyword-db 8 | (sql= (sql/update :postgresql :films 9 | {:kind "Dramatic"} 10 | (sql/where '(= :kind "Drama"))) 11 | ["UPDATE \"films\" SET \"kind\" = ? WHERE (\"kind\" = ?)" 12 | "Dramatic" "Drama"])) 13 | 14 | (deftest test-update-drama-to-dramatic 15 | (sql= (sql/update db :films 16 | {:kind "Dramatic"} 17 | (sql/where '(= :kind "Drama"))) 18 | ["UPDATE \"films\" SET \"kind\" = ? WHERE (\"kind\" = ?)" 19 | "Dramatic" "Drama"])) 20 | 21 | (deftest test-update-drama-to-dramatic-returning 22 | (sql= (sql/update db :films 23 | {:kind "Dramatic"} 24 | (sql/where '(= :kind "Drama")) 25 | (sql/returning :*)) 26 | ["UPDATE \"films\" SET \"kind\" = ? WHERE (\"kind\" = ?) RETURNING *" 27 | "Dramatic" "Drama"])) 28 | 29 | (deftest test-update-daily-return 30 | (sql= (sql/update db :quotes 31 | '((= :daily-return :u.daily-return)) 32 | (sql/where '(= :quotes.id :u.id)) 33 | (sql/from (sql/as 34 | (sql/select db [:id (sql/as '((lag :close) over (partition by :company-id order by :date desc)) :daily-return)] 35 | (sql/from :quotes)) 36 | :u))) 37 | [(str "UPDATE \"quotes\" " 38 | "SET \"daily-return\" = \"u\".\"daily-return\" " 39 | "FROM (SELECT \"id\", lag(\"close\") over (partition by \"company-id\" order by \"date\" desc) AS \"daily-return\" FROM \"quotes\") AS \"u\" WHERE (\"quotes\".\"id\" = \"u\".\"id\")")])) 40 | 41 | (deftest test-update-prices 42 | (let [quote {:id 1}] 43 | (sql= (sql/update db :prices 44 | '((= :daily-return :u.daily-return)) 45 | (sql/from 46 | (sql/as (sql/select db [:id (sql/as '(- (/ :close ((lag :close) over (partition by :quote-id order by :date desc))) 1) :daily-return)] 47 | (sql/from :prices) 48 | (sql/where `(= :prices.quote-id ~(:id quote)))) 49 | :u)) 50 | (sql/where `(and (= :prices.id :u.id) 51 | (= :prices.quote-id ~(:id quote))))) 52 | [(str "UPDATE \"prices\" SET \"daily-return\" = \"u\".\"daily-return\" " 53 | "FROM (SELECT \"id\", ((\"close\" / lag(\"close\") over (partition by \"quote-id\" order by \"date\" desc)) - 1) AS \"daily-return\" " 54 | "FROM \"prices\" WHERE (\"prices\".\"quote-id\" = 1)) AS \"u\" WHERE ((\"prices\".\"id\" = \"u\".\"id\") and (\"prices\".\"quote-id\" = 1))")]))) 55 | 56 | (deftest test-update-airports 57 | (sql= (sql/update db :airports 58 | '((= :country-id :u.id) 59 | (= :gps-code :u.gps-code) 60 | (= :wikipedia-url :u.wikipedia) 61 | (= :location :u.geom)) 62 | (sql/from 63 | (sql/as 64 | (sql/select db (sql/distinct [:c.id :a.name :a.gps-code :a.iata-code :a.wikipedia :a.geom] :on [:a.iata-code]) 65 | (sql/from (sql/as :natural-earth.airports :a)) 66 | (sql/join (sql/as :countries :c) '(on (:&& :c.geography :a.geom))) 67 | (sql/join :airports '(on (= (lower :airports.iata-code) (lower :a.iata-code))) :type :left) 68 | (sql/where '(and (is-not-null :a.gps-code) 69 | (is-not-null :a.iata-code) 70 | (is-not-null :airports.iata-code)))) 71 | :u)) 72 | (sql/where '(= :airports.iata-code :u.iata-code))) 73 | [(str "UPDATE \"airports\" SET \"country-id\" = \"u\".\"id\", \"gps-code\" = \"u\".\"gps-code\", \"wikipedia-url\" = \"u\".\"wikipedia\", \"location\" = \"u\".\"geom\" " 74 | "FROM (SELECT DISTINCT ON (\"a\".\"iata-code\") \"c\".\"id\", \"a\".\"name\", \"a\".\"gps-code\", \"a\".\"iata-code\", \"a\".\"wikipedia\", \"a\".\"geom\" " 75 | "FROM \"natural-earth\".\"airports\" \"a\" JOIN \"countries\" \"c\" ON (\"c\".\"geography\" && \"a\".\"geom\") " 76 | "LEFT JOIN \"airports\" ON (lower(\"airports\".\"iata-code\") = lower(\"a\".\"iata-code\")) " 77 | "WHERE ((\"a\".\"gps-code\" IS NOT NULL) and (\"a\".\"iata-code\" IS NOT NULL) and (\"airports\".\"iata-code\" IS NOT NULL))) AS \"u\" " 78 | "WHERE (\"airports\".\"iata-code\" = \"u\".\"iata-code\")")])) 79 | 80 | (deftest test-update-countries 81 | (sql= (sql/update db :countries 82 | '((= :geom :u.geom)) 83 | (sql/from 84 | (sql/as 85 | (sql/select db [:iso-a2 :iso-a3 :iso-n3 :geom] 86 | (sql/from :natural-earth.countries)) :u)) 87 | (sql/where '(or (= (lower :countries.iso-3166-1-alpha-2) (lower :u.iso-a2)) 88 | (= (lower :countries.iso-3166-1-alpha-3) (lower :u.iso-a3))))) 89 | [(str "UPDATE \"countries\" SET \"geom\" = \"u\".\"geom\" FROM (SELECT \"iso-a2\", \"iso-a3\", \"iso-n3\", \"geom\" FROM \"natural-earth\".\"countries\") AS \"u\" " 90 | "WHERE ((lower(\"countries\".\"iso-3166-1-alpha-2\") = lower(\"u\".\"iso-a2\")) or (lower(\"countries\".\"iso-3166-1-alpha-3\") = lower(\"u\".\"iso-a3\")))")])) 91 | 92 | (deftest test-update-with-fn-call 93 | (sql= (sql/update db :films 94 | {:name '(lower :name)} 95 | (sql/where `(= :id 1))) 96 | [(str "UPDATE \"films\" " 97 | "SET \"name\" = lower(\"name\") " 98 | "WHERE (\"id\" = 1)")])) 99 | 100 | (deftest test-update-cast-custom-type 101 | (sql= (sql/update db :people 102 | {:mood '(cast "happy" :mood-type)} 103 | (sql/where {:name "Larry"})) 104 | ["UPDATE \"people\" SET \"mood\" = CAST(? AS mood_type) WHERE " "happy"])) 105 | -------------------------------------------------------------------------------- /src/sqlingvo/util.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.util 2 | (:require [clojure.string :refer [join replace split]] 3 | [sqlingvo.expr :as expr] 4 | [clojure.string :as str]) 5 | (:refer-clojure :exclude [replace])) 6 | 7 | (def ^:dynamic *reserved* 8 | "A set of reserved words that should not be quoted." 9 | #{"EXCLUDED" "DEFAULT"}) 10 | 11 | (def sql-type-names 12 | "Mapping from Clojure keywords to SQL type names." 13 | {:bigint "BIGINT" 14 | :bigserial "BIGSERIAL" 15 | :bit "BIT" 16 | :bit-varying "BIT VARYING" 17 | :boolean "BOOLEAN" 18 | :box "BOX" 19 | :bytea "BYTEA" 20 | :char "CHAR" 21 | :character "CHARACTER" 22 | :character-varying "CHARACTER VARYING" 23 | :cidr "CIDR" 24 | :circle "CIRCLE" 25 | :date "DATE" 26 | :document "DOCUMENT" 27 | :double-precision "DOUBLE PRECISION" 28 | :geography "GEOGRAPHY" 29 | :geometry "GEOMETRY" 30 | :inet "INET" 31 | :int "INT" 32 | :integer "INTEGER" 33 | :interval "INTERVAL" 34 | :json "JSON" 35 | :jsonb "JSONB" 36 | :line "LINE" 37 | :lseg "LSEG" 38 | :macaddr "MACADDR" 39 | :money "MONEY" 40 | :numeric "NUMERIC" 41 | :path "PATH" 42 | :point "POINT" 43 | :polygon "POLYGON" 44 | :real "REAL" 45 | :serial "SERIAL" 46 | :smallint "SMALLINT" 47 | :text "TEXT" 48 | :time-with-time-zone "TIME WITH TIME ZONE" 49 | :time-without-time-zone "TIME WITHOUT TIME ZONE" 50 | :timestamp-with-time-zone "TIMESTAMP WITH TIME ZONE" 51 | :timestamp-without-time-zone "TIMESTAMP WITHOUT TIME ZONE" 52 | :tsquery "TSQUERY" 53 | :tsvector "TSVECTOR" 54 | :txid-snapshot "TXID_SNAPSHOT" 55 | :uuid "UUID" 56 | :varchar "VARCHAR" 57 | :xml "XML"}) 58 | 59 | (defn keyword-str 60 | "Return the qualified name of the keyword `k` as a string." 61 | [k] 62 | (cond 63 | (or (keyword? k) 64 | (symbol? k)) 65 | (if (namespace k) 66 | (str (namespace k) "/" (name k)) 67 | (str (name k))) 68 | (string? k) 69 | k)) 70 | 71 | (defn m-bind [mv mf] 72 | (fn [state] 73 | (let [[temp-v temp-state] (mv state) 74 | new-mv (mf temp-v)] 75 | (new-mv temp-state)))) 76 | 77 | (defn m-result [x] 78 | (fn [state] 79 | [x state])) 80 | 81 | (defn m-seq 82 | "'Executes' the monadic values in ms and returns a sequence of the 83 | basic values contained in them." 84 | [ms] 85 | (reduce (fn [q p] 86 | (m-bind p (fn [x] 87 | (m-bind q (fn [y] 88 | (m-result (cons x y)))) ))) 89 | (m-result '()) 90 | (reverse ms))) 91 | 92 | (defn set-val [k v] 93 | (fn [stmt] 94 | [v (assoc stmt k v)])) 95 | 96 | (defn assoc-op [op & {:as opts}] 97 | (set-val op (assoc opts :op op))) 98 | 99 | (defn build-condition 100 | "Helper to build WHERE and HAVING conditions." 101 | [condition-type condition & [combine]] 102 | (let [condition (expr/parse-condition condition)] 103 | (fn [stmt] 104 | (cond 105 | (or (nil? combine) 106 | (nil? (:condition (condition-type stmt)))) 107 | [nil (assoc stmt condition-type condition)] 108 | :else 109 | [nil (assoc-in 110 | stmt [condition-type :condition] 111 | (expr/make-node 112 | :op :condition 113 | :children [:condition] 114 | :condition 115 | {:op :list 116 | ;; TODOD: Use :times, :children is reserved for keywords. 117 | :children 118 | [(expr/parse-expr combine) 119 | (:condition (condition-type stmt)) 120 | (:condition condition)]}))])))) 121 | 122 | (defn concat-in [ks coll] 123 | (fn [stmt] 124 | [nil (if (empty? coll) 125 | stmt (update-in stmt ks #(concat %1 coll)))])) 126 | 127 | (defn dissoc-op [k] 128 | (fn [stmt] 129 | [nil (dissoc stmt k)])) 130 | 131 | (defn sequential 132 | "Returns `x` as a sequential data structure." 133 | [x] 134 | (if (sequential? x) 135 | x [x])) 136 | 137 | (defn conditional-clause [clause condition] 138 | (if condition 139 | (assoc-op clause) 140 | (dissoc-op clause))) 141 | 142 | (defn- split-sql-name [x] 143 | (if x (split (name x) #"\."))) 144 | 145 | (defn- map-sql-name [f x] 146 | (->> (split-sql-name x) 147 | (map f) 148 | (join "."))) 149 | 150 | (defn sql-name-underscore [x] 151 | (map-sql-name #(replace %1 "-" "_") x)) 152 | 153 | (defn sql-keyword-hyphenate [x] 154 | (keyword (map-sql-name #(replace (name %1) "_" "-") x))) 155 | 156 | (defn- sql-quote-char [x before after] 157 | (cond 158 | (nil? x) 159 | x 160 | (= "*" x) 161 | "*" 162 | (contains? *reserved* x) 163 | x 164 | :else 165 | (str before x after))) 166 | 167 | (defn sql-quote-backtick [x] 168 | (when x (map-sql-name #(sql-quote-char %1 "`" "`") x))) 169 | 170 | (defn sql-quote-double-quote [x] 171 | (when x (map-sql-name #(sql-quote-char %1 "\"" "\"") x))) 172 | 173 | (defn sql-name 174 | "Return the `db` specific SQL name for `x`." 175 | [db x] 176 | (when x 177 | ((or (:sql-name db) keyword-str) x))) 178 | 179 | (defn sql-keyword 180 | "Return the `db` specific SQL keyword for `x`." 181 | [db x] 182 | (when x 183 | ((or (:sql-keyword db) keyword) x))) 184 | 185 | (defn sql-quote 186 | "Return the `db` specific quoted string for `x`." 187 | [db x] 188 | (when x 189 | ((or (:sql-quote db) sql-quote-double-quote) 190 | (sql-name db x)))) 191 | 192 | (defn sql-quote-fn 193 | "Quote an SQL identifier only if needed." 194 | [db x] 195 | (when x 196 | (if (re-matches #"[a-z_][a-z0-9_]*" (name x)) 197 | (sql-name db x) 198 | (sql-quote db x)))) 199 | 200 | (defn sql-placeholder-constant 201 | "Returns a fn that uses a constant strategy to produce 202 | placeholders." 203 | [& [placeholder]] 204 | (let [placeholder (str (or placeholder "?"))] 205 | (constantly placeholder))) 206 | 207 | (defn sql-placeholder-count 208 | "Returns a fn that uses a counting strategy to produce 209 | placeholders." 210 | [& [prefix]] 211 | (let [counter (atom 0) 212 | prefix (str (or prefix "$"))] 213 | #(str prefix (swap! counter inc)))) 214 | 215 | (defmulti sql-type-name 216 | "Return the SQL name for the `type` keyword." 217 | (fn [db type] type)) 218 | 219 | (defmethod sql-type-name :default [db type] 220 | (or (get sql-type-names type) (some-> type sql-name-underscore))) 221 | -------------------------------------------------------------------------------- /test/sqlingvo/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.core-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.pprint :refer [pprint]] 5 | [clojure.string :as str] 6 | [clojure.test :refer [are deftest is]] 7 | [sqlingvo.core :as sql] 8 | [sqlingvo.util :as util] 9 | [clojure.spec.test.alpha :as stest])) 10 | 11 | (stest/instrument) 12 | 13 | (deftest test-excluded-keyword 14 | (are [arg expected] 15 | (= (sql/excluded-keyword arg) expected) 16 | nil nil 17 | :a :EXCLUDED.a)) 18 | 19 | (deftest test-excluded-kw-map 20 | (are [arg expected] 21 | (= (sql/excluded-kw-map arg) expected) 22 | nil 23 | nil 24 | {:a 1} 25 | {:a :EXCLUDED.a} 26 | [:a] 27 | {:a :EXCLUDED.a})) 28 | 29 | (deftest test-column 30 | (are [column expected] 31 | (= (sql/ast column) expected) 32 | (sql/column :id :serial :primary-key? true) 33 | {:columns [:id], 34 | :column 35 | {:id 36 | {:schema nil, 37 | :children [:name], 38 | :table nil, 39 | :primary-key? true, 40 | :default nil, 41 | :name :id, 42 | :val :id, 43 | :type :serial, 44 | :op :column, 45 | :form :id}}})) 46 | 47 | (deftest test-from 48 | (let [[from stmt] ((sql/from :continents) {})] 49 | (is (= [{:op :table 50 | :children [:name] 51 | :name :continents 52 | :form :continents 53 | :val :continents}] 54 | from)) 55 | (is (= {:from 56 | [{:op :table 57 | :children [:name] 58 | :name :continents 59 | :form :continents 60 | :val :continents}]} 61 | stmt)))) 62 | 63 | ;; COMPOSE 64 | 65 | (deftest test-compose 66 | (sql= (sql/compose 67 | (sql/select db [:id :name] 68 | (sql/from :continents)) 69 | (sql/where '(= :id 1)) 70 | (sql/order-by :name)) 71 | [(str "SELECT \"id\", \"name\" " 72 | "FROM \"continents\" " 73 | "WHERE (\"id\" = 1) " 74 | "ORDER BY \"name\"")])) 75 | 76 | (deftest test-compose-where-clause-using-and 77 | (sql= (sql/compose 78 | (sql/compose 79 | (sql/select db [:color :num-sides] 80 | (sql/from :shapes)) 81 | (sql/where '(= :num-sides 3))) 82 | (sql/where '(= :color "green") :and)) 83 | [(str "SELECT \"color\", \"num-sides\" " 84 | "FROM \"shapes\" " 85 | "WHERE ((\"num-sides\" = 3) and (\"color\" = ?))") 86 | "green"])) 87 | 88 | (deftest test-compose-selects 89 | (sql= (sql/compose 90 | (sql/select db [1 2 3]) 91 | (sql/select db [3 2 1])) 92 | ["SELECT 3, 2, 1"])) 93 | 94 | ;; AS 95 | 96 | (deftest test-as 97 | (are [args expected] (= (apply sql/as args) expected) 98 | [:id :other] 99 | {:op :alias 100 | :children [:expr :name] 101 | :expr {:children [:name] 102 | :name :id 103 | :op :column 104 | :form :id 105 | :val :id} 106 | :name :other 107 | :columns []} 108 | ['(count :*) :count] 109 | {:op :alias 110 | :children [:expr :name] 111 | :columns [] 112 | :expr 113 | {:op :list 114 | :children 115 | [{:form 'count 116 | :op :constant 117 | :type :symbol 118 | :val 'count} 119 | {:children [:name] 120 | :name :* 121 | :val :* 122 | :op :column 123 | :form :*}]} 124 | :name :count})) 125 | 126 | ;; CAST 127 | 128 | (deftest test-cast-int-as-double-precision 129 | (sql= (sql/select db [`(cast 1 :double-precision)]) 130 | ["SELECT CAST(1 AS DOUBLE PRECISION)"])) 131 | 132 | (deftest test-cast-int-as-text 133 | (sql= (sql/select db [`(cast 1 :text)]) 134 | ["SELECT CAST(1 AS TEXT)"])) 135 | 136 | (deftest test-cast-text-as-int 137 | (sql= (sql/select db [`(cast "1" :int)]) 138 | ["SELECT CAST(? AS INT)" "1"])) 139 | 140 | (deftest test-cast-with-alias 141 | (sql= (sql/select db [(sql/as `(cast "1" :int) :numeric-id)]) 142 | ["SELECT CAST(? AS INT) AS \"numeric-id\"" "1"])) 143 | 144 | (deftest test-sql-placeholder-constant 145 | (let [db (assoc db :sql-placeholder util/sql-placeholder-constant)] 146 | (sql= (sql/select db [:*] 147 | (sql/from :distributors) 148 | (sql/where '(and (= :dname "Anvil Distribution") 149 | (= :zipcode "21201")))) 150 | [(str "SELECT * FROM \"distributors\" " 151 | "WHERE ((\"dname\" = ?) and (\"zipcode\" = ?))") 152 | "Anvil Distribution" "21201"]))) 153 | 154 | (deftest test-sql-placeholder-count 155 | (let [db (assoc db :sql-placeholder util/sql-placeholder-count)] 156 | (sql= (sql/select db [:*] 157 | (sql/from :distributors) 158 | (sql/where '(and (= :dname "Anvil Distribution") 159 | (= :zipcode "21201")))) 160 | [(str "SELECT * FROM \"distributors\" " 161 | "WHERE ((\"dname\" = $1) and (\"zipcode\" = $2))") 162 | "Anvil Distribution" "21201"]))) 163 | 164 | (deftest test-sql-placeholder-count-subselect 165 | (let [db (assoc db :sql-placeholder util/sql-placeholder-count)] 166 | (sql= (sql/select db ["a" "b" :*] 167 | (sql/from (sql/as (sql/select db ["c" "d"]) :x))) 168 | ["SELECT $1, $2, * FROM (SELECT $3, $4) AS \"x\"" "a" "b" "c" "d"]))) 169 | 170 | (deftest test-pprint 171 | (is (= (with-out-str (pprint (sql/select db [1]))) 172 | "[\"SELECT 1\"]\n"))) 173 | 174 | (deftest test-table 175 | (is (= (sql/table :my-table 176 | (sql/column :a :serial :primary-key? true) 177 | (sql/column :b :text)) 178 | {:children [:name], 179 | :columns [:a :b], 180 | :name :my-table, 181 | :val :my-table, 182 | :op :table, 183 | :column 184 | {:a 185 | {:schema nil, 186 | :children [:name], 187 | :table :my-table, 188 | :primary-key? true, 189 | :default nil, 190 | :name :a, 191 | :val :a, 192 | :type :serial, 193 | :op :column, 194 | :form :a}, 195 | :b 196 | {:children [:name], 197 | :name :b, 198 | :val :b, 199 | :op :column, 200 | :form :b, 201 | :type :text, 202 | :default nil, 203 | :schema nil, 204 | :table :my-table}}, 205 | :form :my-table}))) 206 | -------------------------------------------------------------------------------- /src/sqlingvo/expr.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.expr 2 | (:require [clojure.spec.alpha :as s] 3 | [clojure.string :as str] 4 | [sqlingvo.spec :as spec])) 5 | 6 | (def ^:dynamic *column-regex* 7 | "The regular expression used to parse a column identifier." 8 | #"(([^./]+)\.)?(([^./]+)\.)?([^./]+)") 9 | 10 | (def ^:dynamic *table-regex* 11 | "The regular expression used to parse a table identifier." 12 | #"(([^./]+)\.)?([^./]+)") 13 | 14 | (def ^:dynamic *type-regex* 15 | "The regular expression used to parse a type." 16 | #"(([^./]+)\.)?([^./]+)") 17 | 18 | (defprotocol IExpr 19 | (-parse-expr [x] "Parse `x` and return the AST of a SQL expression.")) 20 | 21 | (defn attribute? 22 | "Returns true if `form` is an attribute for a composite type." 23 | [form] 24 | (and (symbol? form) 25 | (str/starts-with? (str form) ".-"))) 26 | 27 | (defn parse-expr 28 | "Parse the SQL expression `x` into an AST." 29 | [x] 30 | (-parse-expr x)) 31 | 32 | (defn parse-exprs 33 | "Parse the SQL expressions `xs` into an AST." 34 | [xs] 35 | (mapv parse-expr (remove nil? xs))) 36 | 37 | (deftype Stmt [f] 38 | #?(:clj clojure.lang.IDeref :cljs cljs.core/IDeref) 39 | (#?(:clj deref :cljs -deref) [stmt] 40 | (let [ast (second (f nil))] 41 | ((:eval-fn (:db ast)) stmt))) 42 | #?(:clj clojure.lang.IFn :cljs cljs.core/IFn) 43 | (#?(:clj invoke :cljs -invoke) [this n] 44 | (f n))) 45 | 46 | (defn ast 47 | "Returns the abstract syntax tree of `stmt`." 48 | [stmt] 49 | (cond 50 | (map? stmt) 51 | stmt 52 | (instance? Stmt stmt) 53 | (second (#?(:clj (.f stmt) :cljs (.-f stmt)) nil)) 54 | :else (second (stmt nil)))) 55 | 56 | (defn stmt [x] 57 | (Stmt. x)) 58 | 59 | (defn unintern-name 60 | "Returns `x` without any namespace." 61 | [x] 62 | (cond 63 | (string? x) 64 | x 65 | (or (keyword? x) (symbol? x)) 66 | (name x))) 67 | 68 | (defn make-node [& {:as node}] 69 | (assert (:op node) (str "Missing :op in make-node: " (pr-str node))) 70 | (if-not (empty? (:children node)) 71 | (reduce (fn [node child] 72 | (if (nil? (get node child)) 73 | (dissoc node child) 74 | (update-in node [:children] conj child))) 75 | (assoc node :children []) 76 | (:children node)) 77 | node)) 78 | 79 | (defn parse-column 80 | "Parse `s` as a column identifier and return a map 81 | with :op, :schema, :name and :as keys." 82 | [s] 83 | (cond 84 | (s/valid? :sqlingvo/alias s) s 85 | (s/valid? :sqlingvo/column s) s 86 | (or (string? s) (keyword? s)) 87 | (if-let [matches (re-matches *column-regex* (name s))] 88 | (let [[_ _ schema _ table name _] matches] 89 | (cond-> (make-node 90 | :op :column 91 | :children [:schema :table :name :as] 92 | :form s 93 | :schema (if (and schema table) (keyword schema)) 94 | :table (keyword (or table schema)) 95 | :name (keyword name) 96 | :val s) 97 | (and (keyword? s) (namespace s)) 98 | (assoc :ns (namespace s))))))) 99 | 100 | (s/fdef parse-column 101 | :args (s/cat :s :sqlingvo.column/identifier) 102 | :ret (s/nilable :sqlingvo/column)) 103 | 104 | (defn parse-table 105 | "Parse `s` as a table identifier and return a map 106 | with :op, :schema, :name and :as keys." 107 | [s] 108 | (cond 109 | (s/valid? :sqlingvo/alias s) s 110 | (map? s) s 111 | (or (string? s) (keyword? s)) 112 | (if-let [matches (re-matches *table-regex* (name s))] 113 | (cond-> (make-node 114 | :op :table 115 | :children [:schema :name :as] 116 | :form s 117 | :schema (keyword (nth matches 2)) 118 | :name (keyword (nth matches 3)) 119 | :val s) 120 | (and (keyword? s) (namespace s)) 121 | (assoc :ns (namespace s)))))) 122 | 123 | (s/fdef parse-table 124 | :args (s/cat :s :sqlingvo.table/identifier) 125 | :ret (s/nilable :sqlingvo/table)) 126 | 127 | (defn- parse-attr-expr [expr] 128 | (make-node 129 | :op :attr 130 | :children [:arg] 131 | :name (keyword (str/replace (name (first expr)) ".-" "")) 132 | :arg (parse-expr (first (rest expr))))) 133 | 134 | (defn parse-map-expr [m] 135 | (into {} (for [[k v] m] [k (parse-expr v) ]))) 136 | 137 | (defn parse-condition [condition] 138 | {:op :condition 139 | :condition (parse-expr condition)}) 140 | 141 | (defn parse-from [forms] 142 | (cond 143 | (or (string? forms) 144 | (keyword? forms)) 145 | (parse-table forms) 146 | (and (map? forms) 147 | (= :alias (:op forms)) 148 | (= :column (-> forms :expr :op))) 149 | (assoc forms :expr (parse-table (-> forms :expr :form))) 150 | (and (map? forms) (= :alias (:op forms))) 151 | forms 152 | (and (map? forms) (= :list (:op forms))) 153 | forms 154 | (and (map? forms) (= :select (:op forms))) 155 | forms 156 | (and (map? forms) (= :table (:op forms))) 157 | forms 158 | (and (map? forms) (:as forms)) 159 | (make-node 160 | :op :table 161 | :children [:schema :name :as] 162 | :as (:as forms) 163 | :schema (:table forms) 164 | :name (:name forms)) 165 | (list? forms) 166 | (parse-expr forms) 167 | :else (throw (ex-info "Can't parse FROM form." {:forms forms})))) 168 | 169 | (defn- parse-constant 170 | "Parse the `constant` of `type`." 171 | [type constant] 172 | {:form constant 173 | :op :constant 174 | :type type 175 | :val constant}) 176 | 177 | (s/fdef parse-constant 178 | :args (s/cat :type keyword? :constant any?) 179 | :ret map?) 180 | 181 | (defn parse-type 182 | "Parse the `type`." 183 | [type] 184 | (when-let [[_ _ schema name] (re-matches *type-regex* (name type))] 185 | {:form type 186 | :name name 187 | :op :type 188 | :schema schema})) 189 | 190 | (s/fdef parse-type 191 | :args (s/cat :type keyword?) 192 | :ret map?) 193 | 194 | (defn parse-schema 195 | "Parse the `schema`." 196 | [schema] 197 | {:form schema 198 | :op :schema 199 | :name (name schema)}) 200 | 201 | (s/fdef parse-schema 202 | :args (s/cat :schema keyword?) 203 | :ret map?) 204 | 205 | #?(:clj 206 | (extend-protocol IExpr 207 | 208 | clojure.lang.IPersistentMap 209 | (-parse-expr [x] 210 | x) 211 | 212 | java.lang.Double 213 | (-parse-expr [x] 214 | (parse-constant :number x)) 215 | 216 | java.lang.Integer 217 | (-parse-expr [x] 218 | (parse-constant :number x)) 219 | 220 | java.lang.Long 221 | (-parse-expr [x] 222 | (parse-constant :number x)) 223 | 224 | java.util.Date 225 | (-parse-expr [x] 226 | (parse-constant :date x)))) 227 | 228 | #?(:cljs 229 | (extend-protocol IExpr 230 | number 231 | (-parse-expr [x] 232 | (parse-constant :number x)) 233 | 234 | cljs.core/PersistentArrayMap 235 | (-parse-expr [x] 236 | x) 237 | 238 | cljs.core/PersistentHashMap 239 | (-parse-expr [x] 240 | x) 241 | 242 | cljs.core/EmptyList 243 | (-parse-expr [x] 244 | {:op :list}) 245 | 246 | js/Date 247 | (-parse-expr [x] 248 | (parse-constant :date x)))) 249 | 250 | (extend-protocol IExpr 251 | 252 | nil 253 | (-parse-expr [x] 254 | {:form x 255 | :op :nil 256 | :type :nil 257 | :val x}) 258 | 259 | Stmt 260 | (-parse-expr [stmt] 261 | (first (stmt {}))) 262 | 263 | #?(:clj Boolean :cljs boolean) 264 | (-parse-expr [x] 265 | (parse-constant :boolean x)) 266 | 267 | #?(:clj clojure.lang.Cons :cljs cljs.core/Cons) 268 | (-parse-expr [x] 269 | (-parse-expr (apply list x))) 270 | 271 | #?(:clj clojure.lang.Keyword :cljs cljs.core/Keyword) 272 | (-parse-expr [x] 273 | (parse-column x)) 274 | 275 | #?(:clj clojure.lang.Symbol :cljs cljs.core/Symbol) 276 | (-parse-expr [x] 277 | {:form x 278 | :op :constant 279 | :type :symbol 280 | :val (symbol (name x))}) 281 | 282 | #?(:clj clojure.lang.IPersistentMap :cljs cljs.core/PersistentArrayMap) 283 | (-parse-expr [x] 284 | x) 285 | 286 | #?(:clj clojure.lang.PersistentVector :cljs cljs.core/PersistentVector) 287 | (-parse-expr [x] 288 | {:op :array 289 | :children (mapv parse-expr x)}) 290 | 291 | #?(:clj java.util.List :cljs cljs.core/List) 292 | (-parse-expr [expr] 293 | (cond 294 | (attribute? (first expr)) 295 | (parse-attr-expr expr) 296 | (or (list? (first expr)) 297 | (instance? #?(:clj clojure.lang.Cons :cljs cljs.core/Cons) (first expr))) 298 | {:op :expr-list 299 | :children (mapv parse-expr expr) 300 | :as (:as expr)} 301 | :else 302 | {:op :list 303 | :children (mapv parse-expr expr)})) 304 | 305 | #?(:clj String :cljs string) 306 | (-parse-expr [x] 307 | (parse-constant :string x)) 308 | 309 | #?(:clj Object :cljs object) 310 | (-parse-expr [x] 311 | (parse-constant :object x))) 312 | -------------------------------------------------------------------------------- /test/sqlingvo/create_table_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.create-table-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [are deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-create-table-keyword-db 8 | (sql= (sql/create-table :postgresql :measurement-y2006m02 9 | (sql/inherits :measurement)) 10 | ["CREATE TABLE \"measurement-y2006m02\" () INHERITS (\"measurement\")"])) 11 | 12 | (deftest test-create-table-inherits 13 | (sql= (sql/create-table db :measurement-y2006m02 14 | (sql/inherits :measurement)) 15 | ["CREATE TABLE \"measurement-y2006m02\" () INHERITS (\"measurement\")"])) 16 | 17 | (deftest test-create-table-inherits-check 18 | (sql= (sql/create-table db :measurement-y2006m02 19 | (sql/check '(and (>= :logdate (cast "2006-02-01" :date)) 20 | (< :logdate (cast "2006-03-01" :date)))) 21 | (sql/inherits :measurement)) 22 | [(str "CREATE TABLE \"measurement-y2006m02\" (" 23 | "CHECK ((\"logdate\" >= CAST(? AS DATE)) and " 24 | "(\"logdate\" < CAST(? AS DATE)))) " 25 | "INHERITS (\"measurement\")") 26 | "2006-02-01" "2006-03-01"])) 27 | 28 | (deftest test-create-table-inherits-check-multiple 29 | (sql= (sql/create-table db :measurement-y2006m02 30 | (sql/check '(and (>= :logdate (cast "2006-02-01" :date)) 31 | (< :logdate (cast "2006-03-01" :date)))) 32 | (sql/inherits :measurement)) 33 | [(str "CREATE TABLE \"measurement-y2006m02\" (" 34 | "CHECK ((\"logdate\" >= CAST(? AS DATE)) and " 35 | "(\"logdate\" < CAST(? AS DATE)))) " 36 | "INHERITS (\"measurement\")") 37 | "2006-02-01" "2006-03-01"])) 38 | 39 | (deftest test-create-table-inherits-check-like 40 | (sql= (sql/create-table db :measurement-y2006m02 41 | (sql/like :measurements :including [:all]) 42 | (sql/check '(>= :logdate (cast "2006-02-01" :date))) 43 | (sql/check '(< :logdate (cast "2006-03-01" :date))) 44 | (sql/inherits :measurement)) 45 | [(str "CREATE TABLE \"measurement-y2006m02\" (" 46 | "LIKE \"measurements\" INCLUDING ALL, " 47 | "CHECK (\"logdate\" >= CAST(? AS DATE)), " 48 | "CHECK (\"logdate\" < CAST(? AS DATE))) " 49 | "INHERITS (\"measurement\")") 50 | "2006-02-01" "2006-03-01"])) 51 | 52 | (deftest test-create-table-tmp-if-not-exists-inherits 53 | (sql= (sql/create-table db :import 54 | (sql/temporary true) 55 | (sql/if-not-exists true) 56 | (sql/inherits :quotes)) 57 | [(str "CREATE TEMPORARY TABLE IF NOT EXISTS " 58 | "\"import\" () INHERITS (\"quotes\")")])) 59 | 60 | (deftest test-create-table-tmp-if-not-exists-false 61 | (sql= (sql/create-table db :import 62 | (sql/temporary true) 63 | (sql/if-not-exists false) 64 | (sql/inherits :quotes)) 65 | ["CREATE TEMPORARY TABLE \"import\" () INHERITS (\"quotes\")"])) 66 | 67 | (deftest test-create-table-like-including-defaults 68 | (sql= (sql/create-table db :tmp-films 69 | (sql/like :films :including [:defaults])) 70 | ["CREATE TABLE \"tmp-films\" (LIKE \"films\" INCLUDING DEFAULTS)"])) 71 | 72 | (deftest test-create-table-like-excluding-indexes 73 | (sql= (sql/create-table db :tmp-films 74 | (sql/like :films :excluding [:indexes])) 75 | ["CREATE TABLE \"tmp-films\" (LIKE \"films\" EXCLUDING INDEXES)"])) 76 | 77 | (deftest test-create-table-films 78 | (sql= (sql/create-table db :films 79 | (sql/column :code :char :size 5 :primary-key? true) 80 | (sql/column :title :varchar :size 40 :not-null? true) 81 | (sql/column :did :integer :not-null? true) 82 | (sql/column :date-prod :date) 83 | (sql/column :kind :varchar :size 10) 84 | (sql/column :len :interval) 85 | (sql/column :created-at :timestamp-with-time-zone :not-null? true :default '(now)) 86 | (sql/column :updated-at :timestamp-with-time-zone :not-null? true :default '(now))) 87 | [(str "CREATE TABLE \"films\" (" 88 | "\"code\" CHAR(5) PRIMARY KEY, " 89 | "\"title\" VARCHAR(40) NOT NULL, " 90 | "\"did\" INTEGER NOT NULL, " 91 | "\"date-prod\" DATE, " 92 | "\"kind\" VARCHAR(10), " 93 | "\"len\" INTERVAL, " 94 | "\"created-at\" TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT now(), " 95 | "\"updated-at\" TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT now())")])) 96 | 97 | (deftest test-create-table-compound-primary-key 98 | (sql= (sql/create-table db :ratings 99 | (sql/column :id :serial) 100 | (sql/column :user-id :integer :not-null? true) 101 | (sql/column :spot-id :integer :not-null? true) 102 | (sql/column :rating :integer :not-null? true) 103 | (sql/column :created-at :timestamp-with-time-zone :not-null? true :default '(now)) 104 | (sql/column :updated-at :timestamp-with-time-zone :not-null? true :default '(now)) 105 | (sql/primary-key :user-id :spot-id :created-at)) 106 | [(str "CREATE TABLE \"ratings\" (" 107 | "\"id\" SERIAL, " 108 | "\"user-id\" INTEGER NOT NULL, " 109 | "\"spot-id\" INTEGER NOT NULL, " 110 | "\"rating\" INTEGER NOT NULL, " 111 | "\"created-at\" TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT now(), " 112 | "\"updated-at\" TIMESTAMP WITH " 113 | "TIME ZONE NOT NULL DEFAULT now(), " 114 | "PRIMARY KEY(\"user-id\", \"spot-id\", \"created-at\"))")])) 115 | 116 | (deftest test-create-table-references-schema-table-column 117 | (sql= (sql/create-table db :countries 118 | (sql/column :id :serial) 119 | (sql/column :continent-id :integer :references :public.continents.id)) 120 | [(str "CREATE TABLE \"countries\" (" 121 | "\"id\" SERIAL, \"continent-id\" INTEGER REFERENCES \"public\".\"continents\" (\"id\"))")])) 122 | 123 | (deftest test-create-table-references-table-column 124 | (sql= (sql/create-table db :countries 125 | (sql/column :id :serial) 126 | (sql/column :continent-id :integer :references :continents.id)) 127 | [(str "CREATE TABLE \"countries\" (" 128 | "\"id\" SERIAL, \"continent-id\" INTEGER REFERENCES \"continents\" (\"id\"))")])) 129 | 130 | (deftest test-create-table-references-table 131 | (sql= (sql/create-table db :countries 132 | (sql/column :id :serial) 133 | (sql/column :continent-id :integer :references :continents)) 134 | [(str "CREATE TABLE \"countries\" (" 135 | "\"id\" SERIAL, \"continent-id\" INTEGER REFERENCES \"continents\")")])) 136 | 137 | (deftest test-create-table-array-column 138 | (sql= (sql/create-table db :ratings 139 | (sql/column :x :text :array? true)) 140 | ["CREATE TABLE \"ratings\" (\"x\" TEXT[])"])) 141 | 142 | (deftest test-create-table-geometry 143 | (sql= (sql/create-table db :my-table 144 | (sql/column :my-geom :geometry)) 145 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY)"])) 146 | 147 | (deftest test-create-table-geography 148 | (sql= (sql/create-table db :my-table 149 | (sql/column :my-geom :geography)) 150 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOGRAPHY)"])) 151 | 152 | (deftest test-create-table-geometry-collection 153 | (sql= (sql/create-table db :my-table 154 | (sql/column :my-geom :geometry :geometry :geometry-collection)) 155 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY(GEOMETRYCOLLECTION))"])) 156 | 157 | (deftest test-create-table-line-string 158 | (sql= (sql/create-table db :my-table 159 | (sql/column :my-geom :geometry :geometry :line-string)) 160 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY(LINESTRING))"])) 161 | 162 | (deftest test-create-table-multi-line-string 163 | (sql= (sql/create-table db :my-table 164 | (sql/column :my-geom :geometry :geometry :multi-line-string)) 165 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY(MULTILINESTRING))"])) 166 | 167 | (deftest test-create-table-multi-polygon 168 | (sql= (sql/create-table db :my-table 169 | (sql/column :my-geom :geometry :geometry :multi-polygon)) 170 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY(MULTIPOLYGON))"])) 171 | 172 | (deftest test-create-table-multi-point 173 | (sql= (sql/create-table db :my-table 174 | (sql/column :my-geom :geometry :geometry :multi-point)) 175 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY(MULTIPOINT))"])) 176 | 177 | (deftest test-create-table-point 178 | (sql= (sql/create-table db :my-table 179 | (sql/column :my-geom :geometry :geometry :point)) 180 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY(POINT))"])) 181 | 182 | (deftest test-create-table-point-srid 183 | (sql= (sql/create-table db :my-table 184 | (sql/column :my-geom :geometry :geometry :point :srid 4326)) 185 | ["CREATE TABLE \"my-table\" (\"my-geom\" GEOMETRY(POINT, 4326))"])) 186 | -------------------------------------------------------------------------------- /test/sqlingvo/expr_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.expr-test 2 | (:require [clojure.test :refer [are deftest is]] 3 | [sqlingvo.core :refer [as select values]] 4 | [sqlingvo.expr :as expr] 5 | [sqlingvo.test :refer [db]])) 6 | 7 | (deftest test-parse-column 8 | (are [column expected] (= (expr/parse-column column) expected) 9 | :id 10 | {:op :column 11 | :children [:name] 12 | :name :id 13 | :form :id 14 | :val :id} 15 | 16 | :continents.id 17 | {:op :column 18 | :children [:table :name] 19 | :table :continents 20 | :name :id 21 | :form :continents.id 22 | :val :continents.id} 23 | 24 | :public.continents.id 25 | {:op :column 26 | :children [:schema :table :name] 27 | :schema :public 28 | :table :continents 29 | :name :id 30 | :form :public.continents.id 31 | :val :public.continents.id} 32 | 33 | :continent/id 34 | {:op :column 35 | :children [:name] 36 | :name :id 37 | :ns "continent" 38 | :form :continent/id 39 | :val :continent/id} 40 | 41 | (expr/parse-column :continents.id) 42 | (expr/parse-column :continents.id))) 43 | 44 | (deftest test-parse-table 45 | (are [table expected] (= (expr/parse-table table) expected) 46 | :continents 47 | {:op :table 48 | :children [:name] 49 | :name :continents 50 | :form :continents 51 | :val :continents} 52 | 53 | :public.continents 54 | {:op :table 55 | :children [:schema :name] 56 | :schema :public 57 | :name :continents 58 | :form :public.continents 59 | :val :public.continents} 60 | 61 | :sqlingvo/continents 62 | {:op :table 63 | :children [:name] 64 | :name :continents 65 | :ns "sqlingvo" 66 | :form :sqlingvo/continents 67 | :val :sqlingvo/continents} 68 | 69 | (expr/parse-table :public.continents) 70 | (expr/parse-table :public.continents))) 71 | 72 | (deftest test-parse-expr 73 | (are [expr expected] (= (expr/parse-expr expr) expected) 74 | :* 75 | {:children [:name] 76 | :name :* 77 | :op :column 78 | :val :* 79 | :form :*} 80 | 1 81 | {:op :constant 82 | :form 1 83 | :type :number 84 | :val 1} 85 | 1.0 86 | {:op :constant 87 | :form 1.0 88 | :type :number 89 | :val 1.0} 90 | "x" 91 | {:op :constant 92 | :form "x" 93 | :type :string 94 | :val "x"} 95 | '(= 1 1) 96 | {:op :list 97 | :children 98 | [(expr/parse-expr '=) 99 | (expr/parse-expr 1) 100 | (expr/parse-expr 1)]} 101 | `(= 1 1) 102 | {:op :list 103 | :children 104 | [(expr/parse-expr `=) 105 | (expr/parse-expr 1) 106 | (expr/parse-expr 1)]} 107 | '(= :name "Europe") 108 | {:op :list 109 | :children 110 | [(expr/parse-expr '=) 111 | (expr/parse-expr :name) 112 | (expr/parse-expr "Europe")]} 113 | '(max 1 2) 114 | {:op :list 115 | :children 116 | [(expr/parse-expr 'max) 117 | (expr/parse-expr 1) 118 | (expr/parse-expr 2)]} 119 | '(max 1 (max 2 3)) 120 | {:op :list 121 | :children 122 | [(expr/parse-expr 'max) 123 | (expr/parse-expr 1) 124 | (expr/parse-expr '(max 2 3))]} 125 | '(now) 126 | {:op :list 127 | :children [(expr/parse-expr 'now)]} 128 | '(in 1 (1 2 3)) 129 | {:op :list 130 | :children 131 | [(expr/parse-expr 'in) 132 | (expr/parse-expr 1) 133 | (expr/parse-expr '(1 2 3))]} 134 | '(.-val :x) 135 | {:op :attr 136 | :children [:arg] 137 | :name :val 138 | :arg (expr/parse-expr :x)} 139 | '(.-val (new-emp)) 140 | {:children [:arg] 141 | :name :val 142 | :op :attr 143 | :arg 144 | {:op :list 145 | :children 146 | [{:form 'new-emp 147 | :op :constant 148 | :type :symbol 149 | :val 'new-emp}]}})) 150 | 151 | (deftest test-parse-expr-object 152 | (let [obj #?(:clj (Object.) :cljs (js/Object.))] 153 | (is (= (expr/parse-expr obj) 154 | {:form obj 155 | :op :constant 156 | :type :object 157 | :val obj})))) 158 | 159 | (deftest test-parse-expr-select 160 | (is (= (expr/parse-expr (select db [1])) 161 | {:op :select 162 | :children [:exprs] 163 | :db db 164 | :exprs 165 | [{:val 1 166 | :type :number 167 | :op :constant 168 | :form 1}]}))) 169 | 170 | (deftest test-parse-expr-values 171 | (is (= (expr/parse-expr 172 | (values db [["MGM" "Horror"] 173 | ["UA" "Sci-Fi"]])) 174 | {:op :values 175 | :db db 176 | :columns nil 177 | :type :exprs 178 | :values 179 | [[{:val "MGM" 180 | :type :string 181 | :op :constant 182 | :form "MGM"} 183 | {:val "Horror" 184 | :type :string 185 | :op :constant 186 | :form "Horror"}] 187 | [{:val "UA" 188 | :type :string 189 | :op :constant 190 | :form "UA"} 191 | {:val "Sci-Fi" 192 | :type :string 193 | :op :constant 194 | :form "Sci-Fi"}]]}))) 195 | 196 | (deftest test-parse-expr-list 197 | (is (= (expr/parse-expr '((lag :close) over (partition by :company-id order by :date desc))) 198 | '{:op :expr-list, 199 | :children 200 | [{:op :list, 201 | :children 202 | [{:form lag, :op :constant, :type :symbol, :val lag} 203 | {:children [:name], 204 | :name :close, 205 | :val :close, 206 | :op :column, 207 | :form :close}]} 208 | {:form over, :op :constant, :type :symbol, :val over} 209 | {:op :list, 210 | :children 211 | [{:form partition, :op :constant, :type :symbol, :val partition} 212 | {:form by, :op :constant, :type :symbol, :val by} 213 | {:children [:name], 214 | :name :company-id, 215 | :val :company-id, 216 | :op :column, 217 | :form :company-id} 218 | {:form order, :op :constant, :type :symbol, :val order} 219 | {:form by, :op :constant, :type :symbol, :val by} 220 | {:children [:name], 221 | :name :date, 222 | :val :date, 223 | :op :column, 224 | :form :date} 225 | {:form desc, :op :constant, :type :symbol, :val desc}]}], 226 | :as nil}))) 227 | 228 | (deftest test-parse-expr-backquote 229 | (is (= (expr/parse-expr `(count :*)) 230 | {:op :list 231 | :children 232 | [{:form #?(:clj 'clojure.core/count :cljs 'cljs.core/count) 233 | :op :constant 234 | :type :symbol 235 | :val 'count} 236 | {:children [:name] 237 | :name :* 238 | :val :* 239 | :op :column 240 | :form :*}]})) 241 | (is (= (expr/parse-expr `((~'lag (~'count :*) 1))) 242 | (expr/parse-expr '((lag (count :*) 1))))) 243 | (is (= (expr/parse-expr 244 | `((~'lag (~'count :*) 1) ~'over 245 | (~'partition ~'by :quote-id ~'order ~'by (~'date :tweets.created-at)))) 246 | (expr/parse-expr 247 | '((lag (count :*) 1) over 248 | (partition by :quote-id order by (date :tweets.created-at))))))) 249 | 250 | (deftest test-parse-condition-backquote 251 | (is (= (expr/parse-condition `(in 1 (1 2 3))) 252 | {:op :condition, 253 | :condition (expr/parse-expr `(in 1 (1 2 3)))}))) 254 | 255 | (deftest test-parse-from 256 | (are [from expected] 257 | (= (expr/parse-from from) expected) 258 | "continents" 259 | {:children [:name] 260 | :form "continents" 261 | :name :continents 262 | :op :table 263 | :val "continents"} 264 | 265 | :continents 266 | {:children [:name] 267 | :form :continents 268 | :name :continents 269 | :op :table 270 | :val :continents} 271 | 272 | '(generate_series 0 10) 273 | {:op :list 274 | :children 275 | [(expr/parse-expr 'generate_series) 276 | (expr/parse-expr 0) 277 | (expr/parse-expr 10)]} 278 | 279 | (as :countries :c) 280 | {:op :alias 281 | :children [:expr :name] 282 | :expr 283 | {:children [:name] 284 | :name :countries 285 | :op :table 286 | :form :countries 287 | :val :countries} 288 | :name :c 289 | :columns []})) 290 | 291 | (deftest test-parse-expr-array 292 | (is (= (expr/parse-expr [1 2]) 293 | {:op :array 294 | :children 295 | [(expr/parse-expr 1) 296 | (expr/parse-expr 2)]}))) 297 | 298 | (deftest test-deref-statement 299 | (is (= @(select db [1]) 300 | ["SELECT 1"]))) 301 | 302 | (deftest test-unintern-name 303 | (are [k expected] 304 | (= (expr/unintern-name k) expected) 305 | :a "a" 306 | :a/b "b" 307 | 'a "a" 308 | 'a/b "b" 309 | `a "a" 310 | `a "a" 311 | "a/b" "a/b")) 312 | 313 | (deftest test-parse-type 314 | (are [k expected] 315 | (= (expr/parse-type k) expected) 316 | :mood 317 | {:form :mood 318 | :name "mood" 319 | :op :type 320 | :schema nil} 321 | :my-schema.mood 322 | {:form :my-schema.mood 323 | :name "mood" 324 | :op :type 325 | :schema "my-schema"})) 326 | -------------------------------------------------------------------------------- /test/sqlingvo/insert_test.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.insert-test 2 | (:require #?(:clj [sqlingvo.test :refer [db sql=]] 3 | :cljs [sqlingvo.test :refer [db] :refer-macros [sql=]]) 4 | [clojure.test :refer [deftest is]] 5 | [sqlingvo.core :as sql])) 6 | 7 | (deftest test-insert-keyword-db 8 | (sql= (sql/insert :postgresql :films [] 9 | (sql/values :default)) 10 | ["INSERT INTO \"films\" DEFAULT VALUES"])) 11 | 12 | (deftest test-insert-default-values 13 | (sql= (sql/insert db :films [] 14 | (sql/values :default)) 15 | ["INSERT INTO \"films\" DEFAULT VALUES"])) 16 | 17 | (deftest test-insert-single-row-as-seq 18 | (sql= (sql/insert db :films [] 19 | (sql/values [{:code "T-601" 20 | :title "Yojimbo" 21 | :did 106 22 | :date-prod "1961-06-16" 23 | :kind "Drama"}])) 24 | [(str "INSERT INTO \"films\" " 25 | "(\"code\", \"date-prod\", \"did\", \"kind\", \"title\") " 26 | "VALUES (?, ?, 106, ?, ?)") 27 | "T-601" "1961-06-16" "Drama" "Yojimbo"])) 28 | 29 | (deftest test-insert-multi-row 30 | (sql= (sql/insert db :films [] 31 | (sql/values [{:code "B6717" 32 | :title "Tampopo" 33 | :did 110 34 | :date-prod "1985-02-10" 35 | :kind "Comedy"}, 36 | {:code "HG120" 37 | :title "The Dinner Game" 38 | :did 140 39 | :date-prod "1985-02-10" 40 | :kind "Comedy"}])) 41 | [(str "INSERT INTO \"films\" " 42 | "(\"code\", \"date-prod\", \"did\", \"kind\", \"title\") " 43 | "VALUES (?, ?, 110, ?, ?), (?, ?, 140, ?, ?)") 44 | "B6717" "1985-02-10" "Comedy" "Tampopo" 45 | "HG120" "1985-02-10" "Comedy" "The Dinner Game"])) 46 | 47 | (deftest test-insert-returning 48 | (sql= (sql/insert db :distributors [] 49 | (sql/values [{:did 106 :dname "XYZ Widgets"}]) 50 | (sql/returning :*)) 51 | [(str "INSERT INTO \"distributors\" (\"did\", \"dname\") " 52 | "VALUES (106, ?) RETURNING *") 53 | "XYZ Widgets"])) 54 | 55 | (deftest test-insert-subselect 56 | (sql= (sql/insert db :films [] 57 | (sql/select db [:*] 58 | (sql/from :tmp-films) 59 | (sql/where '(< :date-prod "2004-05-07")))) 60 | [(str "INSERT INTO \"films\" SELECT * FROM \"tmp-films\" " 61 | "WHERE (\"date-prod\" < ?)") 62 | "2004-05-07"])) 63 | 64 | (deftest test-insert-airports 65 | (sql= (sql/insert db :airports [:country-id, :name :gps-code :iata-code :wikipedia-url :location] 66 | (sql/select db (sql/distinct [:c.id :a.name :a.gps-code :a.iata-code :a.wikipedia :a.geom] :on [:a.iata-code]) 67 | (sql/from (sql/as :natural-earth.airports :a)) 68 | (sql/join (sql/as :countries :c) '(on (:&& :c.geography :a.geom))) 69 | (sql/join :airports '(on (= :airports.iata-code :a.iata-code)) :type :left) 70 | (sql/where '(and (is-not-null :a.gps-code) 71 | (is-not-null :a.iata-code) 72 | (is-null :airports.iata-code))))) 73 | [(str "INSERT INTO \"airports\" (\"country-id\", \"name\", \"gps-code\", \"iata-code\", \"wikipedia-url\", \"location\") " 74 | "SELECT DISTINCT ON (\"a\".\"iata-code\") \"c\".\"id\", \"a\".\"name\", \"a\".\"gps-code\", \"a\".\"iata-code\", \"a\".\"wikipedia\", \"a\".\"geom\" " 75 | "FROM \"natural-earth\".\"airports\" \"a\" JOIN \"countries\" \"c\" ON (\"c\".\"geography\" && \"a\".\"geom\") " 76 | "LEFT JOIN \"airports\" ON (\"airports\".\"iata-code\" = \"a\".\"iata-code\") " 77 | "WHERE ((\"a\".\"gps-code\" IS NOT NULL) and (\"a\".\"iata-code\" IS NOT NULL) and (\"airports\".\"iata-code\" IS NULL))")])) 78 | 79 | (deftest test-insert-only-columns 80 | (sql= (sql/insert db :x [:a :b] (sql/values [{:a 1 :b 2 :c 3}])) 81 | ["INSERT INTO \"x\" (\"a\", \"b\") VALUES (1, 2)"])) 82 | 83 | (deftest test-insert-values-with-fn-call 84 | (sql= (sql/insert db :x [:a :b] 85 | (sql/values [{:a 1 :b '(lower "B")} 86 | {:a 2 :b "b"}])) 87 | [(str "INSERT INTO \"x\" (\"a\", \"b\") " 88 | "VALUES (1, lower(?)), (2, ?)") 89 | "B" "b"])) 90 | 91 | (deftest test-insert-fixed-columns-mixed-values 92 | (sql= (sql/insert db :table [:a :b] 93 | (sql/values [{:a 1 :b 2} {:b 3} {:c 3}])) 94 | [(str "INSERT INTO \"table\" (\"a\", \"b\") VALUES (1, 2), " 95 | "(NULL, 3), (NULL, NULL)")])) 96 | 97 | (deftest test-insert-fixed-columns-mixed-values-2 98 | (sql= (sql/insert db :quotes [:id :exchange-id :company-id 99 | :symbol :created-at :updated-at] 100 | (sql/values [{:updated-at #inst "2012-11-02T18:22:59.688-00:00" 101 | :created-at #inst "2012-11-02T18:22:59.688-00:00" 102 | :symbol "MSFT" 103 | :exchange-id 2 104 | :company-id 5 105 | :id 5} 106 | {:updated-at #inst "2012-11-02T18:22:59.688-00:00" 107 | :created-at #inst "2012-11-02T18:22:59.688-00:00" 108 | :symbol "SPY" 109 | :exchange-id 2 110 | :id 6}])) 111 | [(str "INSERT INTO \"quotes\" (\"id\", \"exchange-id\", " 112 | "\"company-id\", \"symbol\", \"created-at\", \"updated-at\") " 113 | "VALUES (5, 2, 5, ?, ?, ?), (6, 2, NULL, ?, ?, ?)") 114 | "MSFT" 115 | #inst "2012-11-02T18:22:59.688-00:00" 116 | #inst "2012-11-02T18:22:59.688-00:00" 117 | "SPY" 118 | #inst "2012-11-02T18:22:59.688-00:00" 119 | #inst "2012-11-02T18:22:59.688-00:00"])) 120 | 121 | (deftest test-insert-array 122 | (sql= (sql/insert db :test [:x] (sql/values [{:x ["1" 2]}])) 123 | ["INSERT INTO \"test\" (\"x\") VALUES (ARRAY[?, 2])" "1"])) 124 | 125 | (deftest test-insert-on-conflict-do-update 126 | (sql= (sql/insert db :distributors [:did :dname] 127 | (sql/values [{:did 5 :dname "Gizmo Transglobal"} 128 | {:did 6 :dname "Associated Computing, Inc"}]) 129 | (sql/on-conflict [:did] 130 | (sql/do-update {:dname :EXCLUDED.dname}))) 131 | [(str "INSERT INTO \"distributors\" (\"did\", \"dname\") " 132 | "VALUES (5, ?), (6, ?) " 133 | "ON CONFLICT (\"did\") " 134 | "DO UPDATE SET \"dname\" = EXCLUDED.\"dname\"") 135 | "Gizmo Transglobal" 136 | "Associated Computing, Inc"])) 137 | 138 | (deftest test-insert-on-conflict-do-nothing 139 | (sql= (sql/insert db :distributors [:did :dname] 140 | (sql/values [{:did 7 :dname "Redline GmbH"}]) 141 | (sql/on-conflict [:did] 142 | (sql/do-nothing))) 143 | [(str "INSERT INTO \"distributors\" (\"did\", \"dname\") " 144 | "VALUES (7, ?) " 145 | "ON CONFLICT (\"did\") " 146 | "DO NOTHING") 147 | "Redline GmbH"])) 148 | 149 | (deftest test-insert-on-conflict-do-nothing-returning 150 | (sql= (sql/insert db :distributors [:did :dname] 151 | (sql/values [{:did 7 :dname "Redline GmbH"}]) 152 | (sql/on-conflict [:did] 153 | (sql/do-nothing)) 154 | (sql/returning :*)) 155 | [(str "INSERT INTO \"distributors\" (\"did\", \"dname\") " 156 | "VALUES (7, ?) " 157 | "ON CONFLICT (\"did\") " 158 | "DO NOTHING " 159 | "RETURNING *") 160 | "Redline GmbH"])) 161 | 162 | (deftest test-insert-on-conflict-do-update-where 163 | (sql= (sql/insert db (sql/as :distributors :d) [:did :dname] 164 | (sql/values [{:did 8 :dname "Anvil Distribution"}]) 165 | (sql/on-conflict [:did] 166 | (sql/do-update {:dname '(:|| :EXCLUDED.dname " (formerly " :d.dname ")")}) 167 | (sql/where '(:<> :d.zipcode "21201")))) 168 | [(str "INSERT INTO \"distributors\" AS \"d\" (\"did\", \"dname\") " 169 | "VALUES (8, ?) " 170 | "ON CONFLICT (\"did\") " 171 | "DO UPDATE SET \"dname\" = (EXCLUDED.\"dname\" || ? || \"d\".\"dname\" || ?) " 172 | "WHERE (\"d\".\"zipcode\" <> ?)") 173 | "Anvil Distribution" " (formerly " ")" "21201"])) 174 | 175 | (deftest test-insert-on-conflict-where-do-nothing 176 | (sql= (sql/insert db :distributors [:did :dname] 177 | (sql/values [{:did 10 :dname "Conrad International"}]) 178 | (sql/on-conflict [:did] 179 | (sql/where '(= :is-active true)) 180 | (sql/do-nothing))) 181 | [(str "INSERT INTO \"distributors\" (\"did\", \"dname\") " 182 | "VALUES (10, ?) " 183 | "ON CONFLICT (\"did\") " 184 | "WHERE (\"is-active\" = ?) DO NOTHING") 185 | "Conrad International" true])) 186 | 187 | (deftest test-insert-on-conflict-on-constraint-do-nothing 188 | (sql= (sql/insert db :distributors [:did :dname] 189 | (sql/values [{:did 9 :dname "Antwerp Design"}]) 190 | (sql/on-conflict-on-constraint :distributors_pkey 191 | (sql/do-nothing))) 192 | [(str "INSERT INTO \"distributors\" (\"did\", \"dname\") " 193 | "VALUES (9, ?) " 194 | "ON CONFLICT ON CONSTRAINT \"distributors_pkey\" " 195 | "DO NOTHING") 196 | "Antwerp Design"])) 197 | 198 | (deftest test-insert-expression-row 199 | (sql= (sql/insert db :films [:code :title :did :date-prod :kind] 200 | (sql/values [["T_601" "Yojimbo" 106 "1961-06-16" "Drama"]])) 201 | [(str "INSERT INTO \"films\" (\"code\", \"title\", \"did\", " 202 | "\"date-prod\", \"kind\") VALUES (?, ?, 106, ?, ?)") 203 | "T_601" "Yojimbo" "1961-06-16" "Drama"])) 204 | 205 | (deftest test-insert-expression-rows 206 | (sql= (sql/insert db :films [] 207 | (sql/values [["UA502" "Bananas" 105 :DEFAULT "Comedy" "82 minutes"] 208 | ["T_601" "Yojimbo" 106 :DEFAULT "Drama" :DEFAULT]])) 209 | [(str "INSERT INTO \"films\" VALUES " 210 | "(?, ?, 105, DEFAULT, ?, ?), " 211 | "(?, ?, 106, DEFAULT, ?, DEFAULT)") 212 | "UA502" "Bananas" "Comedy" "82 minutes" 213 | "T_601" "Yojimbo" "Drama"])) 214 | 215 | (deftest test-insert-cast-custom-type 216 | (sql= (sql/insert db :people [] 217 | (sql/values [{:name "Larry" 218 | :mood '(cast "happy" :mood-type)}])) 219 | ["INSERT INTO \"people\" (\"mood\", \"name\") VALUES (CAST(? AS mood_type), ?)" 220 | "happy" "Larry"])) 221 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of Washington and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /src/sqlingvo/core.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.core 2 | (:refer-clojure :exclude [distinct group-by replace update]) 3 | (:require [#?(:clj clojure.pprint :cljs cljs.pprint) :refer [simple-dispatch]] 4 | [clojure.spec.alpha :as s] 5 | [clojure.string :as str] 6 | [sqlingvo.compiler :as compiler] 7 | [sqlingvo.db :as db] 8 | [sqlingvo.expr :as expr] 9 | [sqlingvo.util :as util])) 10 | 11 | (defn db 12 | "Return a new database for `spec`." 13 | [spec & [opts]] 14 | (db/db spec opts)) 15 | 16 | (defn db? 17 | "Return true if `x` is a database, otherwise false." 18 | [x] 19 | (instance? sqlingvo.db.Database x)) 20 | 21 | (defn chain-state [body] 22 | (util/m-seq (remove nil? body))) 23 | 24 | (defn compose 25 | "Compose multiple SQL statements." 26 | [stmt & body] 27 | (expr/stmt (chain-state (cons stmt body)))) 28 | 29 | (defn excluded-keyword? 30 | "Returns true if the keyword `k` is prefixed with \"EXCLUDED.\", 31 | otherwise false." 32 | [k] 33 | (str/starts-with? (name k) "EXCLUDED.")) 34 | 35 | (defn excluded-keyword 36 | "Returns the keyword `k`, prefixed with \"EXCLUDED.\"." 37 | [k] 38 | (some->> k name (str "EXCLUDED.") keyword)) 39 | 40 | (s/fdef excluded-keyword 41 | :args (s/cat :k (s/nilable simple-keyword?)) 42 | :ret (s/nilable excluded-keyword?)) 43 | 44 | (defn excluded-kw-map 45 | "Returns a map of EXCLUDED `ks` indexed by `ks`." 46 | [ks] 47 | (cond 48 | (map? ks) 49 | (excluded-kw-map (keys ks)) 50 | (sequential? ks) 51 | (zipmap ks (map excluded-keyword ks)))) 52 | 53 | (s/fdef excluded-kw-map 54 | :args (s/cat :ks (s/nilable 55 | (s/or :map (s/map-of keyword? any?) 56 | :seq (s/coll-of simple-keyword?)))) 57 | :ret (s/nilable (s/map-of simple-keyword? excluded-keyword?))) 58 | 59 | (defn ast 60 | "Returns the abstract syntax tree of `stmt`." 61 | [stmt] 62 | (expr/ast stmt)) 63 | 64 | (defn as 65 | "Parse `expr` and return an expr with and AS clause using `alias`." 66 | [expr alias & [columns]] 67 | {:op :alias 68 | :children [:expr :name] 69 | :columns (mapv expr/parse-column columns) 70 | :expr (expr/parse-expr expr) 71 | :name alias}) 72 | 73 | (defn asc 74 | "Parse `expr` and return an ORDER BY expr using ascending order." 75 | [expr] 76 | {:op :direction 77 | :direction :asc 78 | :expr (expr/parse-expr expr)}) 79 | 80 | (defn cascade 81 | "Add a CASCADE clause to an SQL statement." 82 | [condition] 83 | (util/conditional-clause :cascade condition)) 84 | 85 | (defn check 86 | "Add a CHECK clause to an SQL statement." 87 | [expr] 88 | (fn [stmt] 89 | (let [expr {:op :check 90 | :expr (expr/parse-expr expr)} 91 | stmt (update-in stmt [:checks] #(conj (vec %) expr))] 92 | [expr stmt]))) 93 | 94 | (defn column 95 | "Add a column to `stmt`." 96 | [name type & {:as options}] 97 | (let [column (merge options (expr/parse-column name) {:type type}) 98 | column (update-in column [:default] #(if %1 (expr/parse-expr %1)))] 99 | (fn [stmt] 100 | (let [column (-> (update-in stmt [:columns] #(vec (concat %1 [(:name column)]))) 101 | (assoc-in [:column (:name column)] 102 | (assoc column 103 | :schema (:schema stmt) 104 | :table (:name stmt))))] 105 | [column column])))) 106 | 107 | (s/def ::not-null boolean?) 108 | (s/def ::primary-key keyword?) 109 | 110 | (s/def ::column-opts 111 | (s/keys* :opt-un [::not-null ::primary-key])) 112 | 113 | (s/fdef column 114 | :args (s/cat :name :sqlingvo.column/name 115 | :type keyword? 116 | :opts ::column-opts)) 117 | 118 | (defn columns 119 | "Returns the columns of `table`." 120 | [table] 121 | (map (:column table) (:columns table))) 122 | 123 | (defn continue-identity 124 | "Add a CONTINUE IDENTITY clause to an SQL statement." 125 | [condition] 126 | (util/conditional-clause :continue-identity condition)) 127 | 128 | (defn concurrently 129 | "Add a CONCURRENTLY clause to a SQL statement." 130 | [condition] 131 | (util/conditional-clause :concurrently condition)) 132 | 133 | (defn do-constraint 134 | "Add a DO CONSTRAINT clause to a SQL statement." 135 | [constraint] 136 | (util/set-val :do-constraint constraint)) 137 | 138 | (defn do-nothing 139 | "Add a DO NOTHING clause to a SQL statement." 140 | [] 141 | (util/assoc-op :do-nothing)) 142 | 143 | (defn do-update 144 | "Add a DO UPDATE clause to a SQL statement." 145 | [expr] 146 | (util/assoc-op :do-update :expr (expr/parse-map-expr expr))) 147 | 148 | (defn with-data 149 | "Add a WITH [NO] DATA clause to a SQL statement." 150 | [data?] 151 | (util/assoc-op :with-data :data data?)) 152 | 153 | (defn desc 154 | "Parse `expr` and return an ORDER BY expr using descending order." 155 | [expr] 156 | {:op :direction 157 | :direction :desc 158 | :expr (expr/parse-expr expr)}) 159 | 160 | (defn distinct 161 | "Parse `exprs` and return a DISTINCT clause." 162 | [exprs & {:keys [on]}] 163 | (expr/make-node 164 | :op :distinct 165 | :children [:exprs :on] 166 | :exprs (expr/parse-exprs exprs) 167 | :on (expr/parse-exprs on))) 168 | 169 | (defn inline-str 170 | "Compile `s` as an inline string, instead of a prepared statement 171 | parameter. 172 | 173 | WARNING: You have to make sure the string `s` is safe against SQL 174 | injection attacks yourself." 175 | [s] 176 | {:form s 177 | :inline? true 178 | :op :constant 179 | :type :string 180 | :val s}) 181 | 182 | (defn delimiter 183 | "Add a DELIMITER clause to an SQL statement." 184 | [delimiter] 185 | (util/set-val :delimiter delimiter)) 186 | 187 | (s/fdef delimiter 188 | :args (s/cat :delimiter string?)) 189 | 190 | (defn encoding 191 | "Add a ENCODING clause to an SQL statement." 192 | [encoding] 193 | (util/set-val :encoding encoding)) 194 | 195 | (s/fdef encoding 196 | :args (s/cat :encoding string?)) 197 | 198 | (defn explain 199 | "Return an EXPLAIN statement for `stmt`. `opts` can be a map with 200 | the following key/value pairs: 201 | 202 | - :analyze boolean 203 | - :buffers boolean 204 | - :costs boolean 205 | - :format :json, :text, :yaml, :xml 206 | - :timing boolean 207 | - :verbose boolean 208 | 209 | Examples: 210 | 211 | (explain db 212 | (select db [:*] 213 | (from :foo))) 214 | 215 | (explain db 216 | (select db [:*] 217 | (from :foo)) 218 | {:analyze true})" 219 | {:style/indent 1} 220 | [db stmt & [opts]] 221 | (expr/stmt 222 | (fn [_] 223 | [_ (expr/make-node 224 | :op :explain 225 | :db (db/db db) 226 | :children [:stmt] 227 | :stmt (ast stmt) 228 | :opts opts)]))) 229 | 230 | (defn copy 231 | "Build a COPY statement. 232 | 233 | Examples: 234 | 235 | (copy db :country [] 236 | (from :stdin)) 237 | 238 | (copy db :country [] 239 | (from \"/usr1/proj/bray/sql/country_data\"))" 240 | {:style/indent 3} 241 | [db table columns & body] 242 | (let [table (expr/parse-table table) 243 | columns (map expr/parse-column columns)] 244 | (expr/stmt 245 | (fn [_] 246 | ((chain-state body) 247 | (expr/make-node 248 | :op :copy 249 | :db (db/db db) 250 | :children [:table :columns] 251 | :table table 252 | :columns columns)))))) 253 | 254 | (defn create-schema 255 | "Build a CREATE SCHEMA statement." 256 | {:style/indent 2} 257 | [db schema & body] 258 | (let [schema (expr/parse-schema schema)] 259 | (expr/stmt 260 | (fn [_] 261 | ((chain-state body) 262 | (expr/make-node 263 | :op :create-schema 264 | :db (db/db db) 265 | :children [:schema] 266 | :schema schema)))))) 267 | 268 | (defn create-table 269 | "Build a CREATE TABLE statement." 270 | {:style/indent 2} 271 | [db table & body] 272 | (let [table (expr/parse-table table)] 273 | (expr/stmt 274 | (fn [_] 275 | ((chain-state body) 276 | (expr/make-node 277 | :op :create-table 278 | :db (db/db db) 279 | :children [:table] 280 | :table table)))))) 281 | 282 | (defn create-type 283 | "Build a CREATE TYPE sql statement." 284 | {:style/indent 2} 285 | [db type & body] 286 | (expr/stmt 287 | (fn [_] 288 | ((chain-state body) 289 | (expr/make-node 290 | :children [:name] 291 | :db (db/db db) 292 | :op :create-type 293 | :type (expr/parse-type type)))))) 294 | 295 | (defn enum 296 | "Returns the enum ast." 297 | [labels] 298 | (util/assoc-op 299 | :enum :labels (for [label labels] 300 | {:op :enum-label 301 | :children [:name] 302 | :name (name label)}))) 303 | 304 | (defn delete 305 | "Build a DELETE statement. 306 | 307 | Examples: 308 | 309 | (delete db :continents) 310 | 311 | (delete db :continents 312 | (where '(= :id 1)))" 313 | {:style/indent 2} 314 | [db table & body] 315 | (let [table (expr/parse-table table)] 316 | (expr/stmt 317 | (fn [_] 318 | ((chain-state body) 319 | (expr/make-node 320 | :op :delete 321 | :db (db/db db) 322 | :children [:table] 323 | :table table)))))) 324 | 325 | (defn drop-schema 326 | "Build a DROP SCHEMA statement. 327 | 328 | Examples: 329 | 330 | (drop-schema db [:my-schema])" 331 | {:style/indent 2} 332 | [db schemas & body] 333 | (let [schemas (mapv expr/parse-schema schemas)] 334 | (expr/stmt 335 | (fn [_] 336 | ((chain-state body) 337 | (expr/make-node 338 | :children [:name] 339 | :db (db/db db) 340 | :op :drop-schema 341 | :schemas schemas)))))) 342 | 343 | (defn drop-table 344 | "Build a DROP TABLE statement. 345 | 346 | Examples: 347 | 348 | (drop-table db [:continents]) 349 | 350 | (drop-table db [:continents :countries])" 351 | {:style/indent 2} 352 | [db tables & body] 353 | (let [tables (mapv expr/parse-table tables)] 354 | (expr/stmt 355 | (fn [stmt] 356 | ((chain-state body) 357 | (expr/make-node 358 | :op :drop-table 359 | :db (db/db db) 360 | :children [:tables] 361 | :tables tables)))))) 362 | 363 | (defn drop-type 364 | "Build a DROP TYPE statement. 365 | 366 | Examples: 367 | 368 | (drop-type db [:mood]) 369 | 370 | (drop-table db [:my-schema.mood])" 371 | {:style/indent 2} 372 | [db types & body] 373 | (let [types (mapv expr/parse-type types)] 374 | (expr/stmt 375 | (fn [_] 376 | ((chain-state body) 377 | (expr/make-node 378 | :children [:name] 379 | :db (db/db db) 380 | :op :drop-type 381 | :types types)))))) 382 | 383 | (defn- make-set-op 384 | [op args] 385 | (let [[[opts] stmts] (split-with map? args)] 386 | (expr/stmt 387 | (fn [_] 388 | (->> (merge 389 | (expr/make-node 390 | :op op 391 | :db (-> stmts first ast :db) 392 | :children [:stmts] 393 | :stmts (map ast stmts)) 394 | opts) 395 | (repeat 2)))))) 396 | 397 | (defn except 398 | "Build an EXCEPT statement. 399 | 400 | Examples: 401 | 402 | (except 403 | (select db [1]) 404 | (select db [2])) 405 | 406 | (except 407 | {:all true} 408 | (select db [1]) 409 | (select db [2]))" 410 | [& args] 411 | (make-set-op :except args)) 412 | 413 | (defn from 414 | "Add a FROM clause to an SQL statement. The `from` forms can be one 415 | or more tables, :stdin, a filename or an other sub query. 416 | 417 | Examples: 418 | 419 | (select db [:*] 420 | (from :continents)) 421 | 422 | (select db [:*] 423 | (from :continents :countries) 424 | (where '(= :continents.id :continent-id))) 425 | 426 | (select db [:*] 427 | (from (as (select [1 2 3]) :x))) 428 | 429 | (copy db :country [] 430 | (from :stdin)) 431 | 432 | (copy db :country [] 433 | (from \"/usr1/proj/bray/sql/country_data\"))" 434 | [& from] 435 | (fn [stmt] 436 | (let [from (case (:op stmt) 437 | :copy [(first from)] 438 | (map expr/parse-from from))] 439 | [from (update-in stmt [:from] #(concat %1 from))]))) 440 | 441 | (defn group-by 442 | "Add a GROUP BY clause to an SQL statement." 443 | [& exprs] 444 | (util/concat-in [:group-by] (expr/parse-exprs exprs))) 445 | 446 | (defn having 447 | "Add a HAVING clause to an SQL statement. 448 | 449 | Examples: 450 | 451 | (select db [:city '(max :temp-lo)] 452 | (from :weather) 453 | (group-by :city) 454 | (having '(< (max :temp-lo) 40)))" 455 | [condition & [combine]] 456 | (util/build-condition :having condition combine)) 457 | 458 | (defn if-exists 459 | "Add a IF EXISTS clause to an SQL statement." 460 | [condition] 461 | (util/conditional-clause :if-exists condition)) 462 | 463 | (defn if-not-exists 464 | "Add a IF EXISTS clause to an SQL statement." 465 | [condition] 466 | (util/conditional-clause :if-not-exists condition)) 467 | 468 | (defn inherits 469 | "Add an INHERITS clause to an SQL statement." 470 | [& tables] 471 | (let [tables (mapv expr/parse-table tables)] 472 | (fn [stmt] 473 | [tables (assoc stmt :inherits tables)]))) 474 | 475 | (defn insert 476 | "Build a INSERT statement." 477 | {:style/indent 3} 478 | [db table columns & body] 479 | (let [table (expr/parse-table table) 480 | columns (map expr/parse-column columns)] 481 | (expr/stmt 482 | (fn [_] 483 | ((chain-state body) 484 | (expr/make-node 485 | :op :insert 486 | :db (db/db db) 487 | :children [:table :columns] 488 | :table table 489 | :columns 490 | (when (not-empty columns) 491 | columns))))))) 492 | 493 | (defn intersect 494 | "Build an INTERSECT statement. 495 | 496 | Examples: 497 | 498 | (intersect 499 | (select db [1]) 500 | (select db [2])) 501 | 502 | (intersect 503 | {:all true} 504 | (select db [1]) 505 | (select db [2]))" 506 | [& args] 507 | (make-set-op :intersect args)) 508 | 509 | (defn join 510 | "Add a JOIN clause to a statement. 511 | 512 | Examples: 513 | 514 | (select db [:*] 515 | (from :countries) 516 | (join :continents '(using :id))) 517 | 518 | (select db [:*] 519 | (from :continents) 520 | (join :countries.continent-id :continents.id)) 521 | 522 | (select db [:*] 523 | (from :countries) 524 | (join :continents '(on (= :continents.id :countries.continent-id))))" 525 | [from condition & {:keys [type outer pk]}] 526 | (util/concat-in 527 | [:joins] 528 | [(let [join (expr/make-node 529 | :op :join 530 | :children [:outer :type :from] 531 | :outer outer 532 | :type type 533 | :from (expr/parse-from from))] 534 | (cond 535 | (and (sequential? condition) 536 | (= :on (keyword (name (first condition))))) 537 | (assoc join 538 | :on (expr/parse-expr (first (rest condition)))) 539 | (and (sequential? condition) 540 | (= :using (keyword (name (first condition))))) 541 | (assoc join 542 | :using (expr/parse-exprs (rest condition))) 543 | (and (keyword? from) 544 | (keyword? condition)) 545 | (assoc join 546 | :from (expr/parse-table (str/join "." (butlast (str/split (name from) #"\.")))) 547 | :on (expr/parse-expr `(= ~from ~condition))) 548 | :else (throw (ex-info "Invalid JOIN condition." {:condition condition}))))])) 549 | 550 | (defn like 551 | "Add a LIKE clause to an SQL statement." 552 | [table & {:as opts}] 553 | (let [table (expr/parse-table table) 554 | like (assoc opts :op :like :table table)] 555 | (util/set-val :like like))) 556 | 557 | (defn limit 558 | "Add a LIMIT clause to an SQL statement." 559 | [expr] 560 | (if expr 561 | (util/assoc-op :limit :expr (expr/parse-expr expr)) 562 | (util/dissoc-op :limit))) 563 | 564 | (defn nulls 565 | "Parse `expr` and return an NULLS FIRST/LAST expr." 566 | [expr where] 567 | (assoc (expr/parse-expr expr) :nulls where)) 568 | 569 | (defn on-conflict 570 | "Add a ON CONFLICT clause to a SQL statement." 571 | {:style/indent 1} 572 | [target & body] 573 | (let [target (map expr/parse-column target)] 574 | (let [[_ node] 575 | ((chain-state body) 576 | (expr/make-node 577 | :op :on-conflict 578 | :target target 579 | :children [:target]))] 580 | (expr/stmt 581 | (fn [stmt] 582 | [_ (assoc stmt :on-conflict node)]))))) 583 | 584 | (defn on-conflict-on-constraint 585 | "Add a ON CONFLICT ON CONSTRAINT clause to a SQL statement." 586 | {:style/indent 1} 587 | [target & body] 588 | (let [[_ node] 589 | ((chain-state body) 590 | (expr/make-node 591 | :op :on-conflict-on-constraint 592 | :target target 593 | :children [:target]))] 594 | (expr/stmt 595 | (fn [stmt] 596 | [_ (assoc stmt :on-conflict-on-constraint node)])))) 597 | 598 | (defn offset 599 | "Add a OFFSET clause to an SQL statement." 600 | [expr] 601 | (if expr 602 | (util/assoc-op :offset :expr (expr/parse-expr expr)) 603 | (util/dissoc-op :offset))) 604 | 605 | (defn or-replace 606 | "Add an OR REPLACE clause to an SQL statement." 607 | [condition] 608 | (util/conditional-clause :or-replace condition)) 609 | 610 | (defn order-by 611 | "Add a ORDER BY clause to an SQL statement." 612 | [& exprs] 613 | (util/concat-in [:order-by] (expr/parse-exprs exprs))) 614 | 615 | (defn window 616 | "Add a WINDOW clause to an SQL statement." 617 | [& exprs] 618 | (util/assoc-op :window :definitions (expr/parse-exprs exprs))) 619 | 620 | (defn primary-key 621 | "Add a PRIMARY KEY clause to a table." 622 | [& keys] 623 | (fn [stmt] 624 | [nil (assoc stmt :primary-key (vec keys))])) 625 | 626 | (defn create-materialized-view 627 | "Build a CREATE MATERIALIZED VIEW statement. 628 | 629 | Examples: 630 | 631 | (sql/create-materialized-view db :pseudo-source [:key :value] 632 | (sql/values [[\"a\" 1] [\"a\" 2] [\"a\" 3] [\"a\" 4] [\"b\" 5] [\"c\" 6] [\"c\" 7]])) 633 | " 634 | {:style/indent 3} 635 | [db view columns & body] 636 | (let [view (expr/parse-table view)] 637 | (expr/stmt 638 | (fn [_] 639 | ((chain-state body) 640 | (expr/make-node 641 | :op :create-materialized-view 642 | :db (db/db db) 643 | :children [:view] 644 | :columns (mapv expr/parse-column columns) 645 | :view view)))))) 646 | 647 | (defn drop-materialized-view 648 | "Build a DROP MATERIALIZED VIEW statement. 649 | 650 | Examples: 651 | 652 | (drop-materialized-view db :order-summary)" 653 | {:style/indent 2} 654 | [db view & body] 655 | (let [view (expr/parse-table view)] 656 | (expr/stmt 657 | (fn [_] 658 | ((chain-state body) 659 | (expr/make-node 660 | :op :drop-materialized-view 661 | :db (db/db db) 662 | :children [:view] 663 | :view view)))))) 664 | 665 | (defn drop-view 666 | "Build a DROP VIEW statement. 667 | 668 | Examples: 669 | 670 | (drop-view db :order-summary)" 671 | {:style/indent 2} 672 | [db view & body] 673 | (let [view (expr/parse-table view)] 674 | (expr/stmt 675 | (fn [_] 676 | ((chain-state body) 677 | (expr/make-node 678 | :op :drop-view 679 | :db (db/db db) 680 | :children [:view] 681 | :view view)))))) 682 | 683 | (defn refresh-materialized-view 684 | "Build a REFRESH MATERIALIZED VIEW statement. 685 | 686 | Examples: 687 | 688 | (refresh-materialized-view db :order-summary)" 689 | {:style/indent 2} 690 | [db view & body] 691 | (let [view (expr/parse-table view)] 692 | (expr/stmt 693 | (fn [_] 694 | ((chain-state body) 695 | (expr/make-node 696 | :op :refresh-materialized-view 697 | :db (db/db db) 698 | :children [:view] 699 | :view view)))))) 700 | 701 | (defn restart-identity 702 | "Add a RESTART IDENTITY clause to an SQL statement." 703 | [condition] 704 | (util/conditional-clause :restart-identity condition)) 705 | 706 | (defn restrict 707 | "Add a RESTRICT clause to an SQL statement." 708 | [condition] 709 | (util/conditional-clause :restrict condition)) 710 | 711 | (defn returning 712 | "Add a RETURNING clause to an SQL statement. 713 | 714 | Examples: 715 | 716 | (insert db :distributors [] 717 | (values [{:did 106 :dname \"XYZ Widgets\"}]) 718 | (returning :*)) 719 | 720 | (update db :films 721 | {:kind \"Dramatic\"} 722 | (where '(= :kind \"Drama\")) 723 | (returning :*))" 724 | [& exprs] 725 | (util/concat-in [:returning] (expr/parse-exprs exprs))) 726 | 727 | (defn select 728 | "Build a SELECT statement. 729 | 730 | Examples: 731 | 732 | (select db [1]) 733 | 734 | (select db [:*] 735 | (from :continents)) 736 | 737 | (select db [:id :name] 738 | (from :continents))" 739 | {:style/indent 2} 740 | [db exprs & body] 741 | (let [[_ select] 742 | ((chain-state body) 743 | (expr/make-node 744 | :op :select 745 | :db (db/db db) 746 | :children [:distinct :exprs] 747 | :distinct (if (= :distinct (:op exprs)) 748 | exprs) 749 | :exprs (if (sequential? exprs) 750 | (expr/parse-exprs exprs))))] 751 | (expr/stmt 752 | (fn [stmt] 753 | (->> (case (:op stmt) 754 | :create-materialized-view (assoc stmt :select select) 755 | :insert (assoc stmt :select select) 756 | :select (assoc stmt :exprs (:exprs select)) 757 | select) 758 | (repeat 2)))))) 759 | 760 | (defn table 761 | "Make a new table and return it's AST." 762 | {:style/indent 1} 763 | [name & body] 764 | (ast (fn [table] 765 | [nil (merge 766 | table 767 | (second 768 | ((chain-state body) 769 | (expr/parse-table name))))]))) 770 | 771 | (s/fdef table 772 | :args (s/cat :name :sqlingvo.table/name :body (s/* any?)) 773 | :ret :sqlingvo/table) 774 | 775 | (defn temporary 776 | "Add a TEMPORARY clause to an SQL statement." 777 | [condition] 778 | (util/conditional-clause :temporary condition)) 779 | 780 | (defn truncate 781 | "Build a TRUNCATE statement. 782 | 783 | Examples: 784 | 785 | (truncate db [:continents]) 786 | 787 | (truncate db [:continents :countries])" 788 | {:style/indent 2} 789 | [db tables & body] 790 | (let [tables (map expr/parse-table tables)] 791 | (expr/stmt 792 | (fn [_] 793 | ((chain-state body) 794 | (expr/make-node 795 | :op :truncate 796 | :db (db/db db) 797 | :children [:tables] 798 | :tables tables)))))) 799 | 800 | (defn union 801 | "Build a UNION statement. 802 | 803 | Examples: 804 | 805 | (union 806 | (select db [1]) 807 | (select db [2])) 808 | 809 | (union 810 | {:all true} 811 | (select db [1]) 812 | (select db [2]))" 813 | [& args] 814 | (make-set-op :union args)) 815 | 816 | (defn update 817 | "Build a UPDATE statement. 818 | 819 | Examples: 820 | 821 | (update db :films {:kind \"Dramatic\"} 822 | (where '(= :kind \"Drama\")))" 823 | {:style/indent 2} 824 | [db table row & body] 825 | (let [table (expr/parse-table table) 826 | exprs (if (sequential? row) (expr/parse-exprs row)) 827 | row (if (map? row) (expr/parse-map-expr row))] 828 | (expr/stmt 829 | (fn [_] 830 | ((chain-state body) 831 | (expr/make-node 832 | :op :update 833 | :db (db/db db) 834 | :children [:table :exprs :row] 835 | :table table 836 | :exprs exprs 837 | :row row)))))) 838 | 839 | (defn values 840 | "Return a VALUES statement or clause. 841 | 842 | Examples: 843 | 844 | (values db [[1 \"one\"] [2 \"two\"] [3 \"three\"]]) 845 | 846 | (insert db :distributors [] 847 | (values [{:did 106 :dname \"XYZ Widgets\"}]))" 848 | ([vals] 849 | (values nil vals)) 850 | ([db vals] 851 | (expr/stmt 852 | (fn [stmt] 853 | (let [node (cond 854 | (= vals :default) 855 | {:op :values 856 | :db (some-> db db/db) 857 | :type :default} 858 | (every? map? vals) 859 | {:op :values 860 | :db (some-> db db/db) 861 | :columns (if (not-empty (:columns stmt)) 862 | (:columns stmt) 863 | (->> (mapcat keys vals) 864 | (apply sorted-set) 865 | (mapv expr/parse-column))) 866 | :type :records 867 | :values (mapv expr/parse-map-expr vals)} 868 | :else 869 | {:op :values 870 | :db (some-> db db/db) 871 | :columns (:columns stmt) 872 | :type :exprs 873 | :values (mapv expr/parse-exprs vals)})] 874 | (->> (case (:op stmt) 875 | :create-materialized-view (assoc stmt :values node) 876 | :insert (assoc stmt :values node) 877 | node) 878 | (repeat 2))))))) 879 | 880 | (defn where 881 | "Add a WHERE clause to an SQL statement. 882 | 883 | Examples: 884 | 885 | (select db [1] 886 | (where '(in 1 (1 2 3)))) 887 | 888 | (select db [*] 889 | (from :continents) 890 | (where '(= :name \"Europe\"))) 891 | 892 | (delete db :continents 893 | (where '(= :id 1)))" 894 | [condition & [combine]] 895 | (util/build-condition :where condition combine)) 896 | 897 | (defn with 898 | "Build a WITH (common table expressions) query." 899 | {:style/indent 2} 900 | [db bindings query] 901 | (assert (even? (count bindings)) "The WITH bindings must be even.") 902 | (let [bindings (map (fn [[name stmt]] 903 | (vector (keyword name) 904 | (ast stmt))) 905 | (partition 2 bindings)) 906 | query (ast query) 907 | node (expr/make-node 908 | :op :with 909 | :db (db/db db) 910 | :children [:bindings] 911 | :bindings bindings 912 | :query query)] 913 | (expr/stmt 914 | (fn [stmt] 915 | [node (if stmt 916 | (assoc stmt :with node) 917 | node)])))) 918 | 919 | (defn sql 920 | "Compile `stmt` into a clojure.java.jdbc compatible vector." 921 | [stmt] 922 | (compiler/compile-stmt (ast stmt))) 923 | 924 | #?(:clj (defmethod print-method sqlingvo.expr.Stmt 925 | [stmt writer] 926 | (print-method (sql stmt) writer))) 927 | 928 | #?(:cljs 929 | (extend-protocol IPrintWithWriter 930 | sqlingvo.expr.Stmt 931 | (-pr-writer [stmt writer opts] 932 | (-pr-writer (sql stmt) writer opts)))) 933 | 934 | ;; Override deref in pprint 935 | (defmethod simple-dispatch sqlingvo.expr.Stmt [stmt] 936 | (pr (sql stmt))) 937 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * SQLingvo 2 | #+author: r0man 3 | #+LANGUAGE: en 4 | 5 | [[https://clojars.org/sqlingvo][https://img.shields.io/clojars/v/sqlingvo.svg]] 6 | [[https://github.com/r0man/sqlingvo/actions?query=workflow%3A%22Clojure+CI%22][https://github.com/r0man/sqlingvo/workflows/Clojure%20CI/badge.svg]] 7 | [[https://versions.deps.co/r0man/sqlingvo][https://versions.deps.co/r0man/sqlingvo/status.svg]] 8 | [[https://versions.deps.co/r0man/sqlingvo][https://versions.deps.co/r0man/sqlingvo/downloads.svg]] 9 | 10 | /SQLingvo/ is an embedded [[https://clojure.org][Clojure]] and [[https://github.com/clojure/clojurescript][ClojureScript]] /DSL/ that 11 | allows you to build /SQL/ statements within your favorite 12 | /LISP/. The /SQL/ statements used by /SQLingvo/ are compatible with 13 | the [[https://github.com/seancorfield/next-jdbc][next.jdbc]], [[https://github.com/clojure/java.jdbc][clojure.java.jdbc]], [[https://github.com/funcool/clojure.jdbc][clojure.jdbc]], [[https://github.com/alaisi/postgres.async][postgres.async]] and 14 | [[https://github.com/brianc/node-postgres][node-postgres]] libraries. 15 | 16 | If you want to execute /SQL/ statements on [[https://nodejs.org][Node.js]], take a look at 17 | [[https://github.com/r0man/sqlingvo.node][SQLingvo.node]]. 18 | 19 | *Note*: /SQLingvo/ is designed for the [[http://www.postgresql.org/][PostgreSQL]] database 20 | management system. That said, if you can avoid /PostgreSQL/ specific 21 | features, you might be lucky and use it with other databases as 22 | well. 23 | 24 | [[https://xkcd.com/1409][https://imgs.xkcd.com/comics/query.png]] 25 | 26 | ** Usage 27 | 28 | /SQLingvo/ shadows some functions from the =clojure.core= 29 | namespace, such as =distinct=, =group-by= and =update= 30 | functions. It's recommended to require the =sqlingvo.core= 31 | namespace via an alias, such as =sql=. 32 | 33 | #+BEGIN_SRC clojure :exports code :results silent 34 | (require '[sqlingvo.core :as sql]) 35 | #+END_SRC 36 | 37 | ** Database specification 38 | 39 | /SQLingvo/ uses a database specification to configure how /SQL/ 40 | identifiers are quoted and column and table names are translated 41 | between /Clojure/ and your database. The following code defines a 42 | database specification using the naming and quoting strategy for 43 | /PostgreSQL/. 44 | 45 | #+BEGIN_SRC clojure :exports code :results silent 46 | (def my-db (sql/db :postgresql)) 47 | #+END_SRC 48 | 49 | Such a database specification is needed by all functions that 50 | produce /SQL/ statements. The following code uses the database 51 | specification =my-db= to build a simple /SELECT/ statement. 52 | 53 | #+BEGIN_SRC clojure :exports both :results verbatim 54 | (sql/sql (sql/select my-db [:first-name] 55 | (sql/from :people))) 56 | #+END_SRC 57 | 58 | #+RESULTS: 59 | : ["SELECT \"first-name\" FROM \"people\""] 60 | 61 | *** Naming strategy 62 | 63 | The naming strategy is used to configure how column and table 64 | names are translated between /Clojure/ and the /SQL/ dialect of the 65 | database. The strategy can be configured with the =:sql-name= 66 | entry in a database specification. 67 | 68 | The default strategy used is =clojure.core/name=, which translates 69 | a /Clojure/ keyword to a string. 70 | 71 | A common use case is to translate from a keyword to a string and 72 | replace all hyphens with underscores. This can be done with the 73 | following code: 74 | 75 | #+BEGIN_SRC clojure :exports code :results silent 76 | (require '[clojure.string :as str]) 77 | 78 | (defn underscore [s] 79 | (str/replace (name s) "-" "_")) 80 | 81 | (def my-db' (sql/db :postgresql {:sql-name underscore})) 82 | #+END_SRC 83 | 84 | All the hyphens in column and table names are now translated to 85 | underscores. 86 | 87 | #+BEGIN_SRC clojure :exports both :results verbatim 88 | (sql/sql (sql/select my-db' [:first-name] 89 | (sql/from :people))) 90 | #+END_SRC 91 | 92 | #+RESULTS: 93 | : ["SELECT \"first_name\" FROM \"people\""] 94 | 95 | *** Quoting strategy 96 | 97 | The quoting strategy defines how column and table names are quoted 98 | when building /SQL/. The strategy can be configured with the 99 | =:sql-quote= entry in a database specification. 100 | 101 | You could change the quoting strategy with the following code: 102 | 103 | #+BEGIN_SRC clojure :exports code :results silent 104 | (require '[sqlingvo.util :refer [sql-quote-backtick]]) 105 | (def my-db' (sql/db :postgresql {:sql-quote sql-quote-backtick})) 106 | #+END_SRC 107 | 108 | Now the column and table names are quoted with back ticks, instead 109 | of double quotes. 110 | 111 | #+BEGIN_SRC clojure :exports both :results verbatim 112 | (sql/sql (sql/select my-db' [:first-name] 113 | (sql/from :people))) 114 | #+END_SRC 115 | 116 | #+RESULTS: 117 | : ["SELECT `first-name` FROM `people`"] 118 | 119 | *** Placeholder strategy 120 | 121 | The placeholder strategy defines how placeholders for /SQL/ 122 | parameters are generated when building statements. The default 123 | =sql-placeholder-constant= strategy always uses the string =?=, 124 | the =sql-placeholder-count= strategy uses increasing values 125 | starting from =$1=, =$2=, etc. 126 | 127 | The strategy can be configured with the =:sql-placeholder= entry 128 | in a database specification. 129 | 130 | #+BEGIN_SRC clojure :exports code :results silent 131 | (require '[sqlingvo.util :refer [sql-placeholder-count]]) 132 | (def my-db' (sql/db :postgresql {:sql-placeholder sql-placeholder-count})) 133 | #+END_SRC 134 | 135 | Now, the placeholders for /SQL/ parameters will contain the index 136 | number of the parameter. Use this strategy if you are using 137 | /SQLingvo/ with [[https://github.com/alaisi/postgres.async][postgres.async]]. 138 | 139 | #+BEGIN_SRC clojure :exports both :results verbatim 140 | (sql/sql (sql/select my-db' [:*] 141 | (sql/from :distributors) 142 | (sql/where '(and (= :dname "Anvil Distribution") 143 | (= :zipcode "21201"))))) 144 | #+END_SRC 145 | 146 | #+RESULTS: 147 | : ["SELECT * FROM \"distributors\" WHERE ((\"dname\" = $1) and (\"zipcode\" = $2))" "Anvil Distribution" "21201"] 148 | 149 | ** SQL statement 150 | 151 | /SQLingvo/ comes with functions for common /SQL/ commands like 152 | =select=, =insert=, =update= and more. These functions return an 153 | instance of =sqlingvo.expr.Stmt=, a data structure that can be 154 | compiled into /SQL/ with the =sql= function, or used by other 155 | functions to build derived statements. 156 | 157 | Here's an example: 158 | 159 | #+BEGIN_SRC clojure :exports code :results silent 160 | (def commendy-films-stmt 161 | (sql/select my-db [:id :name] 162 | (sql/from :films) 163 | (sql/where '(= :kind "Comedy")))) 164 | #+END_SRC 165 | 166 | In the code above we select all the =id= and =name= columns of all 167 | rows in the =films= table that have a =kind= column with the value 168 | =Comedy=. The call to the =select= function returns and instance of 169 | =sqlingvo.expr.Stmt=, which is bound to the =commendy-films-stmt= 170 | var. 171 | 172 | #+BEGIN_SRC clojure :exports both :results verbatim 173 | (class commendy-films-stmt) 174 | #+END_SRC 175 | 176 | #+RESULTS: 177 | : sqlingvo.expr.Stmt 178 | 179 | This instance can be compiled into /SQL/ with the =sql= 180 | function. The result is a /Clojure/ vector with the first entry 181 | being the compiled /SQL/ string and the remaining entries the 182 | prepared statement parameters. 183 | 184 | #+BEGIN_SRC clojure :exports both :results verbatim 185 | (sql/sql commendy-films-stmt) 186 | #+END_SRC 187 | 188 | #+RESULTS: 189 | : ["SELECT \"id\", \"name\" FROM \"films\" WHERE (\"kind\" = ?)" "Comedy"] 190 | 191 | Those vectors could be fed to the [[https://github.com/funcool/clojure.jdbc][clojure.jdbc]] and 192 | [[https://github.com/clojure/java.jdbc][clojure.java.jdbc]] libraries to actually execute a statement. 193 | 194 | ** Printing in the REPL 195 | 196 | There is a =print-method= defined for the =sqlingvo.expr.Stmt= 197 | class, so instances of a statement are printed in their compiled 198 | from. This is convenient when building /SQL/ statements in the 199 | /REPL/. If you type the following example directly into your 200 | /REPL/, it prints out the compiled form of the statement. 201 | 202 | #+BEGIN_SRC clojure :exports both :results verbatim 203 | (sql/select my-db [:id :name] 204 | (sql/from :films) 205 | (sql/where '(= :kind "Comedy"))) 206 | #+END_SRC 207 | 208 | #+RESULTS: 209 | : ["SELECT \"id\", \"name\" FROM \"films\" WHERE (\"kind\" = ?)" "Comedy"] 210 | 211 | But the return value of the call to the =select= function above is 212 | still an instance of =sqlingvo.expr.Stmt=. 213 | 214 | #+BEGIN_SRC clojure :exports both :results verbatim 215 | (class *1) 216 | #+END_SRC 217 | 218 | #+RESULTS: 219 | : sqlingvo.expr.Stmt 220 | 221 | ** SQL expressions 222 | 223 | /SQLingvo/ compiles /SQL/ expressions from /Clojure/ prefix 224 | notation into /SQL/. There's built-in support for special 225 | operators, such as =+=, =-=, =*=, =/= and many others. 226 | 227 | #+BEGIN_SRC clojure :exports both :results verbatim 228 | (sql/select my-db [1 '(+ 2 (abs 3)) '(upper "Hello")]) 229 | #+END_SRC 230 | 231 | #+RESULTS: 232 | : ["SELECT 1, (2 + abs(3)), upper(?)" "Hello"] 233 | 234 | You can influence the compilation of functions by extending the 235 | =compile-fn= multi method. In case a function uses a special 236 | compilation rule that is not built in, take a look at the multi 237 | method implementation of =substring= to see how to create your own 238 | compilation rule. Or even better, send a PR ... 239 | 240 | #+BEGIN_SRC clojure :exports both :results verbatim 241 | (sql/select my-db ['(substring "Fusion" from 2 for 3)]) 242 | #+END_SRC 243 | 244 | #+RESULTS: 245 | : ["SELECT substring(? from 2 for 3)" "Fusion"] 246 | 247 | ** Syntax quoting 248 | 249 | When using /SQLingvo/ to build parameterized /SQL/ statements, you 250 | often want to use the parameters in a /SQL/ expression. This can be 251 | accomplished with syntax quoting. Note the back tick character in 252 | the =where= clause. 253 | 254 | #+BEGIN_SRC clojure :exports code :results silent 255 | (defn films-by-kind [db kind] 256 | (sql/select db [:id :name] 257 | (sql/from :films) 258 | (sql/where `(= :kind ~kind)))) 259 | #+END_SRC 260 | 261 | #+BEGIN_SRC clojure :exports both :results verbatim 262 | (films-by-kind my-db "Action") 263 | #+END_SRC 264 | 265 | #+RESULTS: 266 | : ["SELECT \"id\", \"name\" FROM \"films\" WHERE (\"kind\" = ?)" "Action"] 267 | 268 | ** Detailed SQL examples 269 | 270 | The following examples show how to build /SQL/ statements found in 271 | the /PostgreSQL/ [[https://www.postgresql.org/docs/9.5/interactive/index.html][documentation]] with /SQLingvo/. Note that we don't 272 | call the =sql= function anymore, because we are only interested in 273 | the printed result. 274 | 275 | *** Copy 276 | 277 | Copy from standard input. 278 | 279 | #+BEGIN_SRC clojure :exports both :results verbatim 280 | (sql/copy my-db :country [] 281 | (sql/from :stdin)) 282 | #+END_SRC 283 | 284 | #+RESULTS: 285 | : ["COPY \"country\" FROM STDIN"] 286 | 287 | Copy data from a file into the country table. 288 | 289 | #+BEGIN_SRC clojure :exports both :results verbatim 290 | (sql/copy my-db :country [] 291 | (sql/from "/usr1/proj/bray/sql/country_data")) 292 | #+END_SRC 293 | 294 | #+RESULTS: 295 | : ["COPY \"country\" FROM ?" "/usr1/proj/bray/sql/country_data"] 296 | 297 | Copy data from a file into the country table with columns in the given order. 298 | 299 | #+BEGIN_SRC clojure :exports both :results verbatim 300 | (sql/copy my-db :country [:id :name] 301 | (sql/from "/usr1/proj/bray/sql/country_data")) 302 | #+END_SRC 303 | 304 | #+RESULTS: 305 | : ["COPY \"country\" (\"id\", \"name\") FROM ?" "/usr1/proj/bray/sql/country_data"] 306 | 307 | *** Create table 308 | 309 | Define a new database table. 310 | 311 | #+BEGIN_SRC clojure :exports both :results verbatim 312 | (sql/create-table my-db :films 313 | (sql/column :code :char :length 5 :primary-key? true) 314 | (sql/column :title :varchar :length 40 :not-null? true) 315 | (sql/column :did :integer :not-null? true) 316 | (sql/column :date-prod :date) 317 | (sql/column :kind :varchar :length 10) 318 | (sql/column :len :interval) 319 | (sql/column :created-at :timestamp-with-time-zone :not-null? true :default '(now)) 320 | (sql/column :updated-at :timestamp-with-time-zone :not-null? true :default '(now))) 321 | #+END_SRC 322 | 323 | #+RESULTS: 324 | : ["CREATE TABLE \"films\" (\"code\" CHAR PRIMARY KEY, \"title\" VARCHAR NOT NULL, \"did\" INTEGER NOT NULL, \"date-prod\" DATE, \"kind\" VARCHAR, \"len\" INTERVAL, \"created-at\" TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT now(), \"updated-at\" TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT now())"] 325 | 326 | *** Delete 327 | 328 | Clear the table films. 329 | 330 | #+BEGIN_SRC clojure :exports both :results verbatim 331 | (sql/delete my-db :films) 332 | #+END_SRC 333 | 334 | #+RESULTS: 335 | : ["DELETE FROM \"films\""] 336 | 337 | Delete all films but musicals. 338 | 339 | #+BEGIN_SRC clojure :exports both :results verbatim 340 | (sql/delete my-db :films 341 | (sql/where '(<> :kind "Musical"))) 342 | #+END_SRC 343 | 344 | #+RESULTS: 345 | : ["DELETE FROM \"films\" WHERE (\"kind\" <> ?)" "Musical"] 346 | 347 | Delete completed tasks, returning full details of the deleted rows. 348 | 349 | #+BEGIN_SRC clojure :exports both :results verbatim 350 | (sql/delete my-db :tasks 351 | (sql/where '(= :status "DONE")) 352 | (sql/returning :*)) 353 | #+END_SRC 354 | 355 | #+RESULTS: 356 | : ["DELETE FROM \"tasks\" WHERE (\"status\" = ?) RETURNING *" "DONE"] 357 | 358 | *** Insert 359 | 360 | **** Insert expressions 361 | 362 | Insert expressions into the =films= table. 363 | 364 | #+BEGIN_SRC clojure :exports both :results verbatim 365 | (sql/insert my-db :films [:code :title :did :date-prod :kind] 366 | (sql/values [['(upper "t_601") "Yojimbo" 106 "1961-06-16" "Drama"]])) 367 | #+END_SRC 368 | 369 | #+RESULTS: 370 | : ["INSERT INTO \"films\" (\"code\", \"title\", \"did\", \"date-prod\", \"kind\") VALUES (upper(?), ?, 106, ?, ?)" "t_601" "Yojimbo" "1961-06-16" "Drama"] 371 | 372 | Insert expressions and default values into the =films= table. 373 | 374 | #+BEGIN_SRC clojure :exports both :results verbatim 375 | (sql/insert my-db :films [] 376 | (sql/values [["UA502" "Bananas" 105 :DEFAULT "Comedy" "82 minutes"] 377 | ["T_601" "Yojimbo" 106 :DEFAULT "Drama" :DEFAULT]])) 378 | #+END_SRC 379 | 380 | #+RESULTS: 381 | : ["INSERT INTO \"films\" VALUES (?, ?, 105, DEFAULT, ?, ?), (?, ?, 106, DEFAULT, ?, DEFAULT)" "UA502" "Bananas" "Comedy" "82 minutes" "T_601" "Yojimbo" "Drama"] 382 | 383 | **** Insert records 384 | 385 | Insert records into the =films= table. 386 | 387 | #+BEGIN_SRC clojure :exports both :results verbatim 388 | (sql/insert my-db :films [] 389 | (sql/values [{:code "B6717" :title "Tampopo" :did 110 :date-prod "1985-02-10" :kind "Comedy"}, 390 | {:code "HG120" :title "The Dinner Game" :did 140 :date-prod "1985-02-10" :kind "Comedy"}])) 391 | #+END_SRC 392 | 393 | #+RESULTS: 394 | : ["INSERT INTO \"films\" (\"code\", \"date-prod\", \"did\", \"kind\", \"title\") VALUES (?, ?, 110, ?, ?), (?, ?, 140, ?, ?)" "B6717" "1985-02-10" "Comedy" "Tampopo" "HG120" "1985-02-10" "Comedy" "The Dinner Game"] 395 | 396 | **** Insert returning records 397 | 398 | Insert a row into the =films= table and return the inserted records. 399 | 400 | #+BEGIN_SRC clojure :exports both :results verbatim 401 | (sql/insert my-db :films [] 402 | (sql/values [{:code "T_601" :title "Yojimbo" :did 106 :date-prod "1961-06-16" :kind "Drama"}]) 403 | (sql/returning :*)) 404 | #+END_SRC 405 | 406 | #+RESULTS: 407 | : ["INSERT INTO \"films\" (\"code\", \"date-prod\", \"did\", \"kind\", \"title\") VALUES (?, ?, 106, ?, ?) RETURNING *" "T_601" "1961-06-16" "Drama" "Yojimbo"] 408 | 409 | **** Insert default values 410 | 411 | Insert a row consisting entirely of default values. 412 | 413 | #+BEGIN_SRC clojure :exports both :results verbatim 414 | (sql/insert my-db :films [] 415 | (sql/values :default)) 416 | #+END_SRC 417 | 418 | #+RESULTS: 419 | : ["INSERT INTO \"films\" DEFAULT VALUES"] 420 | 421 | **** Insert from a select statement 422 | 423 | Insert rows into the =films= table from the =tmp-films= table 424 | with the same column layout as films. 425 | 426 | #+BEGIN_SRC clojure :exports both :results verbatim 427 | (sql/insert my-db :films [] 428 | (sql/select my-db [:*] 429 | (sql/from :tmp-films) 430 | (sql/where '(< :date-prod "2004-05-07")))) 431 | #+END_SRC 432 | 433 | #+RESULTS: 434 | : ["INSERT INTO \"films\" SELECT * FROM \"tmp-films\" WHERE (\"date-prod\" < ?)" "2004-05-07"] 435 | 436 | **** Insert or update rows on conflict 437 | 438 | Insert or update new distributors as appropriate. Assumes a unique 439 | index has been defined that constrains values appearing in the did 440 | column. Note that the special excluded table is used to reference 441 | values originally proposed for insertion: 442 | 443 | #+BEGIN_SRC clojure :exports both :results verbatim 444 | (sql/insert my-db :distributors [:did :dname] 445 | (sql/values [{:did 5 :dname "Gizmo Transglobal"} 446 | {:did 6 :dname "Associated Computing, Inc"}]) 447 | (sql/on-conflict [:did] 448 | (sql/do-update {:dname :EXCLUDED.dname}))) 449 | #+END_SRC 450 | 451 | #+RESULTS: 452 | : ["INSERT INTO \"distributors\" (\"did\", \"dname\") VALUES (5, ?), (6, ?) ON CONFLICT (\"did\") DO UPDATE SET \"dname\" = EXCLUDED.\"dname\"" "Gizmo Transglobal" "Associated Computing, Inc"] 453 | 454 | **** Insert or do nothing on conflict 455 | 456 | Insert a distributor, or do nothing for rows proposed for 457 | insertion when an existing, excluded row (a row with a matching 458 | constrained column or columns after before row insert triggers 459 | fire) exists. Example assumes a unique index has been defined that 460 | constrains values appearing in the did column: 461 | 462 | #+BEGIN_SRC clojure :exports both :results verbatim 463 | (sql/insert my-db :distributors [:did :dname] 464 | (sql/values [{:did 7 :dname "Redline GmbH"}]) 465 | (sql/on-conflict [:did] 466 | (sql/do-nothing))) 467 | #+END_SRC 468 | 469 | #+RESULTS: 470 | : ["INSERT INTO \"distributors\" (\"did\", \"dname\") VALUES (7, ?) ON CONFLICT (\"did\") DO NOTHING" "Redline GmbH"] 471 | 472 | **** Insert or update rows on conflict with condition 473 | 474 | Don't update existing distributors based in a certain ZIP code. 475 | 476 | #+BEGIN_SRC clojure :exports both :results verbatim 477 | (sql/insert my-db (as :distributors :d) [:did :dname] 478 | (sql/values [{:did 8 :dname "Anvil Distribution"}]) 479 | (sql/on-conflict [:did] 480 | (sql/do-update {:dname '(:|| :EXCLUDED.dname " (formerly " :d.dname ")")}) 481 | (sql/where '(:<> :d.zipcode "21201")))) 482 | #+END_SRC 483 | 484 | #+RESULTS: 485 | : ["INSERT INTO \"distributors\" AS \"d\" (\"did\", \"dname\") VALUES (8, ?) ON CONFLICT (\"did\") DO UPDATE SET \"dname\" = (EXCLUDED.\"dname\" || ? || \"d\".\"dname\" || ?) WHERE (\"d\".\"zipcode\" <> ?)" "Anvil Distribution" " (formerly " ")" "21201"] 486 | 487 | **** Insert or do nothing by constraint 488 | 489 | Name a constraint directly in the statement. Uses associated index 490 | to arbitrate taking the /DO NOTHING/ action. 491 | 492 | #+BEGIN_SRC clojure :exports both :results verbatim 493 | (sql/insert my-db :distributors [:did :dname] 494 | (sql/values [{:did 9 :dname "Antwerp Design"}]) 495 | (sql/on-conflict-on-constraint :distributors_pkey 496 | (sql/do-nothing))) 497 | #+END_SRC 498 | 499 | #+RESULTS: 500 | : ["INSERT INTO \"distributors\" (\"did\", \"dname\") VALUES (9, ?) ON CONFLICT ON CONSTRAINT \"distributors_pkey\" DO NOTHING" "Antwerp Design"] 501 | 502 | *** Join 503 | 504 | Join the =weathers= table with the =cities= table. 505 | 506 | #+BEGIN_SRC clojure :exports both :results verbatim 507 | (sql/select my-db [:*] 508 | (sql/from :weather) 509 | (sql/join :cities.name :weather.city)) 510 | #+END_SRC 511 | 512 | #+RESULTS: 513 | : ["SELECT * FROM \"weather\" JOIN \"cities\" ON (\"cities\".\"name\" = \"weather\".\"city\")"] 514 | 515 | The code above is a common use case and is syntactic sugar for the 516 | following. Use this version if you want to join on an arbitrary 517 | SQL expression. 518 | 519 | #+BEGIN_SRC clojure :exports both :results verbatim 520 | (sql/select my-db [:*] 521 | (sql/from :weather) 522 | (sql/join :cities '(on (= :cities.name :weather.city)))) 523 | #+END_SRC 524 | 525 | #+RESULTS: 526 | : ["SELECT * FROM \"weather\" JOIN \"cities\" ON (\"cities\".\"name\" = \"weather\".\"city\")"] 527 | 528 | The type of join can be given as a keyword argument. 529 | 530 | #+BEGIN_SRC clojure :exports both :results verbatim 531 | (sql/select my-db [:*] 532 | (sql/from :weather) 533 | (sql/join :cities '(on (= :cities.name :weather.city)) :type :inner)) 534 | #+END_SRC 535 | 536 | #+RESULTS: 537 | : ["SELECT * FROM \"weather\" INNER JOIN \"cities\" ON (\"cities\".\"name\" = \"weather\".\"city\")"] 538 | 539 | *** Select 540 | 541 | Select all films. 542 | 543 | #+BEGIN_SRC clojure :exports both :results verbatim 544 | (sql/select my-db [:*] 545 | (sql/from :films)) 546 | #+END_SRC 547 | 548 | #+RESULTS: 549 | : ["SELECT * FROM \"films\""] 550 | 551 | Select all Comedy films. 552 | 553 | #+BEGIN_SRC clojure :exports both :results verbatim 554 | (sql/select my-db [:*] 555 | (sql/from :films) 556 | (sql/where '(= :kind "Comedy"))) 557 | #+END_SRC 558 | 559 | #+RESULTS: 560 | : ["SELECT * FROM \"films\" WHERE (\"kind\" = ?)" "Comedy"] 561 | 562 | Retrieve the most recent weather report for each location. 563 | 564 | #+BEGIN_SRC clojure :exports both :results verbatim 565 | (sql/select my-db (sql/distinct [:location :time :report] :on [:location]) 566 | (sql/from :weather-reports) 567 | (sql/order-by :location (desc :time))) 568 | #+END_SRC 569 | 570 | #+RESULTS: 571 | : ["SELECT DISTINCT ON (\"location\") \"location\", \"time\", \"report\" FROM \"weather-reports\" ORDER BY \"location\", \"time\" DESC"] 572 | 573 | *** Update 574 | 575 | Change the word =Drama= to =Dramatic= in the =kind= column of the 576 | =films= table. 577 | 578 | #+BEGIN_SRC clojure :exports both :results verbatim 579 | (sql/update my-db :films {:kind "Dramatic"} 580 | (sql/where '(= :kind "Drama"))) 581 | #+END_SRC 582 | 583 | #+RESULTS: 584 | : ["UPDATE \"films\" SET \"kind\" = ? WHERE (\"kind\" = ?)" "Dramatic" "Drama"] 585 | 586 | Change all the values in the =kind= column of the table =films= to 587 | upper case. 588 | 589 | #+BEGIN_SRC clojure :exports both :results verbatim 590 | (sql/update my-db :films {:kind '(upper :kind)}) 591 | #+END_SRC 592 | 593 | #+RESULTS: 594 | : ["UPDATE \"films\" SET \"kind\" = upper(\"kind\")"] 595 | 596 | *** Order by 597 | 598 | The sort expression(s) can be any expression that would be valid in the query's select list. 599 | 600 | #+BEGIN_SRC clojure :exports both :results verbatim 601 | (sql/select my-db [:a :b] 602 | (sql/from :table-1) 603 | (sql/order-by '(+ :a :b) :c)) 604 | #+END_SRC 605 | 606 | #+RESULTS: 607 | : ["SELECT \"a\", \"b\" FROM \"table-1\" ORDER BY (\"a\" + \"b\"), \"c\""] 608 | 609 | A sort expression can also be the column label 610 | 611 | #+BEGIN_SRC clojure :exports both :results verbatim 612 | (sql/select my-db [(sql/as '(+ :a :b) :sum) :c] 613 | (sql/from :table-1) 614 | (sql/order-by :sum)) 615 | #+END_SRC 616 | 617 | #+RESULTS: 618 | : ["SELECT (\"a\" + \"b\") AS \"sum\", \"c\" FROM \"table-1\" ORDER BY \"sum\""] 619 | 620 | or the number of an output column. 621 | 622 | #+BEGIN_SRC clojure :exports both :results verbatim 623 | (sql/select my-db [:a '(max :b)] 624 | (sql/from :table-1) 625 | (sql/group-by :a) 626 | (sql/order-by 1)) 627 | #+END_SRC 628 | 629 | #+RESULTS: 630 | : ["SELECT \"a\", max(\"b\") FROM \"table-1\" GROUP BY \"a\" ORDER BY 1"] 631 | 632 | *** Having clause 633 | 634 | Groups can be restricted via a /HAVING/ clause. 635 | 636 | #+BEGIN_SRC clojure :exports both :results verbatim 637 | (sql/select my-db [:city '(max :temp-lo)] 638 | (sql/from :weather) 639 | (sql/group-by :city) 640 | (sql/having '(< (max :temp-lo) 40))) 641 | #+END_SRC 642 | 643 | #+RESULTS: 644 | : ["SELECT \"city\", max(\"temp-lo\") FROM \"weather\" GROUP BY \"city\" HAVING (max(\"temp-lo\") < 40)"] 645 | 646 | *** Values 647 | 648 | A bare /VALUES/ command. 649 | 650 | #+BEGIN_SRC clojure :exports both :results verbatim 651 | (sql/values my-db [[1 "one"] [2 "two"] [3 "three"]]) 652 | #+END_SRC 653 | 654 | #+RESULTS: 655 | : ["VALUES (1, ?), (2, ?), (3, ?)" "one" "two" "three"] 656 | 657 | This will return a table of two columns and three rows. It's 658 | effectively equivalent to. 659 | 660 | #+BEGIN_SRC clojure :exports both :results verbatim 661 | (sql/union 662 | {:all true} 663 | (sql/select my-db [(sql/as 1 :column1) (sql/as "one" :column2)]) 664 | (sql/select my-db [(sql/as 2 :column1) (sql/as "two" :column2)]) 665 | (sql/select my-db [(sql/as 3 :column1) (sql/as "three" :column2)])) 666 | #+END_SRC 667 | 668 | #+RESULTS: 669 | : ["SELECT 1 AS \"column1\", ? AS \"column2\" UNION ALL SELECT 2 AS \"column1\", ? AS \"column2\" UNION ALL SELECT 3 AS \"column1\", ? AS \"column2\"" "one" "two" "three"] 670 | 671 | More usually, /VALUES/ is used within a larger SQL command. The most 672 | common use is in /INSERT/. 673 | 674 | #+BEGIN_SRC clojure :exports both :results verbatim 675 | (sql/insert my-db :films [] 676 | (sql/values [{:code "T-601" 677 | :title "Yojimbo" 678 | :did 106 679 | :date-prod "1961-06-16" 680 | :kind "Drama"}])) 681 | #+END_SRC 682 | 683 | #+RESULTS: 684 | : ["INSERT INTO \"films\" (\"code\", \"date-prod\", \"did\", \"kind\", \"title\") VALUES (?, ?, 106, ?, ?)" "T-601" "1961-06-16" "Drama" "Yojimbo"] 685 | 686 | In the context of /INSERT/, entries of a /VALUES/ list can be 687 | /DEFAULT/ to indicate that the column default should be used here 688 | instead of specifying a value. 689 | 690 | #+BEGIN_SRC clojure :exports both :results verbatim 691 | (sql/insert my-db :films [] 692 | (sql/values [["UA502" "Bananas" 105 :DEFAULT "Comedy" "82 minutes"] 693 | ["T_601" "Yojimbo" 106 :DEFAULT "Drama" :DEFAULT]])) 694 | #+END_SRC 695 | 696 | #+RESULTS: 697 | : ["INSERT INTO \"films\" VALUES (?, ?, 105, DEFAULT, ?, ?), (?, ?, 106, DEFAULT, ?, DEFAULT)" "UA502" "Bananas" "Comedy" "82 minutes" "T_601" "Yojimbo" "Drama"] 698 | 699 | /VALUES/ can also be used where a sub /SELECT/ might be written, 700 | for example in a /FROM/ clause: 701 | 702 | #+BEGIN_SRC clojure :exports both :results verbatim 703 | (sql/select my-db [:f.*] 704 | (sql/from (sql/as :films :f) 705 | (sql/as (sql/values [["MGM" "Horror"] ["UA" "Sci-Fi"]]) 706 | :t [:studio :kind])) 707 | (sql/where '(and (= :f.studio :t.studio) 708 | (= :f.kind :t.kind)))) 709 | #+END_SRC 710 | 711 | #+RESULTS: 712 | : ["SELECT \"f\".* FROM \"films\" \"f\", (VALUES (?, ?), (?, ?)) AS \"t\" (\"studio\", \"kind\") WHERE ((\"f\".\"studio\" = \"t\".\"studio\") and (\"f\".\"kind\" = \"t\".\"kind\"))" "MGM" "Horror" "UA" "Sci-Fi"] 713 | 714 | Note that an /AS/ clause is required when /VALUES/ is used in a 715 | /FROM/ clause, just as is true for /SELECT/. It is not required 716 | that the /AS/ clause specify names for all the columns, but it's 717 | good practice to do so. (The default column names for /VALUES/ are 718 | column1, column2, etc in PostgreSQL, but these names might be 719 | different in other database systems.) 720 | 721 | #+BEGIN_SRC clojure :exports both :results verbatim 722 | (sql/update my-db :employees 723 | {:salary '(* :salary :v.increase)} 724 | (sql/from (sql/as (sql/values [[1 200000 1.2] [2 400000 1.4]]) 725 | :v [:depno :target :increase])) 726 | (sql/where '(and (= :employees.depno :v.depno) 727 | (>= :employees.sales :v.target)))) 728 | #+END_SRC 729 | 730 | #+RESULTS: 731 | : ["UPDATE \"employees\" SET \"salary\" = (\"salary\" * \"v\".\"increase\") FROM (VALUES (1, 200000, 1.2), (2, 400000, 1.4)) AS \"v\" (\"depno\", \"target\", \"increase\") WHERE ((\"employees\".\"depno\" = \"v\".\"depno\") and (\"employees\".\"sales\" >= \"v\".\"target\"))"] 732 | 733 | When /VALUES/ is used in /INSERT/, the values are all 734 | automatically coerced to the data type of the corresponding 735 | destination column. When it's used in other contexts, it might be 736 | necessary to specify the correct data type. If the entries are all 737 | quoted literal constants, coercing the first is sufficient to 738 | determine the assumed type for all: 739 | 740 | #+BEGIN_SRC clojure :exports both :results verbatim 741 | (sql/select my-db [:*] 742 | (sql/from :machines) 743 | (sql/where `(in :ip-address 744 | ~(sql/values [['(cast "192.168.0.1" :inet)] 745 | ["192.168.0.10"] 746 | ["192.168.1.43"]])))) 747 | #+END_SRC 748 | 749 | #+RESULTS: 750 | : ["SELECT * FROM \"machines\" WHERE \"ip-address\" IN (VALUES (CAST(? AS INET)), (?), (?))" "192.168.0.1" "192.168.0.10" "192.168.1.43"] 751 | 752 | *** With Queries / Common table expressions 753 | 754 | You can compose more complex /SQL/ statements with common table 755 | expressions. 756 | 757 | Define the =regional-sales= and =top-regions= helper functions. 758 | 759 | #+BEGIN_SRC clojure :exports code :results silent 760 | (defn regional-sales [db] 761 | (sql/select db [:region (sql/as '(sum :amount) :total-sales)] 762 | (sql/from :orders) 763 | (sql/group-by :region))) 764 | #+END_SRC 765 | 766 | #+BEGIN_SRC clojure :exports code :results silent 767 | (defn top-regions [db] 768 | (sql/select db [:region] 769 | (sql/from :regional-sales) 770 | (sql/where `(> :total-sales 771 | ~(sql/select db ['(/ (sum :total-sales) 10)] 772 | (sql/from :regional-sales)))))) 773 | #+END_SRC 774 | 775 | And use them in a common table expression. 776 | 777 | #+BEGIN_SRC clojure :exports both :results verbatim 778 | (sql/with my-db [:regional-sales (regional-sales my-db) 779 | :top-regions (top-regions my-db)] 780 | (sql/select my-db [:region :product 781 | (sql/as '(sum :quantity) :product-units) 782 | (sql/as '(sum :amount) :product-sales)] 783 | (sql/from :orders) 784 | (sql/where `(in :region ~(sql/select my-db [:region] 785 | (sql/from :top-regions)))) 786 | (sql/group-by :region :product))) 787 | #+END_SRC 788 | 789 | #+RESULTS: 790 | : ["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\""] 791 | 792 | For more complex examples, look at the [[https://github.com/r0man/sqlingvo/blob/master/test/sqlingvo][tests]]. 793 | 794 | ** License 795 | 796 | Copyright © 2012-2020 [[https://github.com/r0man][r0man]] 797 | 798 | Distributed under the Eclipse Public License, the same as Clojure. 799 | -------------------------------------------------------------------------------- /src/sqlingvo/compiler.cljc: -------------------------------------------------------------------------------- 1 | (ns sqlingvo.compiler 2 | #?(:cljs (:require-macros [sqlingvo.compiler :refer [defarity]])) 3 | (:require [clojure.core :as core] 4 | [clojure.string :as str] 5 | [sqlingvo.expr :as expr] 6 | [sqlingvo.util :as util :refer [sql-quote sql-quote-fn]])) 7 | 8 | (defmulti compile-sql 9 | "Compile the `ast` into SQL." 10 | (fn [db ast] (:op ast))) 11 | 12 | (defn to-sql [arg] 13 | (cond 14 | (string? arg) 15 | [arg] 16 | (sequential? arg) 17 | arg)) 18 | 19 | (defn concat-sql [& args] 20 | (->> (remove nil? args) 21 | (map to-sql) 22 | (reduce (fn [stmt [sql & args]] 23 | (cons (apply str [(first stmt) sql]) 24 | (concat (rest stmt) args))) 25 | []))) 26 | 27 | (defn join-sql [separator args] 28 | (let [args (map to-sql args)] 29 | (cons (str/join separator (remove str/blank? (map first args))) 30 | (apply concat (map rest args))))) 31 | 32 | (defn compile-sql-join [db separator args] 33 | (join-sql separator (map #(compile-sql db %) args))) 34 | 35 | (defn keyword-sql [k] 36 | (str/replace (str/upper-case (name k)) #"-" " ")) 37 | 38 | (defn wrap-stmt [stmt] 39 | (let [[sql & args] stmt] 40 | (cons (str "(" sql ")") args))) 41 | 42 | (defn unwrap-stmt [stmt] 43 | (let [[sql & args] stmt] 44 | (cons (str/replace sql #"^\(|\)$" "") args))) 45 | 46 | (defn- compile-set-op [db op {:keys [stmts all] :as node}] 47 | (let [separater (str " " (str/upper-case (name op)) " " (if all "ALL "))] 48 | (compile-sql-join db separater (:stmts node)))) 49 | 50 | (defn- placeholder 51 | "Returns the next placeholder for an SQL parameter." 52 | [db] 53 | ((or (:sql-next-placeholder db) 54 | (util/sql-placeholder-constant)))) 55 | 56 | ;; COMPILE CONSTANTS 57 | 58 | (defn compile-inline [db node] 59 | [(str (:val node))]) 60 | 61 | (defmulti compile-const 62 | "Compile a SQL constant into a SQL statement." 63 | (fn [db node] (:type node))) 64 | 65 | (defmethod compile-const :number [db node] 66 | (compile-inline db node)) 67 | 68 | (defmethod compile-const :string [db node] 69 | (if (:inline? node) 70 | [(str "'" (:val node) "'")] 71 | [(str (placeholder db)) (:val node)])) 72 | 73 | (defmethod compile-const :symbol [db node] 74 | (compile-inline db node)) 75 | 76 | (defmethod compile-const :default [db node] 77 | [(str (placeholder db)) (:form node)]) 78 | 79 | ;; COMPILE EXPRESSIONS 80 | 81 | (defn- compile-array [db {:keys [children]}] 82 | (concat-sql "ARRAY[" (compile-sql-join db ", " children) "]")) 83 | 84 | (defmulti compile-expr 85 | "Compile a SQL expression." 86 | (fn [db ast] (:op ast))) 87 | 88 | (defmethod compile-expr :array [db node] 89 | (compile-array db node)) 90 | 91 | (defmethod compile-expr :select [db expr] 92 | (concat-sql (wrap-stmt (compile-sql db expr)))) 93 | 94 | (defmethod compile-expr :default [db node] 95 | (compile-sql db node)) 96 | 97 | (defn compile-exprs [db exprs] 98 | (map #(compile-expr db %1) exprs)) 99 | 100 | ;; Compile function calls 101 | 102 | (defn- aggregate-modifier? 103 | "Returns true if `node` is a modifier of an aggregate expression, otherwise false." 104 | [node] 105 | (#{"ALL" "DISTINCT"} (some-> node :val name str/upper-case))) 106 | 107 | (defn- order-by? 108 | "Returns true if `node` is an ORDER BY expression, otherwise false." 109 | [node] 110 | (and (= (:op node) :list) 111 | (= (some-> node :children first :val name str/upper-case) "ORDER-BY"))) 112 | 113 | (defn- parse-aggregate-expression 114 | "Parse an aggregate expression." 115 | [node] 116 | (let [[[f & args] remaining] (split-with (complement order-by?) (:children node)) 117 | [[modifier] args] (split-with aggregate-modifier? args)] 118 | [f modifier args remaining])) 119 | 120 | (defn compile-aggregate-expression 121 | "Compile an aggregate expression to SQL." 122 | [db node] 123 | (let [[f modifier args remaining] (parse-aggregate-expression node)] 124 | (concat-sql 125 | (sql-quote-fn db (:val f)) "(" 126 | (when modifier (concat-sql (some-> modifier :val name str/upper-case) " ")) 127 | (join-sql ", " (compile-exprs db args)) 128 | (when (not-empty remaining) 129 | (concat-sql " " (join-sql " " (compile-exprs db remaining)))) 130 | ")"))) 131 | 132 | (defn compile-2-ary 133 | "Compile a 2-arity SQL function node into a SQL statement." 134 | [db node] 135 | (let [[name & args] (:children node)] 136 | (assert (< 1 (count args)) "More than 1 arg needed.") 137 | (->> (map (fn [[arg-1 arg-2]] 138 | (concat-sql "(" (compile-expr db arg-1) 139 | " " (core/name (:val name)) " " 140 | (compile-expr db arg-2) ")")) 141 | (partition 2 1 args)) 142 | (join-sql " AND ")))) 143 | 144 | (defn compile-infix 145 | "Compile a SQL infix function node into a SQL statement." 146 | [db node] 147 | (let [[name & args] (:children node)] 148 | (cond 149 | (= 1 (count args)) 150 | (compile-expr db (first args)) 151 | :else 152 | (let [args (compile-exprs db args)] 153 | (cons (str "(" (str/join (str " " (core/name (:val name)) " ") (map first args)) ")") 154 | (apply concat (map rest args))))))) 155 | 156 | (defn compile-complex-args [db node] 157 | (let [[name & args] (:children node)] 158 | (concat-sql 159 | "(" (-> name :val core/name) " " 160 | (compile-sql-join db " " args) 161 | ")"))) 162 | 163 | (defn compile-whitespace-args [db node] 164 | (let [[name & args] (:children node)] 165 | (concat-sql 166 | (-> name :val core/name) "(" 167 | (compile-sql-join db " " args) 168 | ")"))) 169 | 170 | (defmulti compile-fn 171 | "Compile a SQL function node into a SQL statement." 172 | (fn [db node] 173 | (some-> node :children first :val keyword))) 174 | 175 | (defmethod compile-fn :-> [db node] 176 | (compile-sql-join db "->" (-> node :children rest))) 177 | 178 | (defmethod compile-fn :->> [db node] 179 | (compile-sql-join db "->>" (-> node :children rest))) 180 | 181 | (defmethod compile-fn :array_subvec [db node] 182 | (let [[_ array start end] (:children node)] 183 | (concat-sql "(" (compile-sql db array) ")" 184 | (str "[" (:val start) ":" (:val end) "]")))) 185 | 186 | (defmethod compile-fn :as [db node] 187 | (let [[_ source target] (:children node)] 188 | (concat-sql (compile-sql db source) " AS " (compile-sql db target)))) 189 | 190 | (defmethod compile-fn :case [db node] 191 | (let [[_ & args] (:children node) 192 | parts (partition 2 2 nil args)] 193 | (concat-sql (apply concat-sql "CASE" 194 | (concat (for [[test then] (filter #(= 2 (count %1)) parts)] 195 | (concat-sql " WHEN " 196 | (compile-expr db test) " THEN " 197 | (compile-expr db then))) 198 | (for [[else] (filter #(= 1 (count %1)) parts)] 199 | (concat-sql " ELSE " (compile-expr db else))) 200 | [" END"]))))) 201 | 202 | (defn- compile-sql-type 203 | "Compile an SQL type." 204 | [db {:keys [op] :as type}] 205 | (cond 206 | ;; Array type 207 | (= op :array) 208 | (concat-sql 209 | (util/sql-type-name 210 | db (-> type :children first :name)) "[]") 211 | ;; Type in schema 212 | (and (= op :column) (:table type) (:name type)) 213 | (compile-sql db type) 214 | :else 215 | (util/sql-type-name db (:name type)))) 216 | 217 | (defmethod compile-fn :cast [db node] 218 | (let [[_ & [expr type]] (:children node)] 219 | (concat-sql "CAST(" (compile-expr db expr) 220 | " AS " (compile-sql-type db type) ")"))) 221 | 222 | (defmethod compile-fn :count [db node] 223 | (let [[name & args] (:children node)] 224 | (concat-sql "count(" 225 | (if (= 'distinct (:form (first args))) "DISTINCT ") 226 | (join-sql ", " (map #(compile-expr db %1) 227 | (remove #(= 'distinct (:form %1)) args))) ")"))) 228 | 229 | (defn- compile-list 230 | "Compile `node` into a comma separated list." 231 | [db node] 232 | (concat-sql "(" (compile-sql-join db ", " (:children node)) ")")) 233 | 234 | (defmethod compile-fn :in [db node] 235 | (let [[_ member expr] (:children node)] 236 | (concat-sql 237 | (compile-expr db member) " IN " 238 | (cond 239 | (or (= (:op expr) :list) 240 | (= (:op expr) :expr-list)) 241 | (if (empty? (:children expr)) 242 | "(NULL)" (compile-list db expr)) 243 | 244 | (= (:op expr) :values) 245 | (concat-sql "(" (compile-expr db expr) ")") 246 | 247 | :else 248 | (compile-expr db expr))))) 249 | 250 | (defmethod compile-fn :exists [db node] 251 | (let [[_ & args] (:children node)] 252 | (concat-sql "(EXISTS " (compile-expr db (first args)) ")"))) 253 | 254 | (defmethod compile-fn :not [db node] 255 | (let [[_ & args] (:children node)] 256 | (concat-sql "(NOT " (compile-expr db (first args)) ")"))) 257 | 258 | (defmethod compile-fn :not-exists [db node] 259 | (let [[_ & args] (:children node)] 260 | (concat-sql "(NOT EXISTS " (compile-expr db (first args)) ")"))) 261 | 262 | (defmethod compile-fn :is-null [db node] 263 | (let [[_ & args] (:children node)] 264 | (concat-sql "(" (compile-expr db (first args)) " IS NULL)"))) 265 | 266 | (defmethod compile-fn :is-not-null [db node] 267 | (let [[_ & args] (:children node)] 268 | (concat-sql "(" (compile-expr db (first args)) " IS NOT NULL)"))) 269 | 270 | (defmethod compile-fn :not-like [db node] 271 | (let [[_ & args] (:children node) 272 | [string pattern] (compile-exprs db args)] 273 | (concat-sql "(" string " NOT LIKE " pattern ")" ))) 274 | 275 | (defmethod compile-fn :range [db node] 276 | (let [[_ & args] (:children node)] 277 | (concat-sql "(" (compile-sql-join db ", " args) ")"))) 278 | 279 | (defmethod compile-fn :row [db node] 280 | (let [[_ & args] (:children node)] 281 | (concat-sql "ROW(" (join-sql ", " (compile-exprs db args)) ")"))) 282 | 283 | (defmethod compile-fn :over [db node] 284 | (let [[_ & args] (:children node) 285 | args (map #(compile-sql db %) args)] 286 | (concat-sql (first args) " OVER (" 287 | (join-sql " " (rest args)) ")"))) 288 | 289 | (defmethod compile-fn :partition-by [db node] 290 | (let [[_ & args] (:children node) 291 | [expr & more-args] args] 292 | (concat-sql "PARTITION BY " 293 | (if (= :array (:op expr)) 294 | (compile-sql-join db ", " (:children expr)) 295 | (compile-expr db expr)) 296 | (when (seq more-args) 297 | (concat-sql " " (compile-sql-join db " " more-args)))))) 298 | 299 | (defmethod compile-fn :order-by [db node] 300 | (let [[_ & args] (:children node)] 301 | (concat-sql "ORDER BY " (compile-sql-join db ", " args)))) 302 | 303 | (defn- compile-direction [db node] 304 | (let [[name & args] (:children node)] 305 | (concat-sql (compile-sql db (first args)) " " 306 | (str/upper-case (-> name :val core/name))))) 307 | 308 | (defmethod compile-fn :asc [db node] 309 | (compile-direction db node)) 310 | 311 | (defmethod compile-fn :desc [db node] 312 | (compile-direction db node)) 313 | 314 | (defmethod compile-fn :nulls [db node] 315 | (let [[_ args direction] (:children node)] 316 | (concat-sql (compile-sql db args) " NULLS " 317 | (-> direction :val name str/upper-case)))) 318 | 319 | (defmethod compile-fn :raw [db node] 320 | (-> (:children node) 321 | (second) 322 | (:val))) 323 | 324 | (defmethod compile-fn :default [db node] 325 | (let [[name & args] (:children node) ] 326 | (concat-sql (sql-quote-fn db (:val name)) "(" 327 | (join-sql ", " (compile-exprs db args)) ")"))) 328 | 329 | ;; COMPILE FROM CLAUSE 330 | 331 | (defmulti compile-from (fn [db ast] (:op ast))) 332 | 333 | (defmethod compile-from :list [db fn] 334 | (compile-sql db fn)) 335 | 336 | (defmethod compile-from :select [db node] 337 | (let [[sql & args] (compile-sql db node)] 338 | (cons (str "(" sql ") AS " (sql-quote db (:as node))) args))) 339 | 340 | (defmethod compile-from :table [db node] 341 | (compile-sql db node)) 342 | 343 | (defmethod compile-from :alias [db node] 344 | (compile-sql db node)) 345 | 346 | (defn- compile-reference [db reference] 347 | (let [table (expr/parse-column reference) 348 | column (expr/parse-column reference)] 349 | (concat-sql 350 | (->> {:op :table 351 | :schema (or (:schema column) (:schema table)) 352 | :name (or (:table column) (:name table))} 353 | (compile-sql db)) 354 | (when (:table column) 355 | (concat-sql " (" (sql-quote db (:name column)) ")"))))) 356 | 357 | (defn- compile-geo-type 358 | "Compile a GEOMETRY or GEOGRAPHY column type." 359 | [db column] 360 | (concat-sql 361 | (util/sql-type-name db (:type column)) 362 | (when-let [geometry (:geometry column)] 363 | (str "(" (some-> column :geometry name 364 | str/upper-case 365 | (str/replace "-" "")) 366 | (when-let [srid (:srid column)] 367 | (str ", " (:srid column))) 368 | ")")))) 369 | 370 | (defmulti compile-column-type 371 | "Compile the column type." 372 | (fn [db column] (:type column))) 373 | 374 | (defmethod compile-column-type :geometry [db column] 375 | (compile-geo-type db column)) 376 | 377 | (defmethod compile-column-type :geography [db column] 378 | (compile-geo-type db column)) 379 | 380 | (defmethod compile-column-type :default [db {:keys [type]}] 381 | (if (str/index-of (name type) ".") 382 | (compile-sql db (expr/parse-type type)) 383 | (util/sql-type-name db type))) 384 | 385 | (defn compile-column [db column] 386 | (when (:length column) 387 | (println "Column :length is deprecated, use :size instead!")) 388 | (concat-sql 389 | (sql-quote db (:name column)) 390 | " " (compile-column-type db column) 391 | (when (:array? column) "[]") 392 | (when-let [size (or (:size column) (:size column))] 393 | (str "(" size ")")) 394 | (when (:not-null? column) 395 | " NOT NULL") 396 | (when (:unique? column) 397 | " UNIQUE") 398 | (when (:primary-key? column) 399 | " PRIMARY KEY") 400 | (when-let [references (:references column)] 401 | (concat-sql " REFERENCES " (compile-reference db references))) 402 | (when-let [default (:default column)] 403 | (concat-sql " DEFAULT " (compile-sql db default))))) 404 | 405 | ;; COMPILE SQL 406 | 407 | (defmethod compile-sql :alias 408 | [db {:keys [columns expr name]}] 409 | (concat-sql 410 | (if (contains? #{:except :intersect :select :values :union} (:op expr)) 411 | (wrap-stmt (compile-sql db expr)) 412 | (compile-sql db expr)) 413 | (if (= :table (:op expr)) 414 | " " " AS ") 415 | (sql-quote db name) 416 | (when (not-empty columns) 417 | (concat-sql 418 | " (" (join-sql ", " (map #(compile-sql db %) columns)) ")")))) 419 | 420 | (defmethod compile-sql :array [db node] 421 | (compile-array db node)) 422 | 423 | (defmethod compile-sql :cascade [db node] 424 | ["CASCADE"]) 425 | 426 | (defmethod compile-sql :check [db {:keys [expr]}] 427 | (concat-sql ["CHECK "] (compile-expr db expr))) 428 | 429 | (defmethod compile-sql :concurrently [db node] 430 | ["CONCURRENTLY"]) 431 | 432 | (defmethod compile-sql :condition [db {:keys [condition]}] 433 | (compile-sql db condition)) 434 | 435 | (defmethod compile-sql :column [db {:keys [schema form name table direction nulls]}] 436 | (concat-sql 437 | (if (and (namespace form) (core/name form)) 438 | (sql-quote db form) 439 | (->> [(if schema (sql-quote db schema)) 440 | (if table (sql-quote db table)) 441 | (if name (if (= :* name) "*" (sql-quote db name)))] 442 | (remove nil?) 443 | (str/join "."))))) 444 | 445 | (defmethod compile-sql :constant [db node] 446 | (compile-const db node)) 447 | 448 | (defmethod compile-sql :continue-identity [db {:keys [op]}] 449 | ["CONTINUE IDENTITY"]) 450 | 451 | (defmethod compile-sql :copy [db {:keys [columns delimiter encoding from to table]}] 452 | (concat-sql 453 | "COPY " 454 | (compile-sql db table) 455 | (when (not-empty columns) 456 | (concat-sql " (" (compile-sql-join db ", " columns) ")")) 457 | " FROM " 458 | (let [from (first from)] 459 | (cond 460 | #?@(:clj [(instance? java.io.File from) 461 | ["?" (.getAbsolutePath from)]] ) 462 | (string? from) 463 | ["?" #?(:clj (.getAbsolutePath (java.io.File. from)) :cljs from)] 464 | (= :stdin from) 465 | "STDIN")) 466 | (if encoding 467 | [(str " ENCODING " (placeholder db)) encoding]) 468 | (if delimiter 469 | [(str " DELIMITER " (placeholder db)) delimiter]))) 470 | 471 | (defmethod compile-sql :create-schema 472 | [db {:keys [schema if-not-exists]}] 473 | (concat-sql 474 | "CREATE SCHEMA" 475 | (when if-not-exists 476 | " IF NOT EXISTS") 477 | " " (compile-sql db schema))) 478 | 479 | (defmethod compile-sql :create-table 480 | [db {:keys [checks table if-not-exists inherits like primary-key temporary] :as node}] 481 | (let [columns (map (:column node) (:columns node))] 482 | (concat-sql 483 | "CREATE" 484 | (if temporary 485 | " TEMPORARY") 486 | " TABLE" 487 | (if if-not-exists 488 | " IF NOT EXISTS") 489 | (concat-sql " " (compile-sql db table)) 490 | " (" 491 | (->> [(cond 492 | (not (empty? columns)) 493 | (join-sql ", " (map #(compile-column db %1) columns)) 494 | like 495 | (compile-sql db like)) 496 | (when (not-empty checks) 497 | (compile-sql-join db ", " checks))] 498 | (join-sql ", ") ) 499 | (when (not-empty primary-key) 500 | (concat-sql ", PRIMARY KEY(" (str/join ", " (map #(sql-quote db %1) primary-key)) ")")) 501 | ")" 502 | (if inherits 503 | (concat-sql " INHERITS (" (compile-sql-join db ", " inherits) ")"))))) 504 | 505 | (defmethod compile-sql :enum-label 506 | [db {:keys [name] :as node}] 507 | (str "'" name "'")) 508 | 509 | (defmethod compile-sql :create-type 510 | [db {:keys [enum type] :as node}] 511 | (let [columns (map (:column node) (:columns node))] 512 | (concat-sql 513 | "CREATE TYPE " 514 | (compile-sql db type) 515 | (when enum 516 | (concat-sql 517 | " AS ENUM (" 518 | (->> (for [label (:labels enum)] 519 | (compile-sql db label)) 520 | (join-sql ", ")) 521 | ")"))))) 522 | 523 | (defmethod compile-sql :delete [db node] 524 | (let [{:keys [where table returning]} node] 525 | (concat-sql 526 | "DELETE FROM " (compile-sql db table) 527 | (when (not-empty where) 528 | (concat-sql " WHERE " (compile-sql db where))) 529 | (when (not-empty returning) 530 | (concat-sql " RETURNING " (compile-sql-join db ", " returning))) ))) 531 | 532 | (defmethod compile-sql :distinct [db {:keys [exprs on]}] 533 | (concat-sql 534 | "DISTINCT " 535 | (when (not-empty on) 536 | (concat-sql "ON (" (compile-sql-join db ", " on) ") ")) 537 | (compile-sql-join db ", " exprs))) 538 | 539 | (defmethod compile-sql :direction [db node] 540 | (concat-sql 541 | (compile-sql db (:expr node)) 542 | (case (:direction node) 543 | :asc " ASC" 544 | :desc " DESC"))) 545 | 546 | (defmethod compile-sql :drop-schema [db {:keys [cascade if-exists restrict schemas]}] 547 | (join-sql " " ["DROP SCHEMA" 548 | (compile-sql db if-exists) 549 | (compile-sql-join db ", " schemas) 550 | (compile-sql db cascade) 551 | (compile-sql db restrict)])) 552 | 553 | (defmethod compile-sql :drop-table [db {:keys [cascade if-exists restrict tables]}] 554 | (join-sql " " ["DROP TABLE" 555 | (compile-sql db if-exists) 556 | (compile-sql-join db ", " tables) 557 | (compile-sql db cascade) 558 | (compile-sql db restrict)])) 559 | 560 | (defmethod compile-sql :drop-type [db {:keys [cascade if-exists restrict types]}] 561 | (join-sql " " ["DROP TYPE" 562 | (compile-sql db if-exists) 563 | (compile-sql-join db ", " types) 564 | (compile-sql db cascade) 565 | (compile-sql db restrict)])) 566 | 567 | (defmethod compile-sql :except [db node] 568 | (compile-set-op db :except node)) 569 | 570 | (defmethod compile-sql :expr-list [db {:keys [as children]}] 571 | (concat-sql (compile-sql-join db " " children))) 572 | 573 | (defmulti compile-explain-option 574 | "Compile an EXPLAIN option." 575 | (fn [db [option value]] option)) 576 | 577 | (defmethod compile-explain-option :format 578 | [db [option value]] 579 | (assert (contains? #{:text :xml :json :yaml} value) 580 | (str "Invalid EXPLAIN format: " (name value))) 581 | (concat-sql "FORMAT " (str/upper-case (name value)))) 582 | 583 | (defmethod compile-explain-option :default 584 | [db [option value]] 585 | (assert (contains? #{:analyze :buffers :costs :timing :verbose} option) 586 | (str "Invalid EXPLAIN option: " (name option))) 587 | (concat-sql (str/upper-case (name option)) " " (str/upper-case (str (true? value))))) 588 | 589 | (defn compile-explain-options 590 | "Compile the EXPLAIN `options`." 591 | [db options] 592 | (when-not (empty? options) 593 | (concat-sql 594 | "(" (->> (map #(compile-explain-option db %) options) 595 | (join-sql ", ")) ")"))) 596 | 597 | (defmethod compile-sql :explain [db node] 598 | (let [opts (compile-explain-options db (:opts node))] 599 | (concat-sql "EXPLAIN " 600 | (if opts (concat-sql opts " ")) 601 | (compile-sql db (:stmt node))))) 602 | 603 | (defmethod compile-sql :attr [db node] 604 | (concat-sql 605 | "(" (compile-sql db (:arg node)) ")." 606 | (sql-quote db (:name node)))) 607 | 608 | (defmethod compile-sql :from [db {:keys [clause joins]}] 609 | (concat-sql "FROM " (join-sql ", " (map #(compile-from db %1) clause)) 610 | (when (not-empty joins) 611 | (compile-sql-join db " " joins)))) 612 | 613 | (defmethod compile-sql :group-by [db {:keys [exprs]}] 614 | (concat-sql "GROUP BY" (compile-sql db exprs))) 615 | 616 | (defmethod compile-sql :if-exists [_ _] ["IF EXISTS"]) 617 | (defmethod compile-sql :if-not-exists [_ _] ["IF NOT EXISTS"]) 618 | (defmethod compile-sql :or-replace [_ _] ["OR REPLACE"]) 619 | 620 | (defn- compile-value [db columns value] 621 | (let [values (map #(or (get value %) {:op :nil}) (map :form columns)) 622 | values (map #(compile-sql db %) values)] 623 | (concat-sql "(" (join-sql ", " values ) ")"))) 624 | 625 | (defn- compile-values-maps [db {:keys [columns values]}] 626 | (let [values (map #(compile-value db columns %) values)] 627 | (concat-sql ["VALUES "] (join-sql ", " values)))) 628 | 629 | (defn- compile-values-exprs [db node] 630 | (concat-sql 631 | ["VALUES "] 632 | (->> (for [exprs (:values node)] 633 | (concat-sql 634 | "(" (->> exprs 635 | (map #(compile-sql db %)) 636 | (join-sql ", ")) ")")) 637 | (join-sql ", ")))) 638 | 639 | (defmethod compile-sql :values [db node] 640 | (case (:type node) 641 | :default ["DEFAULT VALUES"] 642 | :exprs (compile-values-exprs db node) 643 | :records (compile-values-maps db node))) 644 | 645 | (defn compile-row [db row] 646 | (join-sql 647 | ", " 648 | (for [column (keys row)] 649 | (concat-sql 650 | (str (sql-quote db column) " = ") 651 | (compile-sql db (get row column)))))) 652 | 653 | (defmethod compile-sql :do-nothing [db node] 654 | " DO NOTHING") 655 | 656 | (defmethod compile-sql :do-update [db node] 657 | (concat-sql " DO UPDATE SET " (compile-row db (:expr node)))) 658 | 659 | (defmethod compile-sql :on-conflict [db node] 660 | (concat-sql 661 | " ON CONFLICT " 662 | (when-let [target (:target node)] 663 | (concat-sql "(" (join-sql ", " (map #(compile-sql db %) target)) ")")) 664 | (compile-sql db (:do-update node)) 665 | (when-let [where (:where node)] 666 | (concat-sql " WHERE " (compile-sql db where))) 667 | (compile-sql db (:do-nothing node)))) 668 | 669 | (defmethod compile-sql :on-conflict-on-constraint [db node] 670 | (concat-sql 671 | " ON CONFLICT ON CONSTRAINT" 672 | (when-let [target (:target node)] 673 | (concat-sql " " (sql-quote db target))) 674 | (compile-sql db (:do-update node)) 675 | (when-let [where (:where node)] 676 | (concat-sql " WHERE " (compile-sql db where))) 677 | (compile-sql db (:do-nothing node)))) 678 | 679 | (defmethod compile-sql :insert 680 | [db {:keys [columns table rows values returning select where with] :as node}] 681 | (let [columns (if (not-empty columns) columns (:columns values))] 682 | (concat-sql 683 | "INSERT INTO " (compile-sql db table) 684 | (when (not-empty columns) 685 | (concat-sql " (" (compile-sql-join db ", " columns) ")")) 686 | (when values 687 | (concat-sql " " (compile-sql db values))) 688 | (when select 689 | (concat-sql " " (compile-sql db select))) 690 | (when with 691 | (concat-sql " " (compile-sql db with))) 692 | (when (not-empty where) 693 | (concat-sql " WHERE " (compile-sql db where))) 694 | (compile-sql db (:on-conflict node)) 695 | (compile-sql db (:on-conflict-on-constraint node)) 696 | (when (not-empty returning) 697 | (concat-sql " RETURNING " (compile-sql-join db ", " returning)))))) 698 | 699 | (defmethod compile-sql :intersect [db node] 700 | (compile-set-op db :intersect node)) 701 | 702 | (defmethod compile-sql :join [db {:keys [on using from how type outer]}] 703 | (concat-sql 704 | (case type 705 | :cross "CROSS " 706 | :inner "INNER " 707 | :left "LEFT " 708 | :right "RIGHT " 709 | :full "FULL " 710 | nil "") 711 | (if outer "OUTER ") 712 | "JOIN " (compile-from db from) 713 | (if on 714 | (concat-sql " ON " (compile-sql db on))) 715 | (when (not-empty using) 716 | (concat-sql " USING (" (compile-sql-join db ", " using) ")")))) 717 | 718 | (defmethod compile-sql :keyword [db {:keys [form]}] 719 | [(sql-quote db form)]) 720 | 721 | (defmethod compile-sql :limit [db {:keys [expr]}] 722 | (concat-sql "LIMIT " (compile-expr db expr))) 723 | 724 | (defmethod compile-sql :like [db {:keys [excluding including table]}] 725 | (concat-sql 726 | "LIKE " 727 | (compile-sql db table) 728 | (when (not-empty including) 729 | (str " INCLUDING " (str/join " " (map keyword-sql including)))) 730 | (when (not-empty excluding) 731 | (str " EXCLUDING " (str/join " " (map keyword-sql excluding)))))) 732 | 733 | (defmethod compile-sql :list [db node] 734 | (concat-sql 735 | (compile-fn db node) 736 | (when-let [direction (:direction node) ] 737 | (str " " (str/upper-case (name direction)))))) 738 | 739 | (defmethod compile-sql :nil [db _] ["NULL"]) 740 | 741 | (defmethod compile-sql :offset [db {:keys [expr]}] 742 | (concat-sql "OFFSET " (compile-expr db expr))) 743 | 744 | (defmethod compile-sql :schema [db {:keys [name]}] 745 | (sql-quote db name)) 746 | 747 | (defmethod compile-sql :table [db {:keys [schema name]}] 748 | [(str (str/join "." (map #(sql-quote db %1) (remove nil? [schema name]))))]) 749 | 750 | (defmethod compile-sql :type [db {:keys [schema name]}] 751 | (concat-sql 752 | (when schema (str (sql-quote db schema) ".")) 753 | (sql-quote db name))) 754 | 755 | (defmethod compile-sql :create-materialized-view [db node] 756 | (let [{:keys [columns if-not-exists or-replace select values view]} node] 757 | (concat-sql "CREATE " 758 | (when or-replace 759 | (concat-sql (compile-sql db or-replace) " ")) 760 | "MATERIALIZED VIEW " 761 | (when if-not-exists 762 | (concat-sql (compile-sql db if-not-exists) " ")) 763 | (compile-sql db view) 764 | (when (seq columns) 765 | (concat-sql " (" (compile-sql-join db ", " columns) ")")) 766 | (when select 767 | (concat-sql " AS " (compile-sql db select))) 768 | (when values 769 | (concat-sql " AS " (compile-sql db values)))))) 770 | 771 | (defmethod compile-sql :drop-materialized-view [db node] 772 | (let [{:keys [cascade if-exists restrict view]} node] 773 | (concat-sql "DROP MATERIALIZED VIEW " 774 | (if if-exists 775 | (concat-sql (compile-sql db if-exists) " ")) 776 | (compile-sql db view) 777 | (if cascade 778 | (concat-sql " " (compile-sql db cascade))) 779 | (if restrict 780 | (concat-sql " " (compile-sql db restrict)))))) 781 | 782 | (defmethod compile-sql :drop-view [db node] 783 | (let [{:keys [cascade if-exists restrict view]} node] 784 | (concat-sql "DROP VIEW " 785 | (if if-exists 786 | (concat-sql (compile-sql db if-exists) " ")) 787 | (compile-sql db view) 788 | (if cascade 789 | (concat-sql " " (compile-sql db cascade))) 790 | (if restrict 791 | (concat-sql " " (compile-sql db restrict)))))) 792 | 793 | (defmethod compile-sql :refresh-materialized-view [db node] 794 | (let [{:keys [concurrently view with-data]} node] 795 | (concat-sql "REFRESH MATERIALIZED VIEW " 796 | (if concurrently 797 | (concat-sql (compile-sql db concurrently) " ")) 798 | (compile-sql db view) 799 | (if with-data 800 | (concat-sql " " (compile-sql db with-data)))))) 801 | 802 | (defmethod compile-sql :restrict [db {:keys [op]}] 803 | ["RESTRICT"]) 804 | 805 | (defmethod compile-sql :restart-identity [db {:keys [op]}] 806 | ["RESTART IDENTITY"]) 807 | 808 | (defn- compile-sort-expression 809 | [db {:keys [direction nulls] :as node}] 810 | (concat-sql 811 | (compile-sql db node) 812 | ;; (if direction (str " " (str/upper-case (core/name direction)))) 813 | (if nulls (str " NULLS " (keyword-sql nulls))))) 814 | 815 | (defmethod compile-sql :select [db node] 816 | (let [{:keys [exprs distinct joins from where group-by limit offset order-by set]} node] 817 | (concat-sql 818 | "SELECT " (join-sql ", " (map #(compile-expr db %1) exprs)) 819 | (if distinct 820 | (compile-sql db distinct)) 821 | (when (not-empty from) 822 | (concat-sql " FROM " (join-sql ", " (map #(compile-from db %1) from)))) 823 | (when (not-empty joins) 824 | (concat-sql " " (compile-sql-join db " " joins))) 825 | (when (not-empty where) 826 | (concat-sql " WHERE " (compile-sql db where))) 827 | (when (not-empty group-by) 828 | (concat-sql " GROUP BY " (compile-sql-join db ", " group-by))) 829 | (when-let [having (:having node)] 830 | (concat-sql " HAVING " (compile-sql db having))) 831 | (when-let [window (:window node)] 832 | (concat-sql " " (compile-sql db window))) 833 | (when (not-empty order-by) 834 | (concat-sql " ORDER BY " (join-sql ", " (map #(compile-sort-expression db %1) order-by)))) 835 | (when-let [limit-sql (and limit (seq (compile-sql db limit)))] 836 | (concat-sql " " limit-sql)) 837 | (if offset 838 | (concat-sql " " (compile-sql db offset))) 839 | (when (not-empty set) 840 | (concat-sql " " (compile-sql-join db ", " set)))))) 841 | 842 | (defmethod compile-sql :truncate [db {:keys [tables continue-identity restart-identity cascade restrict]}] 843 | (join-sql " " ["TRUNCATE TABLE" 844 | (compile-sql-join db ", " tables) 845 | (compile-sql db continue-identity) 846 | (compile-sql db restart-identity) 847 | (compile-sql db cascade) 848 | (compile-sql db restrict)])) 849 | 850 | (defmethod compile-sql :union [db node] 851 | (compile-set-op db :union node)) 852 | 853 | (defmethod compile-sql :update [db node] 854 | (let [{:keys [where from exprs table row returning]} node] 855 | (concat-sql 856 | "UPDATE " (compile-sql db table) 857 | " SET " 858 | (if row 859 | (compile-row db row) 860 | (join-sql ", "(map unwrap-stmt (compile-exprs db exprs)))) 861 | (when (not-empty from) 862 | (concat-sql " FROM " (join-sql " " (map #(compile-from db %1) from)))) 863 | (when (not-empty where) 864 | (concat-sql " WHERE " (compile-sql db where))) 865 | (when (not-empty returning) 866 | (concat-sql " RETURNING " (compile-sql-join db ", " returning)))))) 867 | 868 | (defmethod compile-sql :with 869 | [db {:keys [bindings query] :as node}] 870 | (concat-sql 871 | "WITH " 872 | (join-sql 873 | ", " (map (fn [alias stmt] 874 | (concat-sql (sql-quote db alias) " AS (" (compile-sql db stmt) ")")) 875 | (map first bindings) 876 | (map second bindings))) 877 | " " (compile-sql db query))) 878 | 879 | (defmethod compile-sql :window [db node] 880 | (->> (for [alias (:definitions node)] 881 | (concat-sql 882 | (sql-quote db (:name alias)) 883 | " AS (" (compile-sql db (:expr alias)) ")")) 884 | (join-sql ", ") 885 | (concat-sql "WINDOW " ))) 886 | 887 | (defmethod compile-sql :with-data [db node] 888 | (if (:data node) 889 | ["WITH DATA"] 890 | ["WITH NO DATA"])) 891 | 892 | (defmethod compile-sql nil [db {:keys [op]}] 893 | []) 894 | 895 | ;; DEFINE SQL FN ARITY 896 | 897 | (defmacro defarity 898 | "Define SQL functions in terms of `arity-fn`." 899 | [arity-fn & fns] 900 | `(do ~@(for [fn# (map keyword fns)] 901 | `(defmethod sqlingvo.compiler/compile-fn ~fn# 902 | [~'db ~'node] 903 | (~arity-fn ~'db ~'node))))) 904 | 905 | (defarity compile-2-ary 906 | "=" "!=" "<>" "<#>" "<->" "<" ">" "<=" ">=" 907 | "&&" "<@" "@>" "/" "^" "~" "~*" "like" "ilike") 908 | 909 | (defarity compile-infix 910 | "+" "-" "*" "&" "!~" "!~*" "%" "and" "or" "union" "||" "overlaps" "@@") 911 | 912 | (defarity compile-complex-args 913 | "partition") 914 | 915 | (defarity compile-whitespace-args 916 | "substring" "trim") 917 | 918 | ;; Aggregate Functions, https://www.postgresql.org/docs/9.5/static/functions-aggregate.html 919 | 920 | (defarity compile-aggregate-expression 921 | "array_agg" 922 | "avg" 923 | "bit_and" 924 | "bit_or" 925 | "bool_and" 926 | "bool_or" 927 | "count" 928 | "every" 929 | "json_agg" 930 | "json_object_agg" 931 | "jsonb_agg" 932 | "jsonb_object_agg" 933 | "max" 934 | "min" 935 | "string_agg" 936 | "sum" 937 | "xmlagg") 938 | 939 | (defn compile-stmt 940 | "Compile `stmt` into a clojure.java.jdbc compatible prepared 941 | statement vector." 942 | [stmt] 943 | (let [{:keys [db] :as ast} (expr/ast stmt) 944 | placeholder ((or (:sql-placeholder db) util/sql-placeholder-constant)) 945 | db (assoc db :sql-next-placeholder placeholder)] 946 | (vec (compile-sql db ast)))) 947 | --------------------------------------------------------------------------------