summaryrefslogtreecommitdiff
path: root/src/clojure_sql/compiler.clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/clojure_sql/compiler.clj')
-rw-r--r--src/clojure_sql/compiler.clj216
1 files changed, 127 insertions, 89 deletions
diff --git a/src/clojure_sql/compiler.clj b/src/clojure_sql/compiler.clj
index ca8d2d9..7ded112 100644
--- a/src/clojure_sql/compiler.clj
+++ b/src/clojure_sql/compiler.clj
@@ -1,7 +1,9 @@
(ns clojure-sql.compiler
- (:require [clojure.string :as string]))
-
-
+ (:refer-clojure :exclude [compile sequence])
+ (:require [clojure.string :as string]
+ [clojure-sql.query :refer [query?]]
+ [clojure-sql.util :as u]
+ [clojure-sql.writer :as w :refer [return lift p-lift sequence do-m tell >>]]))
(defn add-parentheses [s]
(str \( s \)))
@@ -26,121 +28,129 @@
+;; we use the $ prefix to denote a lifted function
+(def $add-parentheses (lift add-parentheses))
+(def $str (lift str))
+
+
+
;; ==============================================================
;; Utility functions for the compile-* functions
;; ==============================================================
-;; compile-* multimethods are of the signature:
-;; (db, expr) -> [SQL & replacements]
-
-(def is-unary? (comp boolean '#{"not"} name))
-(def is-binary? (comp boolean '#{"=" "<" ">" "<=" ">=" "is" "in" "+" "-" "/" "*"} name))
-(def is-operator? (comp boolean '#{"and" "or"} name))
-(defn c-return [val] [val])
-(defn c-lift [f & orig-args]
- (fn [& c-args]
- (apply vector
- (apply f (concat orig-args
- (map first c-args)))
- (apply concat (map rest c-args)))))
-(def c-str (c-lift str))
-(def c-join (fn [sep args]
- (apply vector
- (string/join sep (map first args))
- (apply concat (map rest args)))))
-(def c-add-parentheses (c-lift add-parentheses))
+(def ^:private named? (some-fn string? symbol? keyword?))
+(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))
;; ==============================================================
;; compile-* functions (turning a map into a query string)
;; ==============================================================
+;; compile-* multimethods are of the signature:
+;; (db, expr) -> (fn [s] [sql])
+
+(declare compile-query compile-expression)
+
+(defmulti compile-expression-sequential (fn [db ex]))
+(defmethod compile-expression-sequential :default [db ex]
+ (let [compile-exprs #(map (partial compile-expression db) %)
+ op (name (first ex))
+ num-args (dec (count ex))]
+ (-> (condp u/funcall (first ex)
+ quote? (do (assert (= num-args 1) "`quote` must only take one argument")
+ (>> (tell (second ex)) (return "?")))
+ unary? (do (assert (= num-args 1) (str "Unary operator `" op "` 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"))
+ (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)
+ (return (str fn-name
+ (add-parentheses (string/join "," vals))))))
+ $add-parentheses)))
+
(defmulti compile-expression (fn [db _] db))
(defmethod compile-expression :default [db ex]
- (condp #(%1 %2) ex
- nil? (c-return "NULL")
- vector? (c-return (str (table-name db (first ex)) \. (field-name db (second ex))))
- keyword? (c-return (field-name db ex))
- string? ["?" ex] ;;(sql-string db ex)
- symbol? (c-return (string/upper-case (name ex)))
- sequential? (-> (condp #(%1 %2) (first ex)
- is-unary? (if (= (count ex) 2)
- (->> ex
- (map (partial compile-expression db))
- (c-join " "))
- (throw (ex-info "Unary operators can only take one argument."
- {:operator (first ex)
- :arguments (rest ex)})))
- is-binary? (if (= (count ex) 3)
- (->> (rest ex)
- (map (partial compile-expression db))
- (interpose (compile-expression db (first ex)))
- (c-join " "))
- (throw (ex-info "Binary operators must take two arguments."
- {:operator (first ex)
- :arguments (rest ex)})))
- is-operator? (->> (rest ex)
- (map (partial compile-expression db))
- (interpose (compile-expression db (first ex)))
- (c-join " "))
- (->> (rest ex)
- (map (partial compile-expression db))
- (c-join ", ")
- c-add-parentheses
- (c-str (c-return (function-name db (first ex))))))
- c-add-parentheses)
- (c-return ex)))
+ (condp u/funcall 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))
+ string? (>> (tell ex) (return "?")) ;;(sql-string db ex)
+ symbol? (return (string/upper-case (name ex)))
+ sequential? (compile-expression-sequential db ex)
+ (return ex)))
(defn ^:private make-table-name [db table & [alias]]
(if (or (= table alias) (nil? alias))
- (table-name db table)
- (str (table-name db table) " AS " (field-name db alias))) )
-
-(defn ^:private make-field-name [db table field & [alias]]
- (if (or (= field alias) (nil? alias))
- (str (table-name db table) \. (field-name db field))
- (str (table-name db table) \. (field-name db field) " AS " (field-name db alias))))
+ (return (table-name db table))
+ ($str (condp #(%1 %2) table
+ query? ($add-parentheses (compile-query db table))
+ named? (return (table-name db table))
+ (compile-expression db table))
+ (return " AS ")
+ (return (table-name db alias)))))
+
+(defn ^:private make-field-name [db field & [alias]]
+ (if (and (vector? field) (or (= field alias) (nil? alias)))
+ (compile-expression db field)
+ ($str (compile-expression db field)
+ (return " AS ")
+ (return (field-name db alias)))))
(defmulti compile-fields (fn [db _] db))
(defmethod compile-fields :default [db fields-map]
(if (seq fields-map)
- (->> (for [[[table field] alias] fields-map]
- (make-field-name db table field alias))
- (string/join ", ")
- c-return)
- (c-return "*")))
+ (->> (for [[field alias] fields-map]
+ (make-field-name db field alias))
+ (apply sequence)
+ ((p-lift string/join ", ")))
+ (return "*")))
(defmulti compile-tables (fn [db _] db))
(defmethod compile-tables :default [db tables-map]
(->> (for [[table alias] tables-map]
(make-table-name db table alias))
- (string/join ", ")
- c-return))
+ (apply sequence)
+ ((p-lift string/join ", "))))
(defmulti compile-join (fn [db _] db))
(defmethod compile-join :default [db [type table-map on]]
- (c-str (c-return (case type
- :left " LEFT OUTER"
- :right " RIGHT OUTER"
- " INNER"))
- (c-return " JOIN ")
- (compile-tables db table-map)
- (c-return " ON ")
- (compile-expression db on)))
+ ($str (return (case type
+ :left " LEFT OUTER"
+ :right " RIGHT OUTER"
+ " INNER"))
+ (return " JOIN ")
+ (compile-tables db table-map)
+ (return " ON ")
+ (compile-expression db on)))
(defmulti compile-joins (fn [db _] db))
(defmethod compile-joins :default [db joins]
(->> joins
(map (partial compile-join db))
- (c-join "")))
+ (apply sequence)
+ ((p-lift string/join ""))))
(defmulti compile-where (fn [db _] db))
(defmethod compile-where :default [db expr]
(if expr
- (c-str (c-return " WHERE ") (compile-expression db expr))))
+ ($str (return " WHERE ") (compile-expression db expr))
+ (return nil)))
(defmulti compile-sort-by (fn [db _] db))
(defmethod compile-sort-by :default [db fields]
@@ -148,22 +158,29 @@
(->> (for [[[table field] dir] fields]
(str (make-field-name db table field) \space (string/upper-case (name dir))))
(string/join ",")
- (apply str " ORDER BY ")
- c-return)))
+ (apply $str (return " ORDER BY "))
+ return)
+ (return nil)))
(defmulti compile-query (fn [db _] db))
(defmethod compile-query :default [db {:keys [table fields joins where sort-by]}]
- (c-str (c-return "SELECT ")
- (compile-fields db fields)
- (if table
- (c-return " FROM "))
- (compile-tables db table)
- (compile-joins db joins)
- (compile-where db where)
- (compile-sort-by db sort-by)))
+ ($str (return "SELECT ")
+ (compile-fields db fields)
+ (if table
+ (return " FROM "))
+ (compile-tables db table)
+ (compile-joins db joins)
+ (compile-where db where)
+ (compile-sort-by db sort-by)))
+
+(defn compile [db query]
+ (let [[sql vars] ((compile-query db query) [])]
+ (vec (cons sql vars))))
+
+
;; ==============================================================
;; A few DB specific overrides
;; ==============================================================
@@ -184,4 +201,25 @@
(str \` (name table) \`))
+;;(compile nil {:table {:u :u}, :fields {[:v :x] :w}})
+
+
+
+
+;; Utility functions
+
+(defn insert! [db query & records]
+ {:pre [(empty? (:joins query))]}
+ ;; some code here
+ ($str (return "Carlo"))
+ )
+
+(defn update! [db query & partial-records]
+ {:pre [(empty? (:joins query))]}
+ ;; some code here
+ )
+(defn delete! [db query]
+ {:pre [(empty? (:joins query))]}
+ ;; some code here
+ )
generated by cgit v1.2.3 (git 2.46.2) at 2024-11-10 07:53:43 +0000