summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCarlo Zancanaro <carlo@clearboxsystems.com.au>2013-06-20 15:49:55 +1000
committerCarlo Zancanaro <carlo@clearboxsystems.com.au>2013-06-20 15:49:55 +1000
commit54c6a5dec031de59dad385d4ba2ccda09a70ec2a (patch)
tree5d428dc6ee23d7bbe4c5f846d6e22474e1a1cefe
parent3ce695f6b2daf943490b2b4a9dac7be01bdd6356 (diff)
Fix compiling of n-ary operators (0 & 1 args), add operator aliases
n-ary operators with no arguments would break everything (compiling to "()"). This should no longer be the case. Additionally, unary operators (ie. negation) now compile properly in the one arg case. Operator aliases allow us to change how we refer to things like the "~" regex operator in postgresql. At the moment it's aliased as "$". Additionally: booleans now compile to upper case.
-rw-r--r--src/clojure_sql/compiler.clj45
-rw-r--r--src/clojure_sql/core.clj4
-rw-r--r--src/clojure_sql/writer.clj2
3 files changed, 39 insertions, 12 deletions
diff --git a/src/clojure_sql/compiler.clj b/src/clojure_sql/compiler.clj
index 9ba0c3a..c7f907f 100644
--- a/src/clojure_sql/compiler.clj
+++ b/src/clojure_sql/compiler.clj
@@ -5,6 +5,12 @@
[clojure-sql.util :as u :refer [named?]]
[clojure-sql.writer :as w :refer [return lift p-lift sequence do-m tell >>]]))
+(defn no-args-operator-error [op]
+ (throw (ex-info (str "Argument called with no args doesn't have identity value: " op)
+ {:operator op})))
+
+
+
(defn add-parentheses [s]
(str \( s \)))
@@ -39,10 +45,18 @@
;; Utility functions for the compile-* functions
;; ==============================================================
+(def ^:private boolean? (some-fn true? false?))
+(def ^:private regex? (partial instance? (class #"")))
+(def ^:private operator-name (some-fn (comp {"$" "~"} name) name))
+
(def quote? (comp boolean '#{"quote"} name))
-(def unary? (comp boolean '#{"not" "exists"} name))
-(def binary? (comp boolean '#{"=" "<" ">" "<=" ">=" "is" "in"} name))
-(def operator? (comp boolean '#{"and" "or" "+" "-" "/" "*"} name))
+(def unary? (comp boolean '#{"not" "exists" "-"} name))
+(def binary? (comp boolean '#{"=" "<" ">" "<=" ">=" "is" "in" "like" "~"} name))
+(def n-ary? (comp boolean '#{"and" "or" "+" "-" "/" "*"} name))
+(def operator-identity (comp {"and" true
+ "or" false
+ "+" 0
+ "*" 1} name))
;; ==============================================================
@@ -64,24 +78,31 @@
(defmulti compile-expression-sequential (fn [db _] db))
(defmethod compile-expression-sequential :default [db ex]
(let [compile-exprs #(map (partial compile-expression db) %)
- op (name (first ex))
+ op-name (operator-name (first ex))
num-args (dec (count ex))]
- (-> (condp u/funcall (first ex)
+ (-> (condp u/funcall op-name
quote? (do (assert (= num-args 1) "`quote` must only take one argument")
(if (sequential? (second ex))
(compile-expression-list db (second ex))
(>> (tell (second ex)) (return "?"))))
- unary? (do (assert (= num-args 1) (str "Unary operator `" op "` must take one argument"))
+ n-ary? (do-m :let [[op & exprs] (compile-exprs ex)]
+ vals <- (apply sequence (interpose op exprs))
+ (condp = (count vals)
+ 0 (if-let [id (operator-identity op-name)]
+ (compile-expression db id)
+ (no-args-operator-error (name (first ex))))
+ 1 (if (unary? op-name)
+ (do-m compiled-op <- op
+ (return (str compiled-op (first vals)))))
+ (return (string/join " " vals))))
+ unary? (do (assert (= num-args 1) (str "Unary operator `" (first ex) "` must take one argument"))
(do-m :let [exprs (compile-exprs ex)]
vals <- (apply sequence exprs)
(return (string/join "" vals))))
- binary? (do (assert (= num-args 2) (str "Binary operator `" op "` must take two arguments"))
+ binary? (do (assert (= num-args 2) (str "Binary operator `" (first ex) "` must take two arguments"))
(do-m :let [[op left right] (compile-exprs ex)]
vals <- (sequence left op right)
(return (string/join " " vals))))
- operator? (do-m :let [[op & exprs] (compile-exprs ex)]
- vals <- (apply sequence (interpose op exprs))
- (return (string/join " " vals)))
(do-m :let [fn-name (function-name db (first ex))
exprs (compile-exprs (rest ex))]
vals <- (apply sequence exprs)
@@ -92,12 +113,14 @@
(defmulti compile-expression (fn [db _] db))
(defmethod compile-expression :default [db ex]
(condp u/funcall ex
+ boolean? (return (string/upper-case (str ex)))
query? ($add-parentheses (compile-query db ex))
nil? (return "NULL")
vector? (return (str (table-name db (first ex)) \. (field-name db (second ex))))
keyword? (return (field-name db ex))
+ regex? (>> (tell (str ex)) (return "?"))
string? (>> (tell ex) (return "?")) ;;(sql-string db ex)
- symbol? (return (string/upper-case (name ex)))
+ symbol? (return (string/upper-case (operator-name ex)))
sequential? (compile-expression-sequential db ex)
(return ex)))
diff --git a/src/clojure_sql/core.clj b/src/clojure_sql/core.clj
index 72438a6..bd4b431 100644
--- a/src/clojure_sql/core.clj
+++ b/src/clojure_sql/core.clj
@@ -26,3 +26,7 @@
(def group #'d/group)
(def having #'d/having)
(def sort #'d/sort)
+
+
+(-> (table :x)
+ (select `($ (- :a) #"bloo")))
diff --git a/src/clojure_sql/writer.clj b/src/clojure_sql/writer.clj
index 5f4250b..176cc67 100644
--- a/src/clojure_sql/writer.clj
+++ b/src/clojure_sql/writer.clj
@@ -53,7 +53,7 @@
(if (= (first args) :let)
`(let ~(second args)
~(apply do-m* (nnext args))))
- (if (= (name (second args)) "<-")
+ (if (every? #(% (second args)) [symbol? #(= (name %) "<-")])
(let [[var <- val & others] args]
`(bind ~val
(fn [~var]