eql-schema.clj

(ns com.wsscode.eql-schema
  (:require
    [clojure.spec.alpha :as s]
    [com.wsscode.misc.coll :as coll]
    [edn-query-language.core :as eql]))

(defn ? [attr]
  (eql/update-property-param attr assoc ::optional? true))

(defn spec-exists? [attr]
  (contains? (s/registry) attr))

(defn ast-keys [ast]
  (->> (tree-seq :children :children ast)
       (into #{} (keep :key))))

(defn eql-schema-unspecified? [eql]
  (->> (eql/query->ast eql) (ast-keys)
       (into #{} (remove spec-exists?))))

(defn validate-attribute-presence-ast [{:keys [children]} entity path]
  (let [expected-keys (into #{} (map :key) children)]
    (reduce-kv
      (fn [_ k _]
        (when-not (contains? expected-keys k)
          (throw (ex-info
                   (str "Unexpected key " k " received at path " (pr-str path) ".")
                   {:key k :entity entity}))))
      nil
      entity))
  (reduce
    (fn [_ {:keys [key children params] :as ast}]
      (if-let [[_ v] (find entity key)]
        (when (seq children)
          (cond
            (map? v)
            (validate-attribute-presence-ast ast v (conj path key))

            (coll/collection? v)
            (doseq [[v' i] (mapv vector v (range))]
              (validate-attribute-presence-ast ast v' (into path [key i])))

            :else
            (throw (ex-info (str "Can't process sub-query on value "
                              (pr-str v)
                              " at path "
                              (pr-str path))
                     {:entity entity
                      :key    key}))))
        (when-not (::optional? params)
          (throw (ex-info (str "Missing key " key " at path " (pr-str path) ".")
                   {:key key :entity entity})))))
    nil
    children)

  true)

(defn validate-attribute-presence-query [query entity]
  (validate-attribute-presence-ast (eql/query->ast query) entity []))

(defn validate! [query entity]
  (validate-attribute-presence-query query entity)
  (if (s/valid? (s/keys) entity)
    true
    (let [err (s/explain-data (s/keys) entity)]
      (throw (ex-info (str "Spec failed") err)))))