An intermedient version of a new frontend for CQL

ast.clj

(ns ast
  (:use [clojure.core.match :only [match]] )
  (:require [clojureql.predicates :as pred]))

(comment These protocols are from a former iteration. They capture the intention pretty well
         and might be reintroduced, as soon the format is stable.
 (defprotocol SqlCompilable
   (render [this] "Sequence of strings that represent the prepared statement")
   (param-count [this] "Number of positional parameters in expression or relation")
   (label [this] "Canonical label of expression or relation"))

 (defprotocol Relation
   (result-labels [rel] "Collection of column labels, :all for unknown columns"))

 (defprotocol Expression
   (references [rel] "Map of relation names to a collection of their columns, referenced in relation.
Can contain a nil relation as a parent of unqualified column references")))

(defn ^:dynamic *syntax-error* [expr message]
  (throw (RuntimeException. (str message ":\n" expr))))

(defmacro syntax-assert
  ([cond expr msg] (when *assert* `(when-not ~cond (*syntax-error* ~expr ~msg)))))

;;; Data types

;; Note: currently this defines a :table/field syntax
;; which is different from CQLs :table.field one

;; Field

; Predicates

(def field? keyword?)
(def qualified-field? #(and (keyword? %) (namespace %)))
(def unqualified-field? #(and (keyword? %) (not (namespace %))))

; Accessors

(def field-name name)
(def field-relation namespace)

; Constructors

(def qualified-field #(keyword %1 %2))
(def unqualified-field #(keyword %))

;; Relation

; Predicates

(def relation? :operator)

; Accessors

(defn- inferred-label [relation]
  (let [genstr (comp str gensym name)]
    (match relation
           (_ :when keyword?)                            (genstr relation)
           [_ ':as (ename :when keyword?)]               (genstr ename)
           {:operator :literal}                          (:name relation)
           {:operator (:or :project :select :aggregate)} (inferred-label (:source relation))
           {:operator op}                                (genstr op) 
           :else                                         (str (gensym "L_")))))

; Constructors

(defn labeled-expression [name expression]
  (clojure.lang.MapEntry. name expression))

(def label first)

;; Syntax definitions

; selecting + renaming fields
(defn- projection-syntax
  "Create a map of output labels to their source expressions
 (which can be simple labels themselves)"
  [fields]
  (letfn [(stx-name [[expr label? label]]
            (field-name (if (= label? :as)
                          label label?)))]
    (into {} (map labeled-expression
                  (for [f fields] (cond (not (or (vector? f) (field? f)))
                                        (*syntax-error* f "Label needed for expression")

                                        (field? f) (field-name f)
                                        :else (stx-name f)))
                  (map #(if (vector? %) (first %) %)
                       fields)))))

; the criterium of a join
(defn- join-clause-syntax [on-clause rel-1-name rel-2-name]
  (cond (unqualified-field? on-clause)
        (pred/=* (qualified-field rel-1-name (field-name on-clause))
                 (qualified-field rel-2-name (field-name on-clause)))

        (and (vector? on-clause)
             (= 2 (count on-clause)))
        (pred/=* (first on-clause)
                 (second on-clause))

        (pred/predicate? on-clause)
        on-clause
        
        :else (*syntax-error* on-clause "Not a valid join clause")))

; a syntactic position in a field or relation context that allows
; naming with [expr :as :label]

;; AST constructors

(defn relation
  ([name] (relation name [:all]))
  ([name fields]
     {:pre [(every? unqualified-field? fields)]}
     {:operator :literal
      :name name
      :field-expressions fields}))

(defn label [rel label]
  {:pre [(relation? rel)
         (unqualified-field? label)]}
  {:operator :label
   :name label})

(defn project [rel fields]
  {:pre [(relation? rel)
         (every? unqualified-field? fields)]}
  (let [])
  {:operator :project
   :source rel
   :field-expressions (projection-syntax fields)})

(defn select [rel filter]
  {:pre [(relation? rel)
         (pred/predicate? filter)]}
  {:operator :select
   :source rel
   :filter-expression filter})

(defn outer-join [rel-1 rel-2 type on]
  {:pre [(relation? rel-1)
         (relation? rel-2)
         (#{:inner :left :right :outer} type)]}
  (let [l1 (inferred-label rel-1)
        l2 (inferred-label rel-2)
        clause (join-clause-syntax on l1 l2)]
    {:operator :join
     :extent type
     :rel-1 (labeled-expression l1 rel-1)
     :rel-2 (labeled-expression l2 rel-2)
     :clause clause}))

(defn join [rel-1 rel-2 on]
  (outer-join rel-1 rel-2 :inner on))

(defn aggregate [rel aggregated-fields group-by]
  {:pre [(relation? rel)]}
  {:operator :aggregate
   :source rel
   :aggregations (projection-syntax aggregated-fields)
   :groups (projection-syntax group-by)})

(defn union [rel-1 rel-2]
  {:pre [(relation? rel-1) (relation? rel-2)]}
  {:operator :union
   :rel-1 rel-1
   :rel-2 rel-2})

(defn difference [rel-1 rel-2]
  {:pre [(relation? rel-1) (relation? rel-2)]}
  {:operator :difference
   :rel-1 rel-1
   :rel-2 rel-2})

(defn intersection [rel-1 rel-2]
  {:pre [(relation? rel-1) (relation? rel-2)]}
  {:operator :intersection
   :rel-1 rel-1
   :rel-2 rel-2})