luciano/honeysql
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Support registration of new infix operators and new function/syntax

Browse source
This commit is contained in:
Sean Corfield 2020-09-29 14:40:03 -07:00
parent b94f169af3
commit a789d4a4ff
1 changed files with 75 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

117
src/honey/sql.cljc
View file

@ -471,7 +471,11 @@
(into (map str "+-*/%|&^=<>")) (into (map str "+-*/%|&^=<>"))
(into (keys infix-aliases)) (into (keys infix-aliases))
(into (vals infix-aliases)) (into (vals infix-aliases))
(->> (into #{} (map keyword))))) (->> (into #{} (map keyword)))
(atom)))
(def ^:private op-ignore-nil (atom #{:and :or}))
(def ^:private op-variadic (atom #{:and :or :+ :* :||}))
(defn- sqlize-value [x] (defn- sqlize-value [x]
(cond (cond
@ -482,37 +486,38 @@
:else (str x))) :else (str x)))
(def ^:private special-syntax (def ^:private special-syntax
{:array (atom
(fn [k [arr]] {:array
(let [[sqls params] (format-expr-list arr)] (fn [_ [arr]]
(into [(str "ARRAY[" (str/join ", " sqls) "]")] params))) (let [[sqls params] (format-expr-list arr)]
:between (into [(str "ARRAY[" (str/join ", " sqls) "]")] params)))
(fn [k [x a b]] :between
(let [[sql-x & params-x] (format-expr x {:nested? true}) (fn [_ [x a b]]
[sql-a & params-a] (format-expr a {:nested? true}) (let [[sql-x & params-x] (format-expr x {:nested? true})
[sql-b & params-b] (format-expr b {:nested? true})] [sql-a & params-a] (format-expr a {:nested? true})
(-> [(str sql-x " BETWEEN " sql-a " AND " sql-b)] [sql-b & params-b] (format-expr b {:nested? true})]
(into params-x) (-> [(str sql-x " BETWEEN " sql-a " AND " sql-b)]
(into params-a) (into params-x)
(into params-b)))) (into params-a)
:cast (into params-b))))
(fn [k [x type]] :cast
(let [[sql & params] (format-expr x)] (fn [_ [x type]]
(into [(str "CAST(" sql " AS " (sql-kw type) ")")] params))) (let [[sql & params] (format-expr x)]
:default (into [(str "CAST(" sql " AS " (sql-kw type) ")")] params)))
(fn [k []] :default
["DEFAULT"]) (fn [_ []]
:inline ["DEFAULT"])
(fn [k [x]] :inline
[(sqlize-value x)]) (fn [_ [x]]
:interval [(sqlize-value x)])
(fn [k [n units]] :interval
(let [[sql & params] (format-expr n)] (fn [_ [n units]]
(into [(str "INTERVAL " sql " " (sql-kw units))] params))) (let [[sql & params] (format-expr n)]
:not (into [(str "INTERVAL " sql " " (sql-kw units))] params)))
(fn [k [x]] :not
(let [[sql & params] (format-expr x)] (fn [_ [x]]
(into [(str "NOT " sql)] params)))}) (let [[sql & params] (format-expr x)]
(into [(str "NOT " sql)] params)))}))
(defn format-expr [x & [{:keys [nested?] :as opts}]] (defn format-expr [x & [{:keys [nested?] :as opts}]]
(cond (or (keyword? x) (symbol? x)) (cond (or (keyword? x) (symbol? x))
@ -525,13 +530,11 @@
(let [op (first x) (let [op (first x)
;; normalize symbols to keywords here -- makes the subsequent ;; normalize symbols to keywords here -- makes the subsequent
;; logic easier since we use op to lookup things in hash maps: ;; logic easier since we use op to lookup things in hash maps:
op (if (symbol? op) (keyword (name op)) op) op (if (symbol? op) (keyword (name op)) op)]
op-ignore-nil #{:and :or}
op-variadic #{:and :or :+ :* :||}]
(if (keyword? op) (if (keyword? op)
(cond (infix-ops op) (cond (contains? @infix-ops op)
(if (op-variadic op) ; no aliases here, no special semantics (if (contains? @op-variadic op) ; no aliases here, no special semantics
(let [x (if (op-ignore-nil op) (remove nil? x) x) (let [x (if (contains? @op-ignore-nil op) (remove nil? x) x)
[sqls params] [sqls params]
(reduce (fn [[sql params] [sql' & params']] (reduce (fn [[sql params] [sql' & params']]
[(conj sql sql') [(conj sql sql')
@ -566,8 +569,8 @@
(vector) (vector)
(into p1) (into p1)
(into p2))))) (into p2)))))
(special-syntax op) (contains? @special-syntax op)
(let [formatter (special-syntax op)] (let [formatter (get @special-syntax op)]
(formatter op (rest x))) (formatter op (rest x)))
:else :else
(let [args (rest x) (let [args (rest x)
@ -641,12 +644,13 @@
New clauses are registered in the base order and the current order so New clauses are registered in the base order and the current order so
that any dialect selections are able to include them while still working that any dialect selections are able to include them while still working
predictably from the base order. Caveat: that means if you are a new predictably from the base order. Caveat: that means if you register a new
clause `before` a clause that is ordered differently in different clause `before` a clause that is ordered differently in different
dialects, your new clause may also end up in a different place. The dialects, your new clause may also end up in a different place. The
only clause so far where that would matter is `:set` which differs in only clause so far where that would matter is `:set` which differs in
MySQL..." MySQL."
[clause formatter before] [clause formatter before]
(assert (keyword? clause))
(let [f (if (keyword? formatter) (let [f (if (keyword? formatter)
(get @clause-format formatter) (get @clause-format formatter)
formatter)] formatter)]
@ -657,6 +661,35 @@
(swap! current-clause-order add-clause-before clause before) (swap! current-clause-order add-clause-before clause before)
(swap! clause-format assoc clause f))) (swap! clause-format assoc clause f)))
(defn register-fn!
"Register a new function (as special syntax). The `formatter` is either
a keyword, meaning that this new function should use the same syntax as
an existing function, or a function of two arguments that generates a
SQL string and parameters (as a vector). The two arguments are the name
of the function (as a keyword) and a sequence of the arguments from the
DSL."
[function formatter]
(assert (keyword? function))
(let [f (if (keyword? formatter)
(get @special-syntax formatter)
formatter)]
(when-not (and f (fn? f))
(throw (ex-info "The formatter must be a function or existing fn name"
{:type (type formatter)})))
(swap! special-syntax assoc function f)))
(defn register-op!
"Register a new infix operator. Operators can be defined to be variadic (the
default is that they are binary) and may choose to ignore `nil` arguments
(this can make it easier to programmatically construct the DSL)."
[op & {:keys [variadic? ignore-nil?]}]
(assert (keyword? op))
(swap! infix-ops conj op)
(when variadic?
(swap! op-variadic conj op))
(when ignore-nil?
(swap! op-ignore-nil conj op)))
(comment (comment
(format {:truncate :foo}) (format {:truncate :foo})
(format-expr [:= :id 1]) (format-expr [:= :id 1])