From 2301de6acc41343ab99548c806a849df9b006e37 Mon Sep 17 00:00:00 2001 From: Valentin Waeselynck Date: Tue, 27 Mar 2018 11:05:58 +0200 Subject: [PATCH] First commit, extracted from BandSquare's internal code --- .gitignore | 14 ++ CHANGELOG.md | 10 + LICENSE | 7 + README.md | 15 ++ doc/intro.md | 3 + project.clj | 11 ++ src/d2q/api.clj | 95 +++++++++ src/d2q/impl.clj | 293 +++++++++++++++++++++++++++ src/d2q/impl/tabular_protocols.clj | 16 ++ src/d2q/impl/utils.clj | 78 ++++++++ test/d2q/test/api.clj | 307 +++++++++++++++++++++++++++++ 11 files changed, 849 insertions(+) create mode 100644 .gitignore create mode 100644 CHANGELOG.md create mode 100644 LICENSE create mode 100644 README.md create mode 100644 doc/intro.md create mode 100644 project.clj create mode 100644 src/d2q/api.clj create mode 100644 src/d2q/impl.clj create mode 100644 src/d2q/impl/tabular_protocols.clj create mode 100644 src/d2q/impl/utils.clj create mode 100644 test/d2q/test/api.clj diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..a9453ec --- /dev/null +++ b/.gitignore @@ -0,0 +1,14 @@ +/target +/classes +/checkouts +pom.xml +pom.xml.asc +*.jar +*.class +/.lein-* +/.nrepl-port +.hgignore +.hg/ + +*.iml +.idea diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..37ffb29 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,10 @@ +# Change Log +All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/). + +## [Unreleased] + +## [0.0.1-alpha] - 2018-03-27 +### Added +- Basic implementation and tests based on BandSquare's internal code, supports asynchronous and tabular resolvers. + +[Unreleased]: https://github.com/your-name/d2q/compare/0.1.1-alpha...HEAD diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..42ab98e --- /dev/null +++ b/LICENSE @@ -0,0 +1,7 @@ +Copyright 2018 BandSquare and contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..e6d202e --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +# d2q + +A Clojure library which provides a generic, expressive, efficient way of implementing query servers for demand-driven languages such as GraphQL. + +**Project status:** less than alpha, open-sourced to allow for development outside of the company. Do not use yet, as major breaking changes will occur soon. + +## Usage + +TBD + +## License + +Copyright © 2018 BandSquare and contributors + +Distributed under the MIT license. diff --git a/doc/intro.md b/doc/intro.md new file mode 100644 index 0000000..8c0fb9f --- /dev/null +++ b/doc/intro.md @@ -0,0 +1,3 @@ +# Introduction to d2q + +TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) diff --git a/project.clj b/project.clj new file mode 100644 index 0000000..62af9e1 --- /dev/null +++ b/project.clj @@ -0,0 +1,11 @@ +(defproject bandsquare/d2q "0.0.1-SNAPSHOT" + :description "An expressive toolkit for building efficient GraphQL-like query servers" + :url "https://github.com/bandsquare/d2q" + :license {:name "MIT License" + :url "https://opensource.org/licenses/MIT"} + :dependencies [[org.clojure/clojure "1.8.0"] + [manifold "0.1.6"]] + :profiles + {:dev + {:dependencies + [[midje "1.7.0"]]}}) diff --git a/src/d2q/api.clj b/src/d2q/api.clj new file mode 100644 index 0000000..b882045 --- /dev/null +++ b/src/d2q/api.clj @@ -0,0 +1,95 @@ +(ns d2q.api + "Demand-driven querying à la GraphQL / Datomic Pull" + (:require [clojure.walk] + [manifold.deferred :as mfd] + [d2q.impl.utils :as impl.utils] + [d2q.impl])) + +;; TODO improvements (Val, 15 Mar 2018) +;; 1. √ Remove specific authorization model - replace by a query-level resolution step +;; 2. Subquery preview in resolvers? May require to change the format of resolvers. +;; 3. Partial errors => resolvers return a map with {:data :errors} key +;; 4. Maybe skip the normalization of query - should be done by the caller +;; 5. Mutual recursion (requires to change the query format) +;; 6. Source mapping - keep track of (reversed) query-path and data-path +;; 7. Maybe faster processing via records ? + +;; IMPROVEMENT maybe we can let the client express than some field is required etc. (Val, 30 May 2017) +(defn normalize-query-field + [f] + (as-> f f + (if (map? f) + f + {:d2q.fcall/field f}) + + (update f + :d2q.fcall/key + #(or % (:d2q.fcall/field f))) + + (if-let [nested (:d2q.fcall/nested f)] + (assoc f :d2q.fcall/nested (into [] (map normalize-query-field) nested)) + f))) + +(defn normalize-query + [pull-spec] + (into [] (map normalize-query-field) pull-spec)) + +(defn query-engine + "Compiles tabular field resolvers + fields specs + entity-transformation fn to a function for computing demand-driven queries. + The returned function has signature [qctx, q, obj] -> Deferred" + [tabular-resolvers + fields + transform-entities-fn ;; TODO find a better name for this step (Val, 17 Mar 2018) + ] + (let [eng (d2q.impl/engine tabular-resolvers fields transform-entities-fn)] + (fn query [qctx q obj] + (let [query (normalize-query q)] + (d2q.impl/query eng qctx query obj))))) + +;; ------------------------------------------------------------------------------ +;; Generalization of the Fields-resolver model + +(defn tabular-resolver-from-field-resolvers + [tr-name fields] + {:d2q.resolver/name tr-name + :d2q.resolver/compute + (let [frs-by-field-name (impl.utils/index-and-map-by + :d2q.field/name + :bs.d2q.field/compute + fields)] + (fn resolve-table [qctx f+args o+is] + (mfd/future + (let [fs (->> f+args + (mapv (fn [[k field-name args]] + (let [compute-fn (or + (frs-by-field-name field-name) + (throw (ex-info + (str "No field with name " (pr-str field-name) + " is supported by tabular resolver " (pr-str tr-name)) + {:d2q.fcall/field field-name + :d2q.fcall/args args + :d2q.resolver/name tr-name})))] + [k compute-fn args field-name]))))] + (into [] + (remove nil?) + (for [[obj i] o+is + [k compute-fn args field-name] fs] + (let [v (try + ;; TODO use deps argument ? (Val, 16 Nov 2017) + (compute-fn qctx obj nil args) + (catch Throwable err + (throw + (ex-info + (str + "Field Resolver for key " (pr-str (:d2q.fcall/key k)) + " failed with " (pr-str (type err)) + " : " (.getMessage err)) + (merge + {:q-field {:d2q.fcall/field field-name + :d2q.fcall/key k + :d2q.fcall/args args} + :d2q.error/type :d2q.error.type/field-resolver-failed-to-compute} + (ex-data err)) + err))))] + (when (some? v) + [i k v]))))))))}) \ No newline at end of file diff --git a/src/d2q/impl.clj b/src/d2q/impl.clj new file mode 100644 index 0000000..1bc985a --- /dev/null +++ b/src/d2q/impl.clj @@ -0,0 +1,293 @@ +(ns d2q.impl + "Algorithm with tabular, non-blocking resolvers. Allows for low-latency and avoiding blocking IO." + (:require [manifold.deferred :as mfd] + [d2q.impl.tabular-protocols :as tp] + [d2q.impl.utils :as impl.utils]) + (:import (java.util List ArrayList))) + +(defn q-clauses + [query] + query) + +(defn qc-field-name [qc] + (:d2q.fcall/field qc)) + +(defn qc-key [qc] + (:d2q.fcall/key qc)) + +(defn qc-args [qc] + (:d2q.fcall/args qc)) + +(defn qc-nested [qc] + (:d2q.fcall/nested qc)) + +(defn table-resolver-for-field + [field] + (tp/field-table-resolver field) + ) + +(defn resolve-table + [tr qctx f+args o+is] + (try + (tp/resolve-table tr qctx f+args o+is) + (catch Throwable err + (mfd/error-deferred err)))) + +(defn field-by-name + [engine field-name] + (or + (tp/field-by-name engine field-name) + (throw (ex-info + (str "No Field registered under name " (pr-str field-name)) + {:d2q.field/name field-name})))) + +(defn scalar-typed? + [field] + (tp/field-scalar? field)) + +(defn ref-typed? + [field] + (not (scalar-typed? field))) + +(defn many-typed? + [field] + (tp/field-many? field)) + +(defrecord EnrichedQClause + [key field-name args nested field table-resolver src-qc]) + +(defn enrich-qc [engine qc] + (let [field-n (qc-field-name qc) + f (field-by-name engine field-n) + tr (table-resolver-for-field f)] + (->EnrichedQClause + (qc-key qc) + field-n + (qc-args qc) + (qc-nested qc) + f + tr + qc))) + +(defn merge-maps-arrs + "Given a seq of l-sized arrays of maps, returns an array of maps merged together." + #^"[Ljava.lang.Object;" [l map-arrays] + (let [map-arrs (to-array map-arrays) + ret-arr (object-array l)] + (impl.utils/doarr-indexed! [[i _] ret-arr] + (aset ret-arr i + (persistent! + (impl.utils/areduce-iv + [[m _ ^objects map-arr] map-arrs] + (transient {}) + (->> (aget map-arr i) + (reduce-kv assoc! m))) + ))) + ret-arr)) + +(comment + (vec + (merge-maps-arrs + 3 + (for [k [:a :b :c]] + (object-array (for [i (range 4)] {k i}))))) + => [{:a 0, :b 0, :c 0} {:a 1, :b 1, :c 1} {:a 2, :b 2, :c 2}] + ) + +(defn populate + "`objs` is an array of DD objects, returns an array of corresponding DD results (maps or nil)." + [engine, qctx, query, ^objects objs] + (mfd/future + (let [e-qs + (mapv #(enrich-qc engine %) (q-clauses query)) + + o+is + (vec (impl.utils/amap-indexed [[i o] objs] [o i])) + + p_transformed-entities + (-> (tp/transform-entities engine qctx query o+is) + (mfd/chain vec) + (mfd/catch + (fn [^Throwable err] + (throw (ex-info + (str "Error when transforming entities: " (pr-str (class err)) " : " (.getMessage err)) + {:query query} + err)))))] + (-> p_transformed-entities + (mfd/chain + (fn [o+is] + (let [n-objs (alength objs) + + by-tr (group-by :table-resolver e-qs) + p_table-batches + (->> by-tr + (map + (fn [[tr e-qs]] + (let [f+args (->> e-qs + (map (fn [e-qc] + [(:key e-qc) (:field-name e-qc) (:args e-qc)]))) + p_results (-> (resolve-table tr qctx f+args o+is) + (mfd/catch + (fn [^Throwable err] + (throw (ex-info + (str "Tabular Resolver " (pr-str (tp/tr-name tr)) + " failed with " (pr-str (class err)) " : " (.getMessage err)) + (merge + {:d2q.resolver/name (tp/tr-name tr) + :f+args f+args} + (ex-data err)) + err))))) + {ref-e-qs true scalar-e-qs false} (group-by #(ref-typed? (:field %)) e-qs)] + (mfd/chain p_results + (fn [results] + (let [k->scalar + (impl.utils/index-and-map-by + :key (constantly true) + scalar-e-qs) + k->ref + (impl.utils/index-and-map-by + :key + (fn [e-qc] + (let [;; The list of all children via e-qc + children-objs-list (ArrayList.) + many? (-> e-qc :field many-typed?) + ;; an array of arrays, in the case of a to-many relationship, holding the ordered result maps of the children. + children-results-arrs (when many? + (object-array n-objs))] + [children-objs-list + many? + children-results-arrs + e-qc])) + ref-e-qs) + + arr-scalars + (let [arr-scalars (object-array n-objs)] + (doseq [[parent-i k v] results] + (let [tm (or + (aget arr-scalars parent-i) + (transient {}))] + (aset arr-scalars parent-i + (if-let [_ (k->scalar k)] + (assoc! tm k v) + (if-let [[^List children-list, many?, ^objects children-results-arrs] (k->ref k)] + (do + (if many? + (do + (.addAll children-list + (into [] + (map-indexed + (fn [j child] + [child parent-i j])) + v)) + (aset children-results-arrs parent-i (object-array (count v)))) + (.add children-list [v parent-i])) + tm) + (throw (ex-info + (str "Unidentified key " (pr-str k)) + {:k k}))))))) + (impl.utils/doarr-indexed! [[i tm] arr-scalars] + (when (some? tm) + (aset arr-scalars i (persistent! tm)))) + arr-scalars) + + p_ref-arrs + (->> k->ref + (mapv (fn [[k [^List children-list, many?, ^objects children-results-arrs, e-qc]]] + (let [children-objs (impl.utils/amap-indexed + [[_ [o _]] + (to-array children-list)] + o) + ;; recursive call + p_populated (populate engine qctx (:nested e-qc) children-objs)] + (mfd/chain p_populated + (fn [^objects i+rs] + (if many? + (do + (impl.utils/doarr-indexed! [[i r] i+rs] + (let [[_ parent-i j] (.get children-list (int i))] + (-> children-results-arrs + ^objects (aget parent-i) + (aset j r)))) + (impl.utils/amap-indexed + [[_ a-children-maps] + children-results-arrs] + (when (some? a-children-maps) + {k (vec a-children-maps)}))) + (let [arr (object-array n-objs)] + (impl.utils/doarr-indexed! [[i r] i+rs] + (let [[_ parent-i] (.get children-list (int i))] + (aset arr parent-i {k r}))) + arr)))) + ))))] + (apply mfd/zip + (doto (mfd/deferred) (deliver arr-scalars)) + p_ref-arrs) + ))) + ))) + (apply mfd/zip))] + (mfd/chain p_table-batches + (fn [arr-seqs] + (merge-maps-arrs n-objs (apply concat arr-seqs)))) + ))))))) + +(defn query + [engine qctx normalized-query obj-root] + (mfd/chain (populate engine qctx normalized-query (to-array [obj-root])) + (fn [^objects i+rs] + (-> i+rs (aget 0) (or {}))))) + +;; ------------------------------------------------------------------------------ +;; Structs + +(defrecord TabularResolver + [name f] + tp/ITabularResolver + (tr-name [_] name) + (resolve-table [this qctx f+args o+is] + (f qctx f+args o+is))) + +(defrecord Field + [fieldName isScalar isMany tr acl] + tp/IField + (field-name [this] fieldName) + (field-scalar? [this] isScalar) + (field-many? [this] isMany) + (field-table-resolver [this] tr) + ) + +(defrecord Engine + [fieldByNames transformEntitiesFn #_resolveAccessLevelsFn] + tp/IEngine + (transform-entities [this qctx query o+is] + (transformEntitiesFn qctx query o+is)) + (field-by-name [this field-name] + (get fieldByNames field-name))) + +(defn engine + [tabular-resolvers fields transform-entities-fn] + {:pre [(fn? transform-entities-fn)]} + (let [trs-by-name (->> tabular-resolvers + (map (fn [tr] + (->TabularResolver + (:d2q.resolver/name tr) + (:d2q.resolver/compute tr)))) + (impl.utils/index-by :name)) + fields-by-name + (->> fields + (map (fn [f] + (->Field + (:d2q.field/name f) + (not (:d2q.field/ref? f)) + (= :d2q.field.cardinality/many (:d2q.field/cardinality f)) + (-> f :d2q.field/resolver + (or (throw (ex-info + (str "Unregistered resolver " (pr-str (:d2q.field/resolver f)) + " referenced in field " (:d2q.field/name f)) + {:field f}))) + trs-by-name) + (set (:bs.d2q.field/acl f)) + ))) + (impl.utils/index-by :fieldName))] + (->Engine fields-by-name transform-entities-fn))) + + diff --git a/src/d2q/impl/tabular_protocols.clj b/src/d2q/impl/tabular_protocols.clj new file mode 100644 index 0000000..2e16362 --- /dev/null +++ b/src/d2q/impl/tabular_protocols.clj @@ -0,0 +1,16 @@ +(ns d2q.impl.tabular-protocols) + +(defprotocol IField + (field-name [this]) + (field-scalar? [this]) + (field-many? [this]) + (field-table-resolver [this])) + +(defprotocol ITabularResolver + (tr-name [this]) + (resolve-table [this qctx f+args o+is])) + +(defprotocol IEngine + (transform-entities [this qctx query o+is]) + (field-by-name [this field-name])) + diff --git a/src/d2q/impl/utils.clj b/src/d2q/impl/utils.clj new file mode 100644 index 0000000..4f2095d --- /dev/null +++ b/src/d2q/impl/utils.clj @@ -0,0 +1,78 @@ +(ns d2q.impl.utils) + +(defn index-by + [kf coll] + (persistent! + (reduce (fn [tm v] + (assoc! tm + (kf v) + v)) + (transient {}) coll))) + +(defn index-and-map-by + [kf vf coll] + (persistent! + (reduce (fn [tm v] + (assoc! tm + (kf v) + (vf v))) + (transient {}) coll))) + +(defmacro doarr-indexed! + "Runs an sequence of expressions `body` across an array `a`, + binding `idx` to the current index and `e` to the current element. + + You should make sure that the runtime type of array a can be inferred, since + clojure.core/aget will be called." + [[[idx e] a] & body] + `(let [a# ~a + l# (alength a#)] + (loop [~idx 0] + (when (< ~idx l#) + (let [~e (aget a# ~idx)] + ~@body) + (recur (unchecked-inc-int ~idx)))))) + +(comment + (doarr-indexed! + [[i e] (to-array (range 10))] + (println i e)) + + ) + +(defmacro areduce-iv + "A more ergonomic version of areduce" + [[[acc idx e] a] init expr] + `(let [a# ~a + l# (alength a#)] + (loop [i# 0 acc# ~init] + (if (< i# l#) + (let [~idx i# + ~acc acc# + ~e (aget a# i#)] + (recur (unchecked-inc-int i#) ~expr)) + acc#)))) + +(comment + (areduce-iv [[acc i v] (to-array (range 10))] + 0 (int (+ acc (- v)))) + => -45 + ) + + +(defmacro amap-indexed + [[[idx e] a] & body] + `(let [a# ~a] + (amap a# i# _# + (let [~idx i# + ~e (aget a# i#)] + ~@body)))) + +(comment + (vec + (amap-indexed [[i e] (to-array (range 10))] + [i (- e)])) + => [[0 0] [1 -1] [2 -2] [3 -3] [4 -4] [5 -5] [6 -6] [7 -7] [8 -8] [9 -9]] + ) + + diff --git a/test/d2q/test/api.clj b/test/d2q/test/api.clj new file mode 100644 index 0000000..860c7ad --- /dev/null +++ b/test/d2q/test/api.clj @@ -0,0 +1,307 @@ +(ns d2q.test.api + (:require [clojure.test :refer :all] + [midje.sweet :refer :all] + + [d2q.api :as d2q :refer :all])) + +(def db-example + {:db/persons + {"john-doe" + {:person/id "john-doe" + :person/email "john.doe@gmail.com" + :person/age 18 + :person/address {:address/number "48" + :address/street "rue de Rome" + :address/city "Paris"} + :person/notes ["blah" :blah 42] + :animal/loves #{"alice-hacker" "minou"}} + "alice-hacker" + {:person/id "alice-hacker" + :person/email "alice.hacker@gmail.com" + :person/gender :person.gender/female + :person/notes [] + :person/address nil} + "bob-moran" + {:person/id "bob-moran" + :person/email "bob.moran@gmail.com" + :person/age nil + :person/gender :person.gender/male + :person/address {:address/number "17" + :address/street "rue de Mars" + :address/city "Orléans"}}} + :db/cats + {"minou" + {:cat/id "minou" + :cat/name "Minou" + :cat/owner "john-doe" + :animal/loves #{"john-doe" "alice-hacker" "fuzzy-fur"}} + "fuzzy-fur" + {:cat/id "fuzzy-fur" + :cat/name "Fuzzy Fur" + :cat/owner "bob-moran" + :animal/loves #{}} + "wild-cat" + {:cat/id "wild-cat" + :cat/name "Wild Cat" + :animal/loves #{}}}} + ) + +(defn qctx-example + "Constructs an example Query Context." + [] + {:db db-example}) + +;; ------------------------------------------------------------------------------ +;; Reads + +(defn- basic-fr + "Concise helper for defining field resolvers" + ([field-name ref? many? doc] + (basic-fr field-name ref? many? doc + (if ref? + (throw (ex-info "Cannot create compute function for entity-typed FR" {:d2q.field/name field-name})) + (fn [_ obj _ _] + (get obj field-name))))) + ([field-name ref? many? doc compute] + {:d2q.field/name field-name + :doc doc + :d2q.field/ref? ref? + :d2q.field/cardinality (if many? :d2q.field.cardinality/many :d2q.field.cardinality/one) + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + compute})) + +(def field-resolvers + [{:d2q.field/name :find-person-by-id + :d2q.field/ref? true + :d2q.field/cardinality :d2q.field.cardinality/one + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + (fn [qctx obj _ [person-id]] + (when-let [p (get-in (:db qctx) [:db/persons person-id])] + p))} + {:d2q.field/name :find-cat-by-id + :d2q.field/ref? true + :d2q.field/cardinality :d2q.field.cardinality/one + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + (fn [qctx obj _ [cat-id]] + (when-let [c (get-in (:db qctx) [:db/cats cat-id])] + c))} + {:d2q.field/name :animal/loves + :d2q.field/ref? true + :d2q.field/cardinality :d2q.field.cardinality/many + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + (fn [qctx obj _ _] + (let [{cats :db/cats persons :db/persons} (:db qctx)] + (->> obj :animal/loves set + (mapv (fn [id] + (or + (get cats id) + (get persons id))))) + ))} + {:d2q.field/name :animal/loved-by + :d2q.field/ref? true + :d2q.field/cardinality :d2q.field.cardinality/many + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + (fn [qctx obj _ _] + (let [{cats :db/cats persons :db/persons} (:db qctx) + id (or (:person/id obj) (:cat/id obj))] + (->> (concat (vals cats) (vals persons)) + (filter (fn [a] + (contains? (or (:animal/loves a) #{}) id))) + vec) + ))} + {:d2q.field/name :find-all-humans + :d2q.field/ref? true + :d2q.field/cardinality :d2q.field.cardinality/many + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + (fn [{:keys [db]} _ _ _] + (->> db :db/persons vals))} + {:d2q.field/name :find-all-cats + :d2q.field/ref? true + :d2q.field/cardinality :d2q.field.cardinality/many + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + (fn [{:keys [db]} _ _ _] + (->> db :db/cats vals))} + {:d2q.field/name :find-persons-with-gender + :doc "Example of a cardinality-many entity-typed FR with params" + :d2q.field/ref? true + :d2q.field/cardinality :d2q.field.cardinality/many + :bs.d2q.field/acl [:everyone-can-read] + :bs.d2q.field/compute + (fn [{:keys [db]} _ _ [gender]] + (->> db :db/persons vals + (filter #(-> % :person/gender (= gender)))))} + + (basic-fr :person/id false false "UID of a person") + (basic-fr :person/email false false "Email of a person") + (basic-fr :person/gender false false "Gender, an enum-valued FR, optional") + (basic-fr :person/age false false "Age, optional") + (basic-fr :person/address false false "Example of a map-valued scalar field") + (basic-fr :person/notes false false "Example of a list-valued scalar field") + (basic-fr :cat/id false false "") + (basic-fr :cat/name false false "") + (basic-fr :cat/owner true false "A to-one entity-typed field" + (fn [{:keys [db]} obj _ _] + (get-in db [:db/persons (:cat/owner obj)]))) + + (basic-fr :one-nil true false "A to-one FR returning nil" + (constantly nil)) + (basic-fr :many-nil true true "A to-many FR returning nil" + (constantly nil)) + (basic-fr :scalar-nil false false "A scalar FR returning nil" + (constantly nil)) + + (basic-fr :scalar-throws false false "" + (fn [_ _ _ _] (throw (ex-info "Scalar failed" {:error-data 42})))) + (basic-fr :one-throws true false "" + (fn [_ _ _ _] (throw (ex-info "To-one failed" {:error-data 42})))) + (basic-fr :many-throws true false "" + (fn [_ _ _ _] (throw (ex-info "To-many failed" {:error-data 42})))) + ]) + +(defn engine2 + [field-resolvers] + (d2q.api/query-engine + [(d2q.api/tabular-resolver-from-field-resolvers ::default field-resolvers)] + (map #(assoc % :d2q.field/resolver ::default) field-resolvers) + (fn [qctx query o+is] o+is))) + + + +(defn query-engine-example + [] + (fn [qctx query obj] + ;; Execution time mean : 228.790078 µs on first sample query + @((engine2 field-resolvers) + qctx (d2q/normalize-query query) obj)) + ;; Execution time mean : 48.560712 µs on first sample query + #_(d2q/engine field-resolvers + {:demand-driven.authorization.read/accesses-for-object (constantly #{:everyone-can-read})})) + +(defn q + "Runs a query on the example dataset" + [query] + (let [q-engine (query-engine-example) + qctx (qctx-example) + root-obj {}] + (q-engine qctx query root-obj))) + +(defn fcall + "Helper for writing Field Calls concisely" + ([field-name nested] + {:d2q.fcall/field field-name + :d2q.fcall/nested nested}) + ([field-name key args] + {:d2q.fcall/key key + :d2q.fcall/field field-name + :d2q.fcall/args args}) + ([field-name key args nested] + {:d2q.fcall/key key + :d2q.fcall/field field-name + :d2q.fcall/args args + :d2q.fcall/nested nested})) + +(fact "Canonical example" + (q (let [human-q [:person/id :person/email :person/age :person/address + (fcall :animal/loves + [:person/id :cat/id])]] + [(fcall :find-person-by-id "jd" ["john-doe"] + human-q) + (fcall :find-all-humans "humans" nil + human-q) + (fcall :find-all-cats "m" nil + [:cat/id :cat/name + {:d2q.fcall/field :cat/owner + :d2q.fcall/nested + [:person/email]}])])) + => + {"jd" {:person/id "john-doe", + :person/email "john.doe@gmail.com", + :person/age 18, + :person/address {:address/number "48", :address/street "rue de Rome", :address/city "Paris"}, + :animal/loves [{:person/id "alice-hacker"} {:cat/id "minou"}]}, + "humans" [{:person/id "john-doe", + :person/email "john.doe@gmail.com", + :person/age 18, + :person/address {:address/number "48", :address/street "rue de Rome", :address/city "Paris"}, + :animal/loves [{:person/id "alice-hacker"} {:cat/id "minou"}]} + {:person/id "alice-hacker", :person/email "alice.hacker@gmail.com", :animal/loves []} + {:person/id "bob-moran", + :person/email "bob.moran@gmail.com", + :person/address {:address/number "17", :address/street "rue de Mars", :address/city "Orléans"}, + :animal/loves []}], + "m" [{:cat/id "minou", :cat/name "Minou", :cat/owner {:person/email "john.doe@gmail.com"}} + {:cat/id "fuzzy-fur", :cat/name "Fuzzy Fur", :cat/owner {:person/email "bob.moran@gmail.com"}} + {:cat/id "wild-cat", :cat/name "Wild Cat"}]} + ) + +(fact "When entity does not exist, not added to the result" + (q [{:d2q.fcall/key "x" + :d2q.fcall/field :find-person-by-id + :d2q.fcall/args ["does not exist"] + :d2q.fcall/nested + [:person/id + {:d2q.fcall/field :animal/loves + :d2q.fcall/nested + [:person/id :cat/id]}]}]) + => {} + + (q [{:d2q.fcall/key "w" + :d2q.fcall/field :find-cat-by-id + :d2q.fcall/args ["wild-cat"] + :d2q.fcall/nested + [:cat/id + {:d2q.fcall/field :cat/owner + :d2q.fcall/nested + [:person/id]}]}]) + => {"w" {:cat/id "wild-cat"}} + ) + +(fact "When a Field Resolver returns nil, the key is not added to the result." + (q [:many-nil :one-nil :scalar-nil]) + => {} + + (fact "When an Entity-typed Field Resolver returns nil, the nested fields are not computed" + (q [(fcall :one-nil + [:scalar-throws :one-throws :many-throws])]) + => {})) + +(fact "When a Field Resolver throws, the whole query fails, with informative data about the error." + (tabular + (fact + (try + (q [(fcall ?field-name ?field-name "aaaaaargs")]) + :should-have-failed + (catch Throwable err + (ex-data err))) + => + (contains + {:q-field {:d2q.fcall/field ?field-name, + :d2q.fcall/key ?field-name + :d2q.fcall/args "aaaaaargs"}, + :d2q.error/type :d2q.error.type/field-resolver-failed-to-compute + :error-data 42}) + ) + ?field-name + :scalar-throws + :one-throws + :many-throws + )) + +;; TODO tests for authorization. (Val, 20 Nov 2017) + + + + + + + + + +