Clojure Query Comprehension Macro

query_comprehension.clj

(ns query-comprehension
  (:use clojure.contrib.prxml))

;;
;; Enhanced List Comprehensions supporting arbitary group-by, filtering and ordering.
;;
;; (from [ BINDING GENERATOR -- One or more Generator clauses
;;      :when PREDICATE  ]   -- Zero or more Guards
;;      :group-by [ EXPRESSION :into [KEY_NAME GROUP_NAME]]   -- Optional Group-By qualifier
;;      :having PREDICATE       -- Optional Group Guard
;;      :order-by EXPRESSION    -- Optional Ordering qualifier
;;      :select EXPRESSION)     -- Projection

(defmacro step [m k f coll]
    (if (contains? m k)
      `(~f ~coll)
      `(identity ~coll)))

(defn extract-row-spec
  [generators]
  (let [row-spec
        (vec (filter (fn [s] (and (not (keyword? s))
                                 (not (= (symbol '_) s))))
                     (map first (partition 2 generators) )))]
    (if (= 1 (count row-spec)) (first row-spec) row-spec)))

(defmacro assert-args [fnname & pairs]
  `(do (when-not ~(first pairs)
         (throw (IllegalArgumentException.
                  ~(str fnname " requires " (second pairs)))))
     ~(let [more (nnext pairs)]
        (when more
          (list* `assert-args fnname more)))))

(defmacro from
  "Executes each generator/guard in a sequence comprehension then each
post-comprehension qualifier step is applied in order. Each step has its first
argument transformed into a function of the row spec. The row spec is determined
from the named element of each generator."
  
  [generators & steps]

  (assert-args from
     (vector? generators) "a vector for its binding"
     (even? (count generators)) "an even number of forms in binding vector"
     (even? (count steps)) "an even number of steps")

  (let [m (into {} (map vec (partition 2 steps)))
        row-spec (extract-row-spec generators)
        group-expr (first (:group-by m))
        group-spec (last (:group-by m))
        final-spec (if group-spec group-spec row-spec)
        having-expr (:having m)
        order-by-expr (:order-by m)
        select-expr (:select m)
        ]
    `(->> (for ~generators ~row-spec)
          (step ~m :group-by (partial group-by (fn [~row-spec] ~group-expr)))
          (step ~m :having (partial filter (fn [~final-spec] ~having-expr)))
          (step ~m :order-by (partial sort-by (fn [~final-spec] ~order-by-expr)))
          (step ~m :select (partial map (fn [~final-spec] ~select-expr)))
          )))


(comment
  (def orders [
               { :customer_id 1 :date "01/02/10" :product "Toaster" :price 10 }
               { :customer_id 2 :date "02/02/10" :product "Cappuccino" :price 2}
               { :customer_id 3 :date "01/02/10" :product "Cappuccino" :price 2}
               { :customer_id 3 :date "01/02/10" :product "Plastic Penguin" :price 5}
               { :customer_id 3 :date "03/02/10" :product "Emacs Manual" :price 20}])

  (def customers [
                  { :customer_id 1 :company "Google" :name "Eric"}
                  { :customer_id 2 :company "Oracle" :name "Larry"}
                  { :customer_id 3 :company "Microsoft" :name "Bill"}
                  { :customer_id 4 :company "Apple" :name "Steve"}])

  (prxml
   [:Customers
    (from [o orders
           c customers
           :when (= (o :customer_id) (c :customer_id)) ]
          :group-by [(c :name) :into [name g]]
          :order-by name
          :select [ :Customer {:name name}
                   (from [[o c] g]
                         :group-by [(o :date) :into [date g2]]
                         :select [ :Total {:date date}
                                  (reduce + (from [[o c] g2]
                                                  :select (o :price) ))] )] )
    ])
)