Skip to content
This repository
tree: b20b75b3aa
Fetching contributors…

Cannot retrieve contributors at this time

file 178 lines (158 sloc) 6.025 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
(ns clojureql.predicates
  (:require [clojure.set :as set] )
  (:use clojureql.internal
        [clojure.string :only [join] :rename {join join-str}]))

(defn sanitize [expression]
  "Returns all values from an expression"
  (reduce #(if (coll? %2)
             (concat %1 %2)
             (concat %1 [%2])) [] (remove keyword? expression)))

(defn parameterize [expression]
  "Replace all values with questionmarks in an expression"
  (map #(if (keyword? %) (str (to-tablename %)) "?") expression))

(declare predicate)

(defprotocol Predicate
  (sql-or [this exprs] "Compiles to (expr OR expr)")
  (sql-and [this exprs] "Compiles to (expr AND expr)")
  (sql-not [this exprs] "Compiles to NOT(exprs)")
  (spec-op [this expr] "Compiles a special, ie. non infix operation")
  (infix [this op exprs] "Compiles an infix operation")
  (prefix [this op field exprs] "Compiles a prefix operation"))

(defrecord APredicate [stmt env cols]
  Object
  (toString [this] (apply str (flatten stmt)))
  Predicate
  (sql-or [this exprs]
    (if (empty? (-> exprs first :stmt))
      (assoc this
        :stmt (mapcat :stmt exprs)
        :cols (concat (or cols '()) (mapcat :cols exprs))
        :env (mapcat :env exprs))
      (assoc this
        :stmt (list stmt "(" (interpose " OR " (map :stmt exprs)) ")")
        :cols (concat (or cols '()) (mapcat :cols exprs))
        :env (concat env (mapcat :env exprs)))))
  (sql-and [this exprs]
    (if (empty? (-> exprs first :stmt))
      (assoc this
        :stmt (mapcat :stmt exprs)
        :cols (concat (or cols '()) (mapcat :cols exprs))
        :env (mapcat :env exprs))
      (assoc this
        :stmt (list stmt "(" (interpose " AND " (map :stmt exprs)) ")")
        :cols (concat (or cols '()) (mapcat :cols exprs))
        :env (concat env (mapcat :env exprs)))))
  (sql-not [this expr]
    (if (empty? (-> expr first :stmt))
      (assoc this
        :stmt (mapcat :stmt expr)
        :cols (concat (or cols '()) (mapcat :cols expr))
        :env (mapcat :env expr))
      (assoc this
        :stmt (list stmt "NOT(" (map :stmt expr) ")")
        :cols (concat (or cols '()) (mapcat :cols expr))
        :env (concat env (mapcat :env expr)))))
  (spec-op [this expr]
    (let [[op p1 p2] expr]
      (cond
       (every? nil? (rest expr))
       (assoc this
         :stmt (list stmt "(NULL " op " NULL)")
         :env env)
       (nil? p1)
       (.spec-op this [op p2 p1])
       (nil? p2)
       (assoc this
         :stmt (list stmt "(" (name p1) " " op " NULL)")
         :cols (concat (or cols []) (filter keyword? [p1 p2]))
         :env '())
       :else
       (infix this "=" (rest expr)))))
  (infix [this op expr]
    (assoc this
      :stmt (list stmt "(" (interpose (str \space (upper-name op) \space)
                                      (parameterize expr))
                  ")")
      :cols (filter keyword? expr)
      :env (concat env (sanitize expr))))
  (prefix [this op field expr]
    (assoc this
      :stmt (list stmt
                  (nskeyword field) \space
                  (upper-name op) \space
                  "(" (->> (if (coll? (first expr))
                             (first expr)
                             expr)
                           parameterize
                           (interpose ","))
                  ")")
      :cols (list field)
      :env (concat env (sanitize expr)))))

(defn predicate
  ([] (predicate [] []))
  ([stmt] (predicate stmt []))
  ([stmt env] (predicate stmt env nil))
  ([stmt env col]
              (APredicate. stmt env col)))

(defn fuse-predicates
  "Combines two predicates into one using AND"
  [p1 p2]
  (if (and (nil? (:env p1)) (nil? (:stmt p1)))
    p2
    (predicate (list (:stmt p1) " AND " (:stmt p2))
               (mapcat :env [p1 p2])
               (mapcat :cols [p1 p2]))))

(defn qualify-predicate
  [this pred]
  (let [tname (to-tablename (:tname this))
        {:keys [stmt env cols]} pred
        aggregates (set (map nskeyword (find-aggregates this)))
        colnames (set (remove #(.contains % ".")
                              (map nskeyword cols)))
        qualify? (set/difference colnames aggregates)]
    (predicate
     (map #(if (qualify? %) (str (to-tablealias (:tname this))
                                 \. %) %)
          (if (string? pred)
            [pred]
            (flatten stmt)))
     env
     cols)))

(defn or* [& args] (sql-or (predicate) args))
(defn and* [& args] (sql-and (predicate) args))
(defn not* [& args] (sql-not (predicate) args))

(defn =* [& args]
  (if (some #(nil? %) args)
    (spec-op (predicate) (into ["IS"] args))
    (infix (predicate) "=" args)))

(defn !=* [& args]
  (if (some #(nil? %) args)
    (spec-op (predicate) (into ["IS NOT"] args))
    (infix (predicate) "!=" args)))

(defn nil?* [field]
  (=* nil field))

(defmacro definfixoperator [name op doc]
  `(defn ~name ~doc [& args#]
     (infix (predicate) (name ~op) args#)))

(definfixoperator like :like "LIKE operator: (like :x \"%y%\"")
(definfixoperator >* :> "> operator: (> :x 5)")
(definfixoperator <* :< "< operator: (< :x 5)")
(definfixoperator <=* :<= "<= operator: (<= :x 5)")
(definfixoperator >=* :>= ">= operator: (>= :x 5)")

(defmacro defprefixoperator [name op doc]
  `(defn ~name ~doc [field# & args#]
     (prefix (predicate) (name ~op) field# args#)))

(defprefixoperator in :in
  "IN operator: (in :name \"Jack\" \"John\"). Accepts both
a vector of items or an arbitrary amount of values as seen
above.")

(defn restrict
  "Returns a query string.

Takes a raw string with params as %1 %2 %n.

(restrict 'id=%1 OR id < %2' 15 10) => 'id=15 OR id < 10'"
  [pred & args]
  (apply sql-clause pred args))

(defn restrict-not
  "The inverse of the restrict fn"
  ([ast] (into [(str "NOT(" ast ")")] (:env ast)))
  ([pred & args] (str "NOT(" (apply sql-clause pred args) ")")))
Something went wrong with that request. Please try again.