A start on spec-ing Datomic queries

query_optim_core.clj

(ns query-optim.core
  (:require [clojure.spec :as s]
            [clojure.spec.gen :as gen]
            [clojure.string :refer [starts-with?]]
            [clojure.test.check.generators :as generators]))


(s/def ::query
  (s/cat :find-spec ::find-spec
         :with-clause (s/? ::with-clause)
         :inputs (s/? ::inputs)
         :where-clauses (s/? ::where-clauses)))

(s/def ::find-spec
  (s/cat :find-kw #{:find}
         :find-rel (s/? ::find-rel)
         :find-coll (s/? ::find-coll)
         :find-tuple (s/? ::find-tuple)
         :find-scalar (s/? ::find-scalar)))

(s/def ::find-rel
  (s/+ ::find-elem))

(s/def ::find-coll
  (s/spec (s/cat :find-elem ::find-elem
                 :ellipses-sym #{'...})))

(s/def ::find-scalar
  (s/cat :find-elem ::find-elem
         :period-sym #{'.}))

(s/def ::find-tuple
  (s/spec (s/+ ::find-elem)))

(s/def ::find-elem
  (s/or :variable ::variable
        :aggregate ::aggregate))

(s/def ::pattern
  (s/or :input-name ::src-var
        :pattern-data-literal ::pattern-data-literal))

(s/def ::aggregate
  (s/spec
    (s/cat :aggregate-fn-name ::aggregate-fn-name
           :fn-args (s/+ ::fn-arg))))

(s/def ::aggregate-fn-name ::plain-symbol)

(s/def ::fn-arg
  (s/or :variable ::variable
        :constant ::constant
        :src-var ::src-var))

(s/def ::with-clause
  (s/cat :with-kw #{:with}
         :variables (s/+ ::variable)))

(s/def ::where-clauses
  (s/cat :where-kw #{:where}
         :clauses (s/+ ::clause)))

(s/def ::inputs
  (s/cat :in-kw #{:in}
         :input-args (s/+ (s/alt :src-var ::src-var
                                 :variable ::variable
                                 :pattern-var ::pattern-var
                                 :rules-var ::rule-var))))

(s/def ::src-var
  (s/and symbol?
         #(starts-with? (name %) "$")))

(s/def ::variable
  (s/and symbol?
         #(starts-with? (name %) "?")))

(s/def ::rules-var
  #{'%})

(s/def ::plain-symbol
  (s/and symbol?
         #(not (starts-with? (name %) "?"))
         #(not (starts-with? (name %) "$"))))

(s/def ::pattern-var
  ::plain-symbol)

(s/def ::and-clause
  (s/spec (s/cat :and-sym #{'and}
                 :clauses (s/+ ::clause))))

(s/def ::expression-clause
  (s/or :data-pattern ::data-pattern
        :pred-expr ::pred-expr
        :fn-expr ::fn-expr
        :rule-exp ::rule-expr))

(s/def ::rule-expr
  (s/spec
    (s/cat :src-var (s/? ::src-var)
           :rule-name ::rule-name
           :rule-args (s/+ (s/alt :variable ::variable
                                  :constant ::constant
                                  :blank #{'_})))))

(s/def ::not-clause
  (s/spec (s/cat :src-var (s/? ::src-var)
                 :not-sym #{'not}
                 :clauses (s/+ ::clause))))

(s/def ::not-join-clause
  (s/spec (s/cat :src-var (s/? ::src-var)
                 :not-join-sym #{'not-join}
                 :variables (s/spec (s/+ ::variable))
                 :clauses (s/+ ::clause))))

(s/def ::or-clause
  (s/spec
    (s/cat :src-var (s/? ::src-var)
           :or-sym #{'or}
           :clauses (s/+ (s/alt :clause ::clause
                                :and-clause ::and-clause)))))

(s/def ::or-join-clause
  (s/spec
    (s/cat :src-var (s/? ::src-var)
           :or-join-sym #{'or-join}
           :rule-vars ::rule-vars
           :clauses (s/+ (s/alt :clause ::clause
                                :and-clause ::and-clause)))))

(s/def ::rule-vars
  (s/spec
    (s/cat :variables (s/+ ::variable))))

(s/def ::clause
  (s/or :not-clause ::not-clause
        :not-join-clause ::not-join-clause
        :or-clause ::or-clause
        :or-join-clause ::or-join-clause
        :expression-clause ::expression-clause))

(s/def ::data-pattern
  (s/spec
    (s/cat :src-var (s/? ::src-var)
           :pattern (s/+ (s/alt :variable ::variable
                                :constant ::constant
                                :blank #{'_})))))

(s/def ::constant
  #(not (symbol? %)))

(s/def ::pred-expr
  (s/spec
    (s/spec
      (s/cat :pred ::pred
             :fn-args (s/+ ::fn-arg)))))

(s/def ::fn-expr
  (s/spec
    (s/cat :call (s/spec (s/cat :fn symbol?
                                :fn-args (s/+ ::fn-arg)))
           :binding ::binding)))

(s/def ::binding
  (s/or :bind-scalar ::bind-scalar
        :bind-tuple ::bind-tuple
        :bind-coll ::bind-coll
        :bind-rel ::bind-rel))

(s/def ::bind-scalar
  ::variable)

(s/def ::bind-tuple
  (s/spec (s/+ (s/or :variable ::variable
                     :underscore-sym #{'_}))))

(s/def ::bind-coll
  (s/spec (s/cat :variable ::variable
                 :ellipses-sym #{'...})))

(s/def ::bind-rel
  (s/spec (s/spec (s/+ (s/or :variable ::variable
                             :underscore-sym #{'_})))))

(s/def ::rule
  (s/spec (s/+ (s/spec (s/cat :rule-head ::rule-head
                              :clauses (s/+ ::clause))))))

(s/def ::rule-head
  (s/spec
    (s/cat :rule-name ::rule-name
           :rule-vars ::rule-vars)))

(s/def ::rule-name ::plain-symbol)