path: root/src/clojure_sql/compiler.clj

(ns clojure-sql.compiler
  (: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 \)))


;; ==============================================================
;; DB specific escaping methods
;; ==============================================================

(defmulti field-name (fn [db _] db))
(defmethod field-name :default [_ field]
  (str \" (name field) \"))

(defmulti table-name (fn [db _] db))
(defmethod table-name :default [_ table]
  (str \" (name table) \"))

(defmulti function-name (fn [db _] db))
(defmethod function-name :default [_ function]
  (str \" (name function) \"))




;; 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
;; ==============================================================


(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 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))
    (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 [[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))
       (apply sequence)
       ((p-lift string/join ", "))))

(defmulti compile-join (fn [db _] db))
(defmethod compile-join :default [db [type table-map 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))
       (apply sequence)
       ((p-lift string/join ""))))

(defmulti compile-where (fn [db _] db))
(defmethod compile-where :default [db expr]
  (if expr
    ($str (return " WHERE ") (compile-expression db expr))
    (return nil)))

(defmulti compile-sort-by (fn [db _] db))
(defmethod compile-sort-by :default [db fields]
  (if fields
    (->> (for [[[table field] dir] fields]
           (str (make-field-name db table field) \space (string/upper-case (name dir))))
         (string/join ",")
         (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]}]
  ($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
;; ==============================================================


;; SQL SERVER
(defmethod field-name :sql-server [_ field]
  (str \[ (name field) \]))

(defmethod table-name :sql-server [_ table]
  (str \[ (name table) \]))

;; mySQL
(defmethod field-name :mysql [_ field]
  (str \` (name field) \`))

(defmethod table-name :mysql [_ table]
  (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
  )