honeysql/test/honeysql/format.cljc
Sean Corfield 11ef895c4a Clean up dialect support; start docs
Also move old namespaces to test-only tree for reference while I 
continue developing V2.
2020-09-24 19:07:32 -07:00

714 lines
22 KiB
Clojure

(ns honeysql.format
(:refer-clojure :exclude [format])
(:require [honeysql.types :as types
:refer [call raw param param-name inline-str
#?@(:cljs [SqlCall SqlRaw SqlParam SqlArray SqlInline])]]
[clojure.string :as string])
#?(:clj (:import [honeysql.types SqlCall SqlRaw SqlParam SqlArray SqlInline])))
;;(set! *warn-on-reflection* true)
;;;;
(defn comma-join [s]
(string/join ", " s))
(defn space-join [s]
(string/join " " s))
(defn paren-wrap [x]
(str "(" x ")"))
(def ^:dynamic *clause*
"During formatting, *clause* is bound to :select, :from, :where, etc."
nil)
(def ^:dynamic *params*
"Will be bound to an atom-vector that accumulates SQL parameters across
possibly-recursive function calls"
nil)
(def ^:dynamic *param-names* nil)
(def ^:dynamic *param-counter* nil)
(def ^:dynamic *all-param-counter* nil)
(def ^:dynamic *input-params* nil)
(def ^:dynamic *fn-context?* false)
(def ^:dynamic *value-context?* false)
(def ^:dynamic *subquery?* false)
(def ^:dynamic *allow-dashed-names?* false)
(def ^:dynamic *allow-namespaced-names?* false)
(def ^:dynamic *namespace-as-table?* false)
(def ^:dynamic *name-transform-fn* nil)
(def ^:private quote-fns
{:ansi #(str \" (string/replace % "\"" "\"\"") \")
:mysql #(str \` (string/replace % "`" "``") \`)
:sqlserver #(str \[ (string/replace % "]" "]]") \])
:oracle #(str \" (string/replace % "\"" "\"\"") \")})
(defmulti parameterize (fn [parameterizer & args] parameterizer))
(defmethod parameterize :postgresql [_ value pname]
(str "$" (swap! *all-param-counter* inc)))
(defmethod parameterize :jdbc [_ value pname]
"?")
(defmethod parameterize :none [_ value pname]
(str (last @*params*)))
(def ^:dynamic *quote-identifier-fn* nil)
(def ^:dynamic *parameterizer* nil)
(defn- undasherize [s]
(string/replace s "-" "_"))
;; String.toUpperCase() or `string/upper-case` for that matter converts the string to uppercase for the DEFAULT
;; LOCALE. Normally this does what you'd expect but things like `inner join` get converted to `İNNER JOIN` (dot over
;; the I) when user locale is Turkish. This predictably has bad consequences for people who like their SQL queries to
;; work. The fix here is to use String.toUpperCase(Locale/US) instead which always converts things the way we'd expect.
;;
;; Use this function instead of `string/upper-case` as it will always use Locale/US.
(def ^:private ^{:arglists '([s])} upper-case
;; TODO - not sure if there's a JavaScript equivalent here we should be using as well
#?(:clj (fn [^String s] (.. s toString (toUpperCase (java.util.Locale/US))))
:cljs string/upper-case))
(defn quote-identifier [x & {:keys [style split] :or {split true}}]
(let [name-transform-fn (cond
*name-transform-fn* *name-transform-fn*
*allow-dashed-names?* identity
:else undasherize)
qf (if style
(quote-fns style)
*quote-identifier-fn*)
s (cond
(or (keyword? x) (symbol? x))
(name-transform-fn
(cond *namespace-as-table?*
(str (when-let [n (namespace x)]
(str n "."))
(name x))
*allow-namespaced-names?*
(str (when-let [n (namespace x)]
(str n "/"))
(name x))
:else
(name x)))
(string? x) (if qf x (name-transform-fn x))
:else (str x))]
(if-not qf
s
(let [qf* #(if (= "*" %) % (qf %))]
(if-not split
(qf* s)
(let [parts (string/split s #"\.")]
(string/join "." (map qf* parts))))))))
(def infix-fns
#{"+" "-" "*" "/" "%" "mod" "|" "&" "^"
"and" "or" "xor"
"in" "not in" "like" "not like" "regexp"})
(def fn-aliases
{"is" "="
"is-not" "<>"
"not=" "<>"
"!=" "<>"
"not-in" "not in"
"not-like" "not like"
"regex" "regexp"})
(defprotocol ToSql
(to-sql [x]))
(defn to-sql-value [x]
(binding [*value-context?* (sequential? x)]
(to-sql x)))
(defmulti fn-handler (fn [op & args] op))
(defn expand-binary-ops [op & args]
(str "("
(string/join " AND "
(for [[a b] (partition 2 1 args)]
(fn-handler op a b)))
")"))
(defmethod fn-handler :default [op & args]
(let [args (map to-sql args)]
(if (infix-fns op)
(paren-wrap (string/join (str " " op " ") args))
(str op (paren-wrap (comma-join args))))))
(defmethod fn-handler "count-distinct" [_ & args]
(str "COUNT(DISTINCT " (comma-join (map to-sql args)) ")"))
(defmethod fn-handler "distinct-on" [_ & args]
(str "DISTINCT ON (" (comma-join (map to-sql args)) ")"))
(defmethod fn-handler "cast" [_ field cast-to-type]
(str "CAST" (paren-wrap (str (to-sql field)
" AS "
(to-sql cast-to-type)))))
(defmethod fn-handler "=" [_ a b & more]
(if (seq more)
(apply expand-binary-ops "=" a b more)
(cond
(nil? a) (str (to-sql-value b) " IS NULL")
(nil? b) (str (to-sql-value a) " IS NULL")
:else (str (to-sql-value a) " = " (to-sql-value b)))))
(defmethod fn-handler "<>" [_ a b & more]
(if (seq more)
(apply expand-binary-ops "<>" a b more)
(cond
(nil? a) (str (to-sql-value b) " IS NOT NULL")
(nil? b) (str (to-sql-value a) " IS NOT NULL")
:else (str (to-sql-value a) " <> " (to-sql-value b)))))
(defmethod fn-handler "<" [_ a b & more]
(if (seq more)
(apply expand-binary-ops "<" a b more)
(str (to-sql-value a) " < " (to-sql-value b))))
(defmethod fn-handler "<=" [_ a b & more]
(if (seq more)
(apply expand-binary-ops "<=" a b more)
(str (to-sql-value a) " <= " (to-sql-value b))))
(defmethod fn-handler ">" [_ a b & more]
(if (seq more)
(apply expand-binary-ops ">" a b more)
(str (to-sql-value a) " > " (to-sql-value b))))
(defmethod fn-handler ">=" [_ a b & more]
(if (seq more)
(apply expand-binary-ops ">=" a b more)
(str (to-sql-value a) " >= " (to-sql-value b))))
(defmethod fn-handler "between" [_ field lower upper]
(str (to-sql-value field) " BETWEEN " (to-sql-value lower) " AND " (to-sql-value upper)))
;; Handles MySql's MATCH (field) AGAINST (pattern). The third argument
;; can be a set containing one or more of :boolean, :natural, or :expand.
(defmethod fn-handler "match" [_ fields pattern & [opts]]
(str "MATCH ("
(comma-join
(map to-sql (if (coll? fields) fields [fields])))
") AGAINST ("
(to-sql-value pattern)
(when (seq opts)
(str " " (space-join (for [opt opts]
(case opt
:boolean "IN BOOLEAN MODE"
:natural "IN NATURAL LANGUAGE MODE"
:expand "WITH QUERY EXPANSION")))))
")"))
(def default-clause-priorities
"Determines the order that clauses will be placed within generated SQL"
{:with 20
:with-recursive 30
:intersect 35
:union 40
:union-all 45
:except 47
:select 50
:insert-into 60
:update 70
:delete 75
:delete-from 80
:truncate 85
:columns 90
:composite 95
:set0 100 ; low-priority set clause
:from 110
:join 120
:left-join 130
:right-join 140
:full-join 150
:cross-join 152
:set 155
:set1 156 ; high-priority set clause (synonym for :set)
:where 160
:group-by 170
:having 180
:order-by 190
:limit 200
:offset 210
:lock 215
:values 220
:query-values 230})
(def clause-store (atom default-clause-priorities))
(defn register-clause! [clause-key priority]
(swap! clause-store assoc clause-key priority))
(defn sort-clauses [clauses]
(let [m @clause-store]
(sort-by
(fn [c]
(m c #?(:clj Long/MAX_VALUE :cljs js/Number.MAX_VALUE)))
clauses)))
(defn format
"Takes a SQL map and optional input parameters and returns a vector
of a SQL string and parameters, as expected by `next.jbc` and
`clojure.java.jdbc`.
Input parameters will be filled into designated spots according to
name (if a map is provided) or by position (if a sequence is provided).
Instead of passing parameters, you can use keyword arguments:
:params - input parameters
:quoting - quote style to use for identifiers; one of :ansi (PostgreSQL),
:mysql, :sqlserver, or :oracle. Defaults to no quoting.
:parameterizer - style of parameter naming, :postgresql,
:jdbc or :none. Defaults to :jdbc.
:return-param-names - when true, returns a vector of
[sql-str param-values param-names]"
[sql-map & params-or-opts]
(let [opts (when (keyword? (first params-or-opts))
(apply hash-map params-or-opts))
params (if (coll? (first params-or-opts))
(first params-or-opts)
(:params opts))]
(binding [*params* (atom [])
*param-counter* (atom 0)
*all-param-counter* (atom 0)
*param-names* (atom [])
*input-params* (atom params)
*quote-identifier-fn* (quote-fns (:quoting opts))
*parameterizer* (or (:parameterizer opts) :jdbc)
*allow-dashed-names?* (:allow-dashed-names? opts)
*allow-namespaced-names?* (:allow-namespaced-names? opts)
*namespace-as-table?* (:namespace-as-table? opts)]
(let [sql-str (to-sql sql-map)]
(if (and (seq @*params*) (not= :none (:parameterizer opts)))
(if (:return-param-names opts)
[sql-str @*params* @*param-names*]
(into [sql-str] @*params*))
[sql-str])))))
(defprotocol Parameterizable
(to-params [value pname]))
(defn to-params-seq [s pname]
(paren-wrap (comma-join (mapv #(to-params % pname) s))))
(defn to-params-default [value pname]
(swap! *params* conj value)
(swap! *param-names* conj pname)
(parameterize *parameterizer* value pname))
(extend-protocol Parameterizable
#?@(:clj
[clojure.lang.Sequential
(to-params [value pname]
(to-params-seq value pname))])
#?(:clj clojure.lang.IPersistentSet
:cljs cljs.core/PersistentHashSet)
(to-params [value pname]
(to-params (seq value) pname))
nil
(to-params [value pname]
(swap! *params* conj value)
(swap! *param-names* conj pname)
(parameterize *parameterizer* value pname))
#?(:clj Object :cljs default)
(to-params [value pname]
#?(:clj
(to-params-default value pname)
:cljs
(if (sequential? value)
(to-params-seq value pname)
(to-params-default value pname)))))
(defn add-param [pname pval]
(to-params pval pname))
;; Anonymous param name -- :_1, :_2, etc.
(defn add-anon-param [pval]
(add-param
(keyword (str "_" (swap! *param-counter* inc)))
pval))
(defrecord Value [v]
ToSql
(to-sql [_]
(add-anon-param v)))
(defn value [x] (Value. x))
(declare -format-clause)
(defn map->sql [m]
(let [clause-ops (sort-clauses (keys m))
sql-str (binding [*subquery?* true
*fn-context?* false]
(space-join
(map (comp #(-format-clause % m) #(find m %))
clause-ops)))]
(if *subquery?*
(paren-wrap sql-str)
sql-str)))
(declare format-predicate*)
(defn seq->sql [x]
(cond
*value-context?*
;; sequences are operators/functions
(format-predicate* x)
*fn-context?*
;; list argument in fn call
(paren-wrap (comma-join (map to-sql x)))
:else
;; alias
(do
(assert (= 2 (count x)) (str "Alias should have two parts" x))
(let [[target alias] x]
(str (to-sql target)
; Omit AS in FROM, JOIN, etc. - Oracle doesn't allow it
(if (= :select *clause*) " AS " " ")
(if (or (string? alias) (keyword? alias) (symbol? alias))
(quote-identifier alias :split false)
(binding [*subquery?* false]
(to-sql alias))))))))
(extend-protocol types/Inlinable
#?(:clj clojure.lang.Keyword
:cljs cljs.core/Keyword)
(inline-str [x]
(name x))
nil
(inline-str [_]
"NULL")
#?(:clj Object :cljs default)
(inline-str [x]
(str x)))
(extend-protocol ToSql
#?(:clj clojure.lang.Keyword
:cljs cljs.core/Keyword)
(to-sql [x]
(let [s (name x)]
(case (.charAt s 0)
\% (let [call-args (string/split (subs s 1) #"\." 2)]
(to-sql (apply call (map keyword call-args))))
\? (to-sql (param (keyword (subs s 1))))
(quote-identifier x))))
#?(:clj clojure.lang.Symbol
:cljs cljs.core/Symbol)
(to-sql [x] (quote-identifier x))
#?(:clj java.lang.Boolean :cljs boolean)
(to-sql [x]
(if x "TRUE" "FALSE"))
#?@(:clj
[clojure.lang.Sequential
(to-sql [x] (seq->sql x))])
SqlCall
(to-sql [x]
(binding [*fn-context?* true]
(let [fn-name (name (.-name x))
fn-name (fn-aliases fn-name fn-name)]
(apply fn-handler fn-name (.-args x)))))
SqlRaw
(to-sql [x]
(let [s (.-s x)]
(if (vector? s)
(string/join "" (map (fn [x] (if (string? x) x (to-sql x))) s))
s)))
#?(:clj clojure.lang.IPersistentMap
:cljs cljs.core/PersistentArrayMap)
(to-sql [x]
(map->sql x))
#?(:clj clojure.lang.IPersistentSet
:cljs cljs.core/PersistentHashSet)
(to-sql [x]
(to-sql (seq x)))
nil
(to-sql [x] "NULL")
SqlParam
(to-sql [x]
(let [pname (param-name x)]
(if (map? @*input-params*)
(add-param pname (get @*input-params* pname))
(let [x (first @*input-params*)]
(swap! *input-params* rest)
(add-param pname x)))))
SqlArray
(to-sql [x]
(str "ARRAY[" (comma-join (map to-sql (.-values x))) "]"))
SqlInline
(to-sql [x]
(inline-str (.-value x)))
#?(:clj Object :cljs default)
(to-sql [x]
#?(:clj (add-anon-param x)
:cljs (if (sequential? x)
(seq->sql x)
(add-anon-param x))))
#?@(:cljs
[cljs.core/PersistentHashMap
(to-sql [x] (map->sql x))]))
(defn sqlable? [x]
(satisfies? ToSql x))
;;;;
(defn format-predicate* [pred]
(if-not (sequential? pred)
(to-sql pred)
(let [[op & args] pred
op-name (name op)]
(case op-name
"not" (str "NOT " (format-predicate* (first args)))
("and" "or" "xor")
(->> args
(remove nil?)
(map format-predicate*)
(string/join (str " " (upper-case op-name) " "))
(paren-wrap))
"exists"
(str "EXISTS " (to-sql (first args)))
(to-sql (apply call pred))))))
(defn format-predicate
"Formats a predicate (e.g., for WHERE, JOIN, or HAVING) as a string."
[pred & {:keys [quoting parameterizer]
:or {parameterizer :jdbc}}]
(binding [*params* (atom [])
*param-counter* (atom 0)
*param-names* (atom [])
*quote-identifier-fn* (or (quote-fns quoting)
*quote-identifier-fn*)
*parameterizer* parameterizer]
(let [sql-str (format-predicate* pred)]
(if (seq @*params*)
(into [sql-str] @*params*)
[sql-str]))))
(defmulti format-clause
"Takes a map entry representing a clause and returns an SQL string"
(fn [clause _] (key clause)))
(defn- -format-clause
[clause _]
(binding [*clause* (key clause)]
(format-clause clause _)))
(defmethod format-clause :default [& _]
"")
(defmethod format-clause :exists [[_ table-expr] _]
(str "EXISTS " (to-sql table-expr)))
(defmulti format-modifiers (fn [[op & _]] op))
(defmethod format-modifiers :distinct [_] "DISTINCT")
(defmethod format-modifiers :default [coll]
(space-join (map (comp upper-case name) coll)))
(defmethod format-clause :select [[_ fields] sql-map]
(str "SELECT "
(when (:modifiers sql-map)
(str (format-modifiers (:modifiers sql-map)) " "))
(comma-join (map to-sql fields))))
(defmethod format-clause :from [[_ tables] _]
(str "FROM " (comma-join (map to-sql tables))))
(defmethod format-clause :where [[_ pred] _]
(str "WHERE " (format-predicate* pred)))
(defn format-join [type table pred]
(str (when type
(str (upper-case (name type)) " "))
"JOIN " (to-sql table)
(when (some? pred)
(if (and (sequential? pred) (= :using (first pred)))
(str " USING (" (->> pred rest (map quote-identifier) comma-join) ")")
(str " ON " (format-predicate* pred))))))
(defmethod format-clause :join [[_ join-groups] _]
(space-join (map #(apply format-join :inner %)
(partition 2 join-groups))))
(defmethod format-clause :left-join [[_ join-groups] _]
(space-join (map #(apply format-join :left %)
(partition 2 join-groups))))
(defmethod format-clause :right-join [[_ join-groups] _]
(space-join (map #(apply format-join :right %)
(partition 2 join-groups))))
(defmethod format-clause :full-join [[_ join-groups] _]
(space-join (map #(apply format-join :full %)
(partition 2 join-groups))))
(defmethod format-clause :cross-join [[_ join-groups] _]
(space-join (map #(format-join :cross % nil) join-groups)))
(defmethod format-clause :group-by [[_ fields] _]
(str "GROUP BY " (comma-join (map to-sql fields))))
(defmethod format-clause :having [[_ pred] _]
(str "HAVING " (format-predicate* pred)))
(defmethod format-clause :order-by [[_ fields] _]
(str "ORDER BY "
(comma-join (for [field fields]
(if (sequential? field)
(let [[field & modifiers] field]
(string/join " "
(cons (to-sql field)
(for [modifier modifiers]
(case modifier
:desc "DESC"
:asc "ASC"
:nulls-first "NULLS FIRST"
:nulls-last "NULLS LAST"
"")))))
(to-sql field))))))
(defmethod format-clause :limit [[_ limit] _]
(str "LIMIT " (to-sql limit)))
(defmethod format-clause :offset [[_ offset] _]
(str "OFFSET " (to-sql offset)))
(defmulti format-lock-clause identity)
(defmethod format-lock-clause :update [_]
"FOR UPDATE")
(defmethod format-lock-clause :mysql-share [_]
"LOCK IN SHARE MODE")
(defmethod format-lock-clause :postgresql-share [_]
"FOR SHARE")
(defmethod format-clause :lock [[_ lock] _]
(let [{:keys [mode wait]} lock
clause (format-lock-clause mode)]
(str clause (when (false? wait) " NOWAIT"))))
(defmethod format-clause :insert-into [[_ table] _]
(if (and (sequential? table) (sequential? (first table)))
(str "INSERT INTO "
(to-sql (ffirst table))
(binding [*namespace-as-table?* false]
(str " (" (comma-join (map to-sql (second (first table)))) ") "))
(binding [*subquery?* false]
(to-sql (second table))))
(str "INSERT INTO " (to-sql table))))
(defmethod format-clause :columns [[_ fields] _]
(binding [*namespace-as-table?* false]
(str "(" (comma-join (map to-sql fields)) ")")))
(defmethod format-clause :composite [[_ fields] _]
(comma-join (map to-sql fields)))
(defmethod format-clause :values [[_ values] _]
(if (sequential? (first values))
(str "VALUES " (comma-join (for [x values]
(str "(" (comma-join (map to-sql x)) ")"))))
(let [cols (keys (first values))]
(str
(binding [*namespace-as-table?* false]
(str "(" (comma-join (map to-sql cols)) ")"))
" VALUES "
(comma-join (for [x values]
(str "(" (comma-join (map #(to-sql (get x %)) cols)) ")")))))))
(defmethod format-clause :query-values [[_ query-values] _]
(to-sql query-values))
(defmethod format-clause :update [[_ table] _]
(str "UPDATE " (to-sql table)))
(defmethod format-clause :set [[_ values] _]
(str "SET " (comma-join (for [[k v] values]
(str (to-sql k) " = " (to-sql v))))))
(defmethod format-clause :set0 [[_ values] _]
(str "SET " (comma-join (for [[k v] values]
(str (to-sql k) " = " (to-sql v))))))
(defmethod format-clause :set1 [[_ values] _]
(str "SET " (comma-join (for [[k v] values]
(str (to-sql k) " = " (to-sql v))))))
(defmethod format-clause :delete-from [[_ table] _]
(str "DELETE FROM " (to-sql table)))
(defmethod format-clause :delete [[_ tables] _]
(str "DELETE " (comma-join (map to-sql tables))))
(defmethod format-clause :truncate [[_ table] _]
(str "TRUNCATE " (to-sql table)))
(defn cte->sql
[[cte-name query]]
(str (binding [*subquery?* false]
(to-sql cte-name))
" AS "
(to-sql query)))
(defmethod format-clause :with [[_ ctes] _]
(str "WITH " (comma-join (map cte->sql ctes))))
(defmethod format-clause :with-recursive [[_ ctes] _]
(str "WITH RECURSIVE " (comma-join (map cte->sql ctes))))
(defmethod format-clause :union [[_ maps] _]
(binding [*subquery?* false]
(string/join " UNION " (map to-sql maps))))
(defmethod format-clause :union-all [[_ maps] _]
(binding [*subquery?* false]
(string/join " UNION ALL " (map to-sql maps))))
(defmethod format-clause :intersect [[_ maps] _]
(binding [*subquery?* false]
(string/join " INTERSECT " (map to-sql maps))))
(defmethod format-clause :except [[_ maps] _]
(binding [*subquery?* false]
(string/join " EXCEPT " (map to-sql maps))))
(defmethod fn-handler "case" [_ & clauses]
(str "CASE "
(space-join
(for [[condition result] (partition 2 clauses)]
(if (= :else condition)
(str "ELSE " (to-sql result))
(let [pred (format-predicate* condition)]
(str "WHEN " pred " THEN " (to-sql result))))))
" END"))
(defn regularize [sql-string]
(string/replace sql-string #"\s+" " "))