├── .gitignore ├── .travis.yml ├── CONTRIBUTING.md ├── LICENSE ├── README.md ├── benchmarks └── claro │ ├── performance_benchmarks │ ├── apply_resolved_values.clj │ └── wrap_tree.clj │ ├── projection_benchmarks │ ├── deep.clj │ ├── sequential.clj │ └── union.clj │ ├── queries.clj │ ├── resolution_with_batching.clj │ ├── resolution_with_batching │ ├── assertion.clj │ ├── claro.clj │ ├── muse.clj │ └── urania.clj │ ├── resolution_without_batching.clj │ └── resolution_without_batching │ ├── assertion.clj │ ├── claro.clj │ ├── muse.clj │ └── urania.clj ├── doc ├── 00-basics.md ├── 01-projection.md ├── 02-advanced-projection.md ├── 03-engine.md ├── 04-testing-and-debugging.md └── 99-notes.md ├── project.clj ├── src └── claro │ ├── data.cljc │ ├── data │ ├── error.cljc │ ├── ops.cljc │ ├── ops │ │ ├── chain.cljc │ │ ├── collections.cljc │ │ ├── fmap.cljc │ │ ├── maps.cljc │ │ └── then.cljc │ ├── protocols.cljc │ ├── transform.clj │ ├── tree.cljc │ └── tree │ │ ├── blocking_composition.cljc │ │ ├── collection.cljc │ │ ├── composition.cljc │ │ ├── leaf.cljc │ │ ├── map.cljc │ │ ├── object.cljc │ │ ├── tuple.cljc │ │ └── utils.cljc │ ├── engine.cljc │ ├── engine │ ├── adapter.cljc │ ├── core.cljc │ ├── multi.clj │ ├── protocols.cljc │ ├── resolver.cljc │ └── selector.cljc │ ├── middleware │ ├── cache.cljc │ ├── deferred.cljc │ ├── intercept.cljc │ ├── mock.cljc │ ├── observe.cljc │ └── transform.cljc │ ├── projection.cljc │ ├── projection │ ├── aux.cljc │ ├── bind.cljc │ ├── case.cljc │ ├── conditional.cljc │ ├── juxt.cljc │ ├── level.cljc │ ├── maps.cljc │ ├── maybe.cljc │ ├── objects.cljc │ ├── parameters.cljc │ ├── protocols.cljc │ ├── remove_nil.clj │ ├── sequential.cljc │ ├── sets.cljc │ ├── sort.cljc │ ├── transform.cljc │ ├── union.cljc │ └── value.cljc │ ├── runtime.cljc │ └── runtime │ ├── application.cljc │ ├── caching.cljc │ ├── impl.cljc │ ├── impl │ ├── core_async.cljc │ └── manifold.clj │ ├── inspection.cljc │ ├── mutation.cljc │ ├── resolution.cljc │ ├── selection.cljc │ └── state.clj └── test └── claro ├── data ├── error_test.clj ├── ops │ ├── collections_test.clj │ ├── fmap_test.clj │ ├── maps_test.clj │ └── then_test.clj ├── transform_test.clj └── tree_test.clj ├── engine ├── caching_test.clj ├── cost_test.clj ├── fixtures.clj ├── manifold_test.clj ├── multi_test.clj ├── mutation_test.clj └── resolution_test.clj ├── middleware ├── cache_test.clj ├── deferred_test.clj ├── intercept_test.clj ├── mock_test.clj ├── observe_test.clj └── transform_test.clj ├── projection ├── alias_test.clj ├── bind_test.clj ├── conditional_test.clj ├── error_test.clj ├── generators.clj ├── juxt_test.clj ├── level_test.clj ├── maps_test.clj ├── maybe_test.clj ├── ops_test.clj ├── parameters_test.clj ├── prepare_test.clj ├── printability_test.clj ├── remove_nil_test.clj ├── sequential_test.clj ├── set_test.clj ├── sort_test.clj ├── transform_test.clj ├── union_test.clj └── value_test.clj ├── runtime └── impls_test.cljc └── test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | jdk: 3 | - oraclejdk8 4 | after_success: 5 | - lein codecov 6 | - bash <(curl -s https://codecov.io/bash) -f target/coverage/codecov.json 7 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # How to contribute 2 | 3 | Contributions are always welcome and it should be as seamless as possible for 4 | you to land patches in master. 5 | 6 | ## Getting Started 7 | 8 | - Make sure you have a [GitHub account][github]. 9 | - Submit an issue outlining your bug/feature (unless there is already one). This 10 | way we can discuss possible solutions/implementations and make sure everyone 11 | is on the same page. 12 | - Fork the repository. 13 | 14 | [github]: https://github.com/signup/free 15 | 16 | ## Making Changes 17 | 18 | - Create a topic branch off of `master`. 19 | - Commit logical units, try to avoid mixing of changes to different logical 20 | parts of the project. 21 | - Make sure your commit messages have the proper format (see existing commits), 22 | starting with `[#] ...`. Ideally, the commit text should also 23 | contain a short description of the feature/bug it is addressing. 24 | - Make sure you have added tests for your changes. 25 | - Run the complete testsuite (`lein test`) and see it pass. 26 | 27 | ## Submitting Changes 28 | 29 | - Push your changes to your topic branch. 30 | - Submit a Pull Request to the GitHub repository, mentioning the original issue 31 | in the description text. 32 | - The Pull Request will be discussed and feedback provided. 33 | 34 | ## Additional Resources 35 | 36 | - [GitHub Help](https://help.github.com/) 37 | - [Using Pull Requests](https://help.github.com/articles/using-pull-requests/) 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2015-2017 Yannick Scherer 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /benchmarks/claro/performance_benchmarks/apply_resolved_values.clj: -------------------------------------------------------------------------------- 1 | (ns claro.performance-benchmarks.apply-resolved-values 2 | (:require [perforate.core :refer [defgoal defcase]] 3 | [claro.data.protocols :as p] 4 | [claro.data.tree :as tree] 5 | [claro.data :as data])) 6 | 7 | (defgoal apply-resolved-values 8 | "Injection of resolution results.") 9 | 10 | ;; ## Fixtures 11 | 12 | (def elements 13 | (repeatedly 1000 #(reify data/Resolvable))) 14 | 15 | (def resolvable->value 16 | (zipmap elements (range))) 17 | 18 | ;; ## Cases 19 | 20 | (let [value (tree/wrap-tree 21 | (zipmap 22 | (map #(str "key-" %) (range)) 23 | elements))] 24 | (defcase apply-resolved-values :map 25 | [] 26 | (p/apply-resolved-values value resolvable->value))) 27 | 28 | (let [value (tree/wrap-tree (vec elements))] 29 | (defcase apply-resolved-values :vector 30 | [] 31 | (p/apply-resolved-values value resolvable->value))) 32 | 33 | (let [value (tree/wrap-tree (list* elements))] 34 | (defcase apply-resolved-values :list 35 | [] 36 | (p/apply-resolved-values value resolvable->value))) 37 | 38 | (let [value (tree/wrap-tree (set elements))] 39 | (defcase apply-resolved-values :set 40 | [] 41 | (p/apply-resolved-values value resolvable->value))) 42 | 43 | (let [value (-> (iterate #(hash-map :value %) (first elements)) 44 | (nth 100) 45 | (tree/wrap-tree))] 46 | (defcase apply-resolved-values :deep 47 | [] 48 | (p/apply-resolved-values value resolvable->value))) 49 | -------------------------------------------------------------------------------- /benchmarks/claro/performance_benchmarks/wrap_tree.clj: -------------------------------------------------------------------------------- 1 | (ns claro.performance-benchmarks.wrap-tree 2 | (:require [perforate.core :refer [defgoal defcase]] 3 | [claro.data.tree :as tree] 4 | [claro.data :as data])) 5 | 6 | (defgoal wrap-tree 7 | "Tree preprocessing, resolvable collection.") 8 | 9 | ;; ## Fixtures 10 | 11 | (def elements 12 | (repeatedly 1000 #(reify data/Resolvable))) 13 | 14 | ;; ## Cases 15 | 16 | (let [value (zipmap 17 | (map #(str "key-" %) (range)) 18 | elements)] 19 | (defcase wrap-tree :map 20 | [] 21 | (tree/wrap-tree value))) 22 | 23 | (let [value (vec elements)] 24 | (defcase wrap-tree :vector 25 | [] 26 | (tree/wrap-tree value))) 27 | 28 | (let [value (list* elements)] 29 | (defcase wrap-tree :list 30 | [] 31 | (tree/wrap-tree value))) 32 | 33 | (let [value (set elements)] 34 | (defcase wrap-tree :set 35 | [] 36 | (tree/wrap-tree value))) 37 | 38 | (let [value (-> (iterate #(hash-map :value %) (first elements)) 39 | (nth 100))] 40 | (defcase wrap-tree :deep 41 | [] 42 | (tree/wrap-tree value))) 43 | -------------------------------------------------------------------------------- /benchmarks/claro/projection_benchmarks/deep.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection-benchmarks.deep 2 | (:require [perforate.core :refer [defgoal defcase]] 3 | [claro.queries :refer :all] 4 | 5 | [claro.data :as data] 6 | [claro.data.ops :as ops] 7 | [claro.projection :as projection] 8 | [claro.engine :as engine] 9 | [manifold.deferred :as d])) 10 | 11 | (defgoal deep-projection 12 | "Resolution of an infinite tree of resolvables, using projection.") 13 | 14 | ;; ## Fixtures 15 | 16 | (defrecord Person [id] 17 | data/Resolvable 18 | data/BatchedResolvable 19 | (resolve-batch! [_ _ people] 20 | (d/future 21 | (->> (map :id people) 22 | (fetch-people!) 23 | (map 24 | (fn [{:keys [friend-ids] :as person}] 25 | (assoc person :friends (map ->Person friend-ids)))))))) 26 | 27 | (defn- make-template 28 | [depth] 29 | (if (zero? depth) 30 | {} 31 | {:id projection/leaf 32 | :name projection/leaf 33 | (projection/alias :first-friend :friends) 34 | (projection/prepare 35 | ops/first 36 | (make-template (dec depth)))})) 37 | 38 | (defn- make-value 39 | [id depth] 40 | (-> (->Person id) 41 | (projection/apply 42 | (make-template depth)))) 43 | 44 | (def run!! 45 | (comp deref (engine/engine {:max-cost 1024}))) 46 | 47 | ;; ## Cases 48 | 49 | (let [value (make-value 1 255)] 50 | (defcase deep-projection :projection-depth-256 51 | [] 52 | (run!! value))) 53 | 54 | (let [value (make-value 1 511)] 55 | (defcase deep-projection :projection-depth-512 56 | [] 57 | (run!! value))) 58 | 59 | (let [value (make-value 1 1023)] 60 | (defcase deep-projection :projection-depth-1024 61 | [] 62 | (run!! value))) 63 | -------------------------------------------------------------------------------- /benchmarks/claro/projection_benchmarks/sequential.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection-benchmarks.sequential 2 | (:require [perforate.core :refer [defgoal defcase]] 3 | [claro.queries :refer :all] 4 | [claro.data :as data] 5 | [claro.data.ops :as ops] 6 | [claro.projection :as projection] 7 | [claro.engine :as engine] 8 | [manifold.deferred :as d])) 9 | 10 | (defgoal sequential-projection 11 | "Resolution of a projection on a sequential value.") 12 | 13 | ;; ## Fixtures 14 | 15 | (defrecord Person [id] 16 | data/Resolvable 17 | data/BatchedResolvable 18 | (resolve-batch! [_ _ people] 19 | (d/future 20 | (->> (map :id people) 21 | (fetch-people!) 22 | (map 23 | (fn [{:keys [friend-ids] :as person}] 24 | (assoc person :friends (map ->Person friend-ids)))))))) 25 | 26 | (def run!! 27 | (comp deref (engine/engine))) 28 | 29 | (def people-with-friends 30 | [{:id projection/leaf 31 | :name projection/leaf 32 | :friends [{:id projection/leaf}]}]) 33 | 34 | (def people 35 | (mapv ->Person (range 1 4096))) 36 | 37 | ;; ## Testcases 38 | 39 | (let [value (projection/apply (list* people) people-with-friends)] 40 | (defcase sequential-projection :list 41 | [] 42 | (run!! value))) 43 | 44 | (let [value (projection/apply (vec people) people-with-friends)] 45 | (defcase sequential-projection :vector 46 | [] 47 | (run!! value))) 48 | -------------------------------------------------------------------------------- /benchmarks/claro/projection_benchmarks/union.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection-benchmarks.union 2 | (:require [perforate.core :refer [defgoal defcase]] 3 | [claro.queries :refer :all] 4 | [claro.data :as data] 5 | [claro.data.ops :as ops] 6 | [claro.projection :as projection] 7 | [claro.engine :as engine] 8 | [manifold.deferred :as d])) 9 | 10 | (defgoal union-projection 11 | "Resolution of multiple map projections with subsequent merge.") 12 | 13 | ;; ## Fixtures 14 | 15 | (defrecord Person [id] 16 | data/Resolvable 17 | data/BatchedResolvable 18 | (resolve-batch! [_ _ people] 19 | (d/future 20 | (->> (map :id people) 21 | (fetch-people!) 22 | (map 23 | (fn [{:keys [friend-ids] :as person}] 24 | (assoc person :friends (map ->Person friend-ids)))))))) 25 | 26 | (def run!! 27 | (comp deref (engine/engine {:max-cost 1024}))) 28 | 29 | ;; ## Values 30 | 31 | (def person-with-direct-projection 32 | (projection/apply 33 | (->Person 1) 34 | {:id projection/leaf 35 | :name projection/leaf 36 | :friends [{:id projection/leaf}]})) 37 | 38 | (def person-with-single-union-projection 39 | (projection/apply 40 | (->Person 1) 41 | (projection/union 42 | {:id projection/leaf 43 | :name projection/leaf 44 | :friends [{:id projection/leaf}]}))) 45 | 46 | (def person-with-union-projection 47 | (projection/apply 48 | (->Person 1) 49 | (projection/union 50 | {:id projection/leaf} 51 | {:name projection/leaf} 52 | {:friends [{:id projection/leaf}]}))) 53 | 54 | (letfn [(make-template [depth] 55 | (if (zero? depth) 56 | {} 57 | (projection/union 58 | {:id projection/leaf 59 | :name projection/leaf} 60 | {(projection/alias :first-friend :friends) 61 | (projection/prepare 62 | ops/first 63 | (make-template (dec depth)))})))] 64 | (def person-with-deep-union-projection 65 | (projection/apply 66 | (->Person 1) 67 | (make-template 512)))) 68 | 69 | (assert (= (run!! person-with-direct-projection) 70 | (run!! person-with-single-union-projection) 71 | (run!! person-with-union-projection))) 72 | 73 | ;; ## Cases 74 | 75 | (defcase union-projection :direct-projection 76 | [] 77 | (run!! person-with-direct-projection)) 78 | 79 | (defcase union-projection :single-element-projection 80 | [] 81 | (run!! person-with-single-union-projection)) 82 | 83 | (defcase union-projection :multi-element-projection 84 | [] 85 | (run!! person-with-union-projection)) 86 | 87 | (defcase union-projection :deep-projection 88 | [] 89 | (run!! person-with-deep-union-projection)) 90 | -------------------------------------------------------------------------------- /benchmarks/claro/queries.clj: -------------------------------------------------------------------------------- 1 | (ns claro.queries) 2 | 3 | (def ^:private sleep 4 | (if-let [ms (some-> (System/getenv "CLARO_BENCHMARK_LATENCY") (Long.))] 5 | #(Thread/sleep ms) 6 | (constantly nil))) 7 | 8 | (defn fetch-person! 9 | [id] 10 | (sleep) 11 | {:id id 12 | :name (str "Person #" id) 13 | :image-id (* id 300) 14 | :friend-ids (range (inc id) (* id 10) (* 3 id))}) 15 | 16 | (defn fetch-image! 17 | [image-id] 18 | (sleep) 19 | (str "http://images.claro.de/" image-id ".png")) 20 | 21 | (defn fetch-images! 22 | [image-ids] 23 | (sleep) 24 | (map 25 | #(str "http://images.claro.de/" % ".png") 26 | image-ids)) 27 | 28 | (defn fetch-people! 29 | [person-ids] 30 | (sleep) 31 | (map 32 | (fn [id] 33 | {:id id 34 | :name (str "Person #" id) 35 | :image-id (* id 300) 36 | :friend-ids (range (inc id) (* id 10) (* 3 id))}) 37 | person-ids)) 38 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_with_batching.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-with-batching 2 | (:require [perforate.core :refer [defgoal defcase]])) 3 | 4 | ;; ## Testcase 5 | ;; 6 | ;; We'll model a three-level resolution for all candidates: 7 | ;; - resolve Person with :image-id and :friend-ids, 8 | ;; - resolve :friend-ids as a seq of [Person] 9 | ;; - resolve :image-id into an Image. 10 | 11 | (defgoal resolution-with-batching 12 | "Resolution of a finite tree of Resolvables (with batching).") 13 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_with_batching/assertion.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-with-batching.assertion 2 | (:require [claro.resolution-with-batching 3 | [muse :as muse] 4 | [urania :as urania] 5 | [claro :as claro]])) 6 | 7 | (let [fs {:muse muse/fetch-with-muse! 8 | :urania urania/fetch-with-urania! 9 | :claro claro/fetch-with-claro! 10 | :claro-and-projection claro/fetch-with-claro-and-projection!} 11 | results (->> (map (juxt key #((val %) 1)) fs) 12 | (partition-by second) 13 | (map #(map first %)))] 14 | (assert 15 | (= (count results) 1) 16 | (str "resolution returned different results. groups: " 17 | (pr-str results)))) 18 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_with_batching/claro.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-with-batching.claro 2 | (:require [perforate.core :refer [defcase]] 3 | [claro.resolution-with-batching :refer :all] 4 | [claro.queries :refer :all] 5 | 6 | ;; claro namespaces 7 | [claro.data :as data] 8 | [claro.data.ops :as ops] 9 | [claro.projection :as projection] 10 | [claro.engine :as engine] 11 | [manifold.deferred :as d])) 12 | 13 | ;; ## Claro 14 | 15 | (defrecord ClaroImage [id] 16 | data/Resolvable 17 | data/BatchedResolvable 18 | (resolve-batch! [_ _ images] 19 | (d/future 20 | (fetch-images! (map :id images))))) 21 | 22 | (defrecord ClaroPerson [id] 23 | data/Resolvable 24 | data/BatchedResolvable 25 | (resolve-batch! [_ _ people] 26 | (d/future 27 | (->> (map :id people) 28 | (fetch-people!) 29 | (map 30 | (fn [{:keys [image-id friend-ids] :as person}] 31 | (-> person 32 | (assoc :friends (map ->ClaroPerson friend-ids)) 33 | (assoc :image (->ClaroImage image-id))))))))) 34 | 35 | (defn fetch-with-claro! 36 | [id] 37 | (engine/run!! 38 | (-> (->ClaroPerson id) 39 | (ops/update 40 | :friends 41 | #(ops/map (fn [x] (dissoc x :friends)) %))))) 42 | 43 | (defcase resolution-with-batching :claro 44 | "Explicitly remove the nested ':friends' key to avoid infinite expansion." 45 | [] 46 | (fetch-with-claro! 1)) 47 | 48 | ;; ## Claro w/ Projection 49 | 50 | (defn fetch-with-claro-and-projection! 51 | [id] 52 | (engine/run!! 53 | (-> (->ClaroPerson id) 54 | (projection/apply 55 | {:id projection/leaf 56 | :name projection/leaf 57 | :image-id projection/leaf 58 | :friend-ids [projection/leaf] 59 | :image projection/leaf 60 | :friends [{:id projection/leaf 61 | :name projection/leaf 62 | :image-id projection/leaf 63 | :friend-ids [projection/leaf] 64 | :image projection/leaf}]})))) 65 | 66 | (defcase resolution-with-batching :claro-and-projection 67 | "Use a projection template to restrict the result tree to the desired shape." 68 | [] 69 | (fetch-with-claro-and-projection! 1)) 70 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_with_batching/muse.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-with-batching.muse 2 | (:require [perforate.core :refer [defcase]] 3 | [claro.resolution-with-batching :refer :all] 4 | [claro.queries :refer :all] 5 | 6 | ; muse namespaces 7 | [muse.core :as muse] 8 | [cats.core :as cats] 9 | [clojure.core.async :as async :refer [go > (->MusePerson id) 39 | (muse/flat-map 40 | (fn [{:keys [friend-ids image-id] :as person}] 41 | (muse/fmap 42 | #(assoc person :friends %1, :image %2) 43 | (muse/traverse 44 | (fn [{:keys [image-id] :as friend}] 45 | (muse/fmap #(assoc friend :image %) (->MuseImage image-id))) 46 | (muse/collect (map ->MusePerson friend-ids))) 47 | (->MuseImage image-id))))))) 48 | 49 | (defcase resolution-with-batching :muse 50 | "Build the desired result from (Muse) DataSources, " 51 | [] 52 | (fetch-with-muse! 1)) 53 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_with_batching/urania.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-with-batching.urania 2 | (:require [perforate.core :refer [defcase]] 3 | [claro.resolution-with-batching :refer :all] 4 | [claro.queries :refer :all] 5 | 6 | ; urania namespaces 7 | [urania.core :as u] 8 | [promesa.core :as prom])) 9 | 10 | ;; ## Urania 11 | 12 | (defrecord UraniaImage [id] 13 | u/DataSource 14 | (-identity [_] id) 15 | (-fetch [_ _] 16 | (prom/do* 17 | (fetch-image! id))) 18 | 19 | u/BatchedSource 20 | (-fetch-multi [_ images _] 21 | (prom/do* 22 | (let [ids (cons id (map :id images))] 23 | (zipmap ids (fetch-images! ids)))))) 24 | 25 | (defrecord UraniaPerson [id] 26 | u/DataSource 27 | (-identity [_] id) 28 | (-fetch [_ _] 29 | (prom/do* 30 | (fetch-person! id))) 31 | 32 | u/BatchedSource 33 | (-fetch-multi [_ people _] 34 | (prom/do* 35 | (let [ids (cons id (map :id people))] 36 | (zipmap ids (fetch-people! ids)))))) 37 | 38 | (defn fetch-with-urania! 39 | [id] 40 | (u/run!! 41 | (->> (->UraniaPerson id) 42 | (u/mapcat 43 | (fn [{:keys [friend-ids image-id] :as person}] 44 | (u/map 45 | #(assoc person :friends %1, :image %2) 46 | (u/traverse 47 | (fn [{:keys [image-id] :as friend}] 48 | (u/map #(assoc friend :image %) (->UraniaImage image-id))) 49 | (u/collect (map ->UraniaPerson friend-ids))) 50 | (->UraniaImage image-id))))))) 51 | 52 | (defcase resolution-with-batching :urania 53 | "Build the desired result from DataSources, " 54 | [] 55 | (fetch-with-urania! 1)) 56 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_without_batching.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-without-batching 2 | (:require [perforate.core :refer [defgoal defcase]])) 3 | 4 | ;; ## Testcase 5 | ;; 6 | ;; We'll model a three-level resolution for all candidates: 7 | ;; - resolve Person with :image-id and :friend-ids, 8 | ;; - resolve :friend-ids as a seq of [Person] 9 | ;; - resolve :image-id into an Image. 10 | 11 | (defgoal resolution-without-batching 12 | "Resolution of a finite tree of Resolvables (without batching).") 13 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_without_batching/assertion.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-without-batching.assertion 2 | (:require [claro.resolution-without-batching 3 | [muse :as muse] 4 | [urania :as urania] 5 | [claro :as claro]])) 6 | 7 | (let [fs {:muse muse/fetch-with-muse! 8 | :urania urania/fetch-with-urania! 9 | :claro claro/fetch-with-claro! 10 | :claro-and-projection claro/fetch-with-claro-and-projection!} 11 | results (->> (map (juxt key #((val %) 1)) fs) 12 | (partition-by second) 13 | (map #(map first %)))] 14 | (assert 15 | (= (count results) 1) 16 | (str "resolution returned different results. groups: " 17 | (pr-str results)))) 18 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_without_batching/claro.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-without-batching.claro 2 | (:require [perforate.core :refer [defcase]] 3 | [claro.resolution-without-batching :refer :all] 4 | [claro.queries :refer :all] 5 | 6 | ;; claro namespaces 7 | [claro.data :as data] 8 | [claro.data.ops :as ops] 9 | [claro.projection :as projection] 10 | [claro.engine :as engine] 11 | [manifold.deferred :as d])) 12 | 13 | ;; ## Claro 14 | 15 | (defrecord ClaroImage [id] 16 | data/Resolvable 17 | (resolve! [_ _] 18 | (d/future 19 | (fetch-image! id)))) 20 | 21 | (defrecord ClaroPerson [id] 22 | data/Resolvable 23 | (resolve! [_ _] 24 | (d/future 25 | (let [{:keys [image-id friend-ids] :as person} (fetch-person! id)] 26 | (-> person 27 | (assoc :friends (map ->ClaroPerson friend-ids)) 28 | (assoc :image (->ClaroImage image-id))))))) 29 | 30 | (defn fetch-with-claro! 31 | [id] 32 | (engine/run!! 33 | (-> (->ClaroPerson id) 34 | (ops/update 35 | :friends 36 | #(ops/map (fn [x] (dissoc x :friends)) %))))) 37 | 38 | (defcase resolution-without-batching :claro 39 | "Explicitly remove the nested ':friends' key to avoid infinite expansion." 40 | [] 41 | (fetch-with-claro! 1)) 42 | 43 | ;; ## Claro w/ Projection 44 | 45 | (defn fetch-with-claro-and-projection! 46 | [id] 47 | (engine/run!! 48 | (-> (->ClaroPerson id) 49 | (projection/apply 50 | {:id projection/leaf 51 | :name projection/leaf 52 | :image-id projection/leaf 53 | :friend-ids [projection/leaf] 54 | :image projection/leaf 55 | :friends [{:id projection/leaf 56 | :name projection/leaf 57 | :image-id projection/leaf 58 | :friend-ids [projection/leaf] 59 | :image projection/leaf}]})))) 60 | 61 | (defcase resolution-without-batching :claro-and-projection 62 | "Use a projection template to restrict the result tree to the desired shape." 63 | [] 64 | (fetch-with-claro-and-projection! 1)) 65 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_without_batching/muse.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-without-batching.muse 2 | (:require [perforate.core :refer [defcase]] 3 | [claro.resolution-without-batching :refer :all] 4 | [claro.queries :refer :all] 5 | 6 | ; muse namespaces 7 | [muse.core :as muse] 8 | [clojure.core.async :as async :refer [go > (->MusePerson id) 26 | (muse/flat-map 27 | (fn [{:keys [friend-ids image-id] :as person}] 28 | (muse/fmap 29 | #(assoc person :friends %1, :image %2) 30 | (muse/traverse 31 | (fn [{:keys [image-id] :as friend}] 32 | (muse/fmap #(assoc friend :image %) (->MuseImage image-id))) 33 | (muse/collect (map ->MusePerson friend-ids))) 34 | (->MuseImage image-id))))))) 35 | 36 | (defcase resolution-without-batching :muse 37 | "Build the desired result from (Muse) DataSources, " 38 | [] 39 | (fetch-with-muse! 1)) 40 | -------------------------------------------------------------------------------- /benchmarks/claro/resolution_without_batching/urania.clj: -------------------------------------------------------------------------------- 1 | (ns claro.resolution-without-batching.urania 2 | (:require [perforate.core :refer [defcase]] 3 | [claro.resolution-without-batching :refer :all] 4 | [claro.queries :refer :all] 5 | 6 | ; urania namespaces 7 | [urania.core :as u] 8 | [promesa.core :as prom])) 9 | 10 | ;; ## Urania 11 | 12 | (defrecord UraniaImage [id] 13 | u/DataSource 14 | (-identity [_] id) 15 | (-fetch [_ _] 16 | (prom/do* 17 | (fetch-image! id)))) 18 | 19 | (defrecord UraniaPerson [id] 20 | u/DataSource 21 | (-identity [_] id) 22 | (-fetch [_ _] 23 | (prom/do* 24 | (fetch-person! id)))) 25 | 26 | (defn fetch-with-urania! 27 | [id] 28 | (u/run!! 29 | (->> (->UraniaPerson id) 30 | (u/mapcat 31 | (fn [{:keys [friend-ids image-id] :as person}] 32 | (u/map 33 | #(assoc person :friends %1, :image %2) 34 | (u/traverse 35 | (fn [{:keys [image-id] :as friend}] 36 | (u/map #(assoc friend :image %) (->UraniaImage image-id))) 37 | (u/collect (map ->UraniaPerson friend-ids))) 38 | (->UraniaImage image-id))))))) 39 | 40 | (defcase resolution-without-batching :urania 41 | "Build the desired result from DataSources, " 42 | [] 43 | (fetch-with-urania! 1)) 44 | -------------------------------------------------------------------------------- /doc/04-testing-and-debugging.md: -------------------------------------------------------------------------------- 1 | # Testing & Debugging 2 | 3 | Claro has a focus on introspectability and testability, so it offers some 4 | built-in ways of achieving both. 5 | 6 | ### Separation of Pure and Impure Logic 7 | 8 | As outlined in [Basic Resolution](00-basics.md), you should use two protocols to 9 | implement resolvables: 10 | 11 | - `Resolvable` for impure logic, like I/O. 12 | - `Transform` for pure logic, like transformations. 13 | 14 | So, instead of writing the following: 15 | 16 | ```clojure 17 | (defrecord Person [id] 18 | data/Resolvable 19 | (resolve! [_ env] 20 | (d/future 21 | (let [{:keys [friend-ids] :as person} (fetch-person! (:db env) id)] 22 | (-> person 23 | (assoc :friends (map ->Person friend-ids)) 24 | (dissoc :friend-ids)))))) 25 | ``` 26 | 27 | You should consider: 28 | 29 | ```clojure 30 | (defrecord Person [id] 31 | data/Resolvable 32 | (resolve! [_ env] 33 | (d/future 34 | (fetch-person! (:db env) id))) 35 | 36 | data/Transform 37 | (transform [_ {:keys [friend-ids] :as person}] 38 | (-> person 39 | (assoc :friends (map ->Person friend-ids)) 40 | (dissoc :friend-ids)))) 41 | ``` 42 | 43 | Sure, it's a bit more verbose – but it also allows you to separately test your 44 | transformation logic: 45 | 46 | ```clojure 47 | (deftest t-person-transform 48 | (let [result (data/transform (->Person 1) {:id 1, :friend-ids [1 2 3]})] 49 | (is (= 1 (:id result))) 50 | (is (every? #(instance? Person %) (:friends result))) 51 | ...)) 52 | ``` 53 | 54 | > __Note:__ While a similar result can surely be achieved by extracting each 55 | > transformation into a separately testable function, you cannot guarantee that 56 | > said function is really used by the `Resolvable`. 57 | 58 | ### Mocks 59 | 60 | Another advantage of the approach described in the previous section is the fact 61 | that you can easily mock the impure part of your `Resolvable` using 62 | [[wrap-mock]]. 63 | 64 | For example, to try out a projection on a `Person` record we could mock the 65 | respective query results: 66 | 67 | ```clojure 68 | (def run-engine 69 | (-> (engine/engine) 70 | (wrap-mock 71 | Person 72 | (fn [{:keys [id]} env] 73 | {:id id 74 | :name "Person" 75 | :friend-ids [(inc id)]})))) 76 | ``` 77 | 78 | Which lets us do: 79 | 80 | ```clojure 81 | (-> (->Person 1) 82 | (projection/apply {:friends [{:name projection/leaf}]}) 83 | (run-engine) 84 | (deref)) 85 | ``` 86 | 87 | Here's the thing: __Logic attached using the `Transform` protocol is still 88 | run__, so if you want to craft a subtree with certain properties you have to 89 | think about what query result conveys these properties. For instance, to produce 90 | a person that has an empty `:friends` key your datastore has to return an empty 91 | list of `:friend-ids`. 92 | 93 | Note that there is also [[wrap-mock-result]] which will skip transformations and 94 | just return whatever the function produces directly. 95 | 96 | ### Introspection 97 | 98 | The namespace [[claro.middleware.observe]] contains multiple middlewares that 99 | let you react to processing of single resolvables or resolvable batches, 100 | optionally using a predicate or list of classes. 101 | 102 | For example, to trace the result of every `Person` resolution, we could use: 103 | 104 | ```clojure 105 | (defn trace-resolution 106 | [input output] 107 | (locking *out* 108 | (prn input '-> output))) 109 | 110 | (def run-engine 111 | (-> (engine/engine) 112 | (wrap-observe-by-class [Person] trace-resolution))) 113 | ``` 114 | 115 | This will print a line every time we encounter a person. 116 | -------------------------------------------------------------------------------- /doc/99-notes.md: -------------------------------------------------------------------------------- 1 | # Implementation Notes 2 | 3 | ## Deeply Nested Structures 4 | 5 | Before any resolution happens, claro will analyze the value it was given to 6 | collect the initial set of resolvables. This means that the whole tree will be 7 | traversed recursively, resulting in the following points of note regarding very 8 | large trees: 9 | 10 | - the stack might overflow during inspection, 11 | - initial inspection, as well as subsequent application steps might show 12 | degrading performance. 13 | 14 | Real-world data should not exhibit excessive nesting, especially not before 15 | resolution, so while users should keep these points in mind, they most probably 16 | won't be affected by them. 17 | 18 | ## Interface vs. Protocol Implementation 19 | 20 | claro will only work with values implementing the `Resolvable` *interface* - 21 | which is automatically done when `claro.data/Resolvable` is used with 22 | `defrecord`, `deftype` or `reify`. This means that values that "earn" their 23 | resolvability via `extend-type` or `extend-protocol` will not be picked up. 24 | 25 | The reason for this is a huge performance gap between `satisfies?` (which has to 26 | create a list of all superclasses for a given value, then intersect it with all 27 | classes implementing a protocol) and `instance?` (which boils down to a simple 28 | reflection call). 29 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject claro "0.2.21-SNAPSHOT" 2 | :description "claro que sí" 3 | :url "https://github.com/xsc/claro" 4 | :license {:name "MIT License" 5 | :url "https://opensource.org/licenses/MIT" 6 | :year 2015 7 | :key "mit"} 8 | :dependencies [[org.clojure/clojure "1.8.0" :scope "provided"] 9 | [org.clojure/core.async "0.3.443" :scope "provided"] 10 | [potemkin "0.4.4"] 11 | [manifold "0.1.6"] 12 | [riddley "0.1.14"]] 13 | :profiles {:dev 14 | {:dependencies [[org.clojure/test.check "0.9.0"] 15 | [com.gfredericks/test.chuck "0.2.8"] 16 | [instaparse "1.4.8"]]} 17 | :benchmarks 18 | {:plugins [[perforate "0.3.4"]] 19 | :dependencies [[perforate "0.3.4"] 20 | [criterium "0.4.4"] 21 | [muse "0.4.3-alpha3" :exclusions [manifold]] 22 | [cats "0.4.0"] 23 | [org.clojure/core.async "0.3.443"] 24 | [funcool/urania "0.1.1"] 25 | [funcool/promesa "1.9.0"]] 26 | :source-paths ["benchmarks"] 27 | :perforate 28 | {:environments 29 | [{:name :comparison 30 | :namespaces [claro.resolution-without-batching.claro 31 | claro.resolution-without-batching.urania 32 | claro.resolution-without-batching.muse 33 | claro.resolution-without-batching.assertion 34 | claro.resolution-without-batching 35 | claro.resolution-with-batching.claro 36 | claro.resolution-with-batching.urania 37 | claro.resolution-with-batching.muse 38 | claro.resolution-with-batching.assertion 39 | claro.resolution-with-batching]} 40 | {:name :performance 41 | :namespaces [claro.resolution-without-batching.claro 42 | claro.resolution-with-batching.claro 43 | claro.projection-benchmarks.deep 44 | claro.projection-benchmarks.union]} 45 | {:name :tree 46 | :namespaces [claro.performance-benchmarks.wrap-tree 47 | claro.performance-benchmarks.apply-resolved-values]} 48 | {:name :projections 49 | :namespaces [claro.projection-benchmarks.deep 50 | claro.projection-benchmarks.sequential 51 | claro.projection-benchmarks.union]}]} 52 | :jvm-opts ^:replace ["-server" "-XX:+TieredCompilation"]} 53 | :codox 54 | {:dependencies [[org.clojure/tools.reader "1.1.0"] 55 | [codox-theme-rdash "0.1.2"]] 56 | :plugins [[lein-codox "0.10.3"]] 57 | :codox {:project {:name "claro"} 58 | :metadata {:doc/format :markdown} 59 | :themes [:rdash] 60 | :source-paths ["src"] 61 | :source-uri "https://github.com/xsc/claro/blob/master/{filepath}#L{line}" 62 | :namespaces [claro.data 63 | claro.data.ops 64 | claro.engine 65 | claro.engine.adapter 66 | claro.engine.selector 67 | #"^claro\.middleware\..*" 68 | claro.projection]}} 69 | :coverage {:plugins [[lein-cloverage "1.0.9"]] 70 | :dependencies [[org.clojure/tools.reader "1.1.0"]]}} 71 | :aliases {"codox" ["with-profile" "codox,dev" "codox"] 72 | "codecov" ["with-profile" "+coverage" "cloverage" "--codecov"]} 73 | :pedantic? :abort) 74 | -------------------------------------------------------------------------------- /src/claro/data.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data 2 | "Main protocols and functions for I/O abstraction. 3 | 4 | See [Basic Resolution][1] for details and examples. 5 | 6 | [1]: 00-basics.md 7 | " 8 | (:refer-clojure :exclude [partition-by]) 9 | (:require [claro.data protocols error transform] 10 | [potemkin :refer [import-vars]])) 11 | 12 | (import-vars 13 | [claro.data.protocols 14 | BatchedResolvable 15 | Cost 16 | Mutation 17 | PureResolvable 18 | Resolvable 19 | Transform 20 | Parameters 21 | Partition 22 | cost 23 | mutation? 24 | resolvable? 25 | batched-resolvable? 26 | pure-resolvable? 27 | resolve! 28 | resolve-batch! 29 | set-parameters 30 | partition-by 31 | transform] 32 | [claro.data.error 33 | collect-errors 34 | error 35 | error? 36 | error-message 37 | error-data 38 | unless-error-> 39 | unless-error->>] 40 | [claro.data.transform 41 | extend-list-transform 42 | extend-transform]) 43 | -------------------------------------------------------------------------------- /src/claro/data/error.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.error 2 | (:require [claro.data.protocols :as p])) 3 | 4 | ;; ## Record 5 | 6 | (deftype ResolutionError [message data] 7 | p/ResolvableTree 8 | (wrapped? [_] 9 | false) 10 | (processable? [_] 11 | true) 12 | (unwrap-tree [this] 13 | this) 14 | (resolved? [_] 15 | true) 16 | (resolvables* [_] 17 | []) 18 | (apply-resolved-values [this _] 19 | this)) 20 | 21 | (defmethod print-method ResolutionError 22 | [^ResolutionError value ^java.io.Writer writer] 23 | (.write writer "#")) 29 | 30 | ;; ## Constructor 31 | 32 | (defn ^{:added "0.2.1"} error 33 | "Generate a value representing a resolution error." 34 | [message & [data]] 35 | {:pre [(string? message) 36 | (or (nil? data) (map? data))]} 37 | (->ResolutionError message data)) 38 | 39 | (defn ^{:added "0.2.1"} error? 40 | "Check whether the given value represents a resolution error." 41 | [value] 42 | (instance? ResolutionError value)) 43 | 44 | (defn ^{:added "0.2.1"} error-message 45 | "Retrieve the message from the given [[error]] value." 46 | [^ResolutionError e] 47 | (.-message e)) 48 | 49 | (defn ^{:added "0.2.1"} error-data 50 | "Retrieve error data from the given [[error]] value." 51 | [^ResolutionError e] 52 | (.-data e)) 53 | 54 | (defn ^{:added "0.2.1"} collect-errors 55 | "Find all errors within the given value." 56 | [value] 57 | (->> (tree-seq coll? seq value) 58 | (filter error?))) 59 | 60 | (defmacro with-error? 61 | "Helper macro that short-circuits if `value` is an [[error]]." 62 | [value & body] 63 | `(let [v# ~value] 64 | (if (error? v#) 65 | v# 66 | (do ~@body)))) 67 | 68 | (defmacro ^{:added "0.2.9"} unless-error-> 69 | [value & body] 70 | (if-let [[f & rst] (seq body)] 71 | `(let [v# ~value] 72 | (if (error? v#) 73 | v# 74 | (unless-error-> (-> v# ~f) ~@rst))) 75 | value)) 76 | 77 | (defmacro ^{:added "0.2.9"} unless-error->> 78 | [value & body] 79 | (if-let [[f & rst] (seq body)] 80 | `(let [v# ~value] (if (error? v#) 81 | v# 82 | (unless-error->> (->> v# ~f) ~@rst))) 83 | value)) 84 | -------------------------------------------------------------------------------- /src/claro/data/ops.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops 2 | (:refer-clojure 3 | :exclude [assoc assoc-in drop first get get-in map nth 4 | select-keys take update update-in]) 5 | (:require [claro.data.ops 6 | collections 7 | fmap 8 | maps 9 | then] 10 | [potemkin :refer [import-vars]])) 11 | 12 | (import-vars 13 | [claro.data.ops.collections 14 | drop 15 | first 16 | map 17 | nth 18 | take] 19 | 20 | [claro.data.ops.fmap 21 | fmap 22 | fmap-on 23 | fmap!] 24 | 25 | [claro.data.ops.maps 26 | assoc 27 | assoc-in 28 | get 29 | get-in 30 | select-keys 31 | update 32 | update-in] 33 | 34 | [claro.data.ops.then 35 | on 36 | then 37 | then!]) 38 | -------------------------------------------------------------------------------- /src/claro/data/ops/chain.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.chain 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.tree 4 | [blocking-composition :refer [->BlockingComposition]] 5 | [composition :as composition :refer [->ResolvableComposition]] 6 | [leaf :refer [->ResolvableLeaf]]] 7 | [claro.data.tree :refer [wrap-tree]])) 8 | 9 | ;; ## Resolved Node 10 | 11 | (deftype ResolvedComposition [value f] 12 | p/ResolvableTree 13 | (wrapped? [_] 14 | true) 15 | (processable? [_] 16 | false) 17 | (resolvables* [_] 18 | (throw 19 | (IllegalStateException. 20 | "'ResolvedComposition' should never be inspected. This is a bug."))) 21 | (unwrap-tree [_] 22 | (f (p/unwrap-tree value)))) 23 | 24 | ;; ## Chains 25 | 26 | (defn- chain-resolvable-when 27 | [value predicate f] 28 | (when (p/resolvable? value) 29 | (->ResolvableComposition (->ResolvableLeaf value) predicate f))) 30 | 31 | (defn- chain-tree-when 32 | [value predicate f] 33 | (let [tree (wrap-tree value) 34 | value' (composition/match-value tree predicate ::none)] 35 | (if (= value' ::none) 36 | (->ResolvableComposition tree predicate f) 37 | (->ResolvedComposition value' f)))) 38 | 39 | (defn chain-when 40 | "Apply the given function to the (potentially not fully-resolved) value 41 | once `predicate` is fulfilled." 42 | [value predicate f] 43 | (let [f' (comp wrap-tree f)] 44 | (or (chain-resolvable-when value predicate f') 45 | (chain-tree-when value predicate f')))) 46 | 47 | (defn chain-blocking* 48 | "Apply the given function once `value` is fully resolved. `f` is not allowed 49 | to introduce any futher resolvables, or has to wrap the result using 50 | `wrap-tree`." 51 | [value f] 52 | (if (p/resolvable? value) 53 | (->BlockingComposition (->ResolvableLeaf value) f) 54 | (let [tree (wrap-tree value)] 55 | (if (p/resolved? tree) 56 | (->ResolvedComposition tree f) 57 | (->BlockingComposition tree f))))) 58 | 59 | (defn chain-blocking 60 | "Apply the given function once `value` is fully resolved." 61 | [value f] 62 | (chain-blocking* value (comp wrap-tree f))) 63 | 64 | (defn chain-eager 65 | "Apply the given function once the value is no longer a `Resolvable` or 66 | wrapped." 67 | [value f] 68 | (chain-when value nil f)) 69 | -------------------------------------------------------------------------------- /src/claro/data/ops/collections.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.collections 2 | (:refer-clojure :exclude [drop first map nth take]) 3 | (:require [claro.data.ops.chain :as chain] 4 | [claro.data.ops.fmap :refer [fmap*]] 5 | [claro.data.protocols :as p] 6 | [clojure.core :as core])) 7 | 8 | ;; ## Helper 9 | 10 | (defn- assert-coll 11 | [value msg pred] 12 | (assert (or (nil? value) (coll? value)) (str msg "\n" (pr-str value))) 13 | (when pred 14 | (assert (pred value) (str msg "\n" (pr-str value))))) 15 | 16 | (defn- wrap-assert-coll 17 | ([f msg] 18 | (wrap-assert-coll f nil msg)) 19 | ([f pred msg] 20 | (fn [value] 21 | (assert-coll value msg pred) 22 | (f value)))) 23 | 24 | ;; ## Map 25 | 26 | (defn map-single 27 | "Iterate the given function over every element of the given, potentially 28 | partially resolved value. The collection type might not be maintained." 29 | [f sq] 30 | (->> (fn [sq] 31 | (core/mapv #(chain/chain-eager % f) sq)) 32 | (chain/chain-eager sq))) 33 | 34 | (defn map 35 | "Iterate the given function over every element of the given, potentially 36 | partially resolved values. The collection type might not be maintained." 37 | [f & sq] 38 | (if (next sq) 39 | (let [rechain #(fmap* f %&)] 40 | (chain/chain-when 41 | (vec sq) 42 | (wrap-assert-coll 43 | p/every-processable? 44 | "can only apply 'map' to collections, given:") 45 | #(core/apply core/mapv rechain %))) 46 | (map-single f (core/first sq)))) 47 | 48 | ;; ## Element Access 49 | 50 | (defn first 51 | "Get the first element of the given resolvable." 52 | [value] 53 | (chain/chain-eager 54 | value 55 | (wrap-assert-coll 56 | core/first 57 | "can only apply 'first' to collections, given:"))) 58 | 59 | (defn nth 60 | "Get the nth element of the given resolvable." 61 | [value n] 62 | (chain/chain-when 63 | [value n] 64 | p/every-processable? 65 | (wrap-assert-coll 66 | (fn [[v n]] 67 | (try 68 | (core/nth v n) 69 | (catch java.lang.IndexOutOfBoundsException e 70 | (throw 71 | (IllegalArgumentException. 72 | (format 73 | (str "index %d out of bounds when calling 'nth'.%n" 74 | "resolvable: %s%n" 75 | "collection: %s") 76 | n 77 | (pr-str value) 78 | (pr-str v)) 79 | e))))) 80 | sequential? 81 | "can only apply 'nth' to sequentials, given:"))) 82 | 83 | ;; ## Take/Drop 84 | 85 | (defn take 86 | "Get first n elements of the given resolvable." 87 | [n value] 88 | (chain/chain-when 89 | [value n] 90 | p/every-processable? 91 | (wrap-assert-coll 92 | (fn [[v n]] 93 | (core/take n v)) 94 | "can only apply 'take' to sequentials, given:"))) 95 | 96 | (defn drop 97 | "Drop first n elements of the given resolvable." 98 | [n value] 99 | (chain/chain-when 100 | [value n] 101 | p/every-processable? 102 | (wrap-assert-coll 103 | (fn [[v n]] 104 | (core/drop n v)) 105 | "can only apply 'drop' to sequentials, given:"))) 106 | -------------------------------------------------------------------------------- /src/claro/data/ops/fmap.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.fmap 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.ops.chain :as chain])) 4 | 5 | (defn fmap* 6 | "Apply the given function to the given, potentially partially resolved 7 | seq of values." 8 | [f values] 9 | (chain/chain-when 10 | (vec values) 11 | p/every-processable? 12 | #(apply f %))) 13 | 14 | (defn fmap 15 | "Apply the given function to the given, potentially partially resolved 16 | values." 17 | [f & values] 18 | (fmap* f values)) 19 | 20 | (defn fmap-on 21 | "Apply the given function to the given, potentially partially resolved 22 | values once the given `predicate` is fulfilled. Note that the predicate 23 | has to have an arity matching the number of values." 24 | [predicate f & values] 25 | (chain/chain-when 26 | (vec values) 27 | (fn [values] 28 | (and (p/every-processable? values) 29 | (apply predicate values))) 30 | #(apply f %))) 31 | 32 | (defn fmap! 33 | "Apply the given function to the given values once they are fully resolved." 34 | [f & values] 35 | (chain/chain-blocking 36 | (vec values) 37 | #(apply f %))) 38 | -------------------------------------------------------------------------------- /src/claro/data/ops/maps.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.maps 2 | (:refer-clojure :exclude [select-keys update update-in 3 | assoc assoc-in get get-in]) 4 | (:require [claro.data.protocols :as p] 5 | [claro.data.tree :refer [wrap-tree]] 6 | [claro.data.ops.chain :as chain] 7 | [clojure.core :as core])) 8 | 9 | ;; ## Helpers 10 | 11 | (defn- assert-map 12 | [value msg] 13 | (assert (or (nil? value) (map? value)) (str msg "\n" (pr-str value)))) 14 | 15 | (defn- wrap-assert-map 16 | [f msg] 17 | (fn [value] 18 | (assert-map value msg) 19 | (f value))) 20 | 21 | ;; ## Map Operations 22 | 23 | ;; ### Selection 24 | 25 | (defn select-keys 26 | "Wrap the given value to select only the given keys once they are available." 27 | [value ks] 28 | (chain/chain-eager 29 | value 30 | (wrap-assert-map 31 | #(core/select-keys % ks) 32 | "can only apply 'select-keys' to resolvables producing maps, given:"))) 33 | 34 | ;; ### Update 35 | 36 | (defn update 37 | "Wrap the given value to perform an update on a key once it's available." 38 | [value k f & args] 39 | (let [f #(apply f % args)] 40 | (chain/chain-eager 41 | value 42 | (wrap-assert-map 43 | (fn [value] 44 | (core/update value k chain/chain-eager f)) 45 | "can only apply 'update' to resolvables producing maps, given:")))) 46 | 47 | (defn update-in 48 | "Wrap the given value to perform an update on a nested key once it's 49 | available." 50 | [value [k & rst] f & args] 51 | (let [f #(apply f % args)] 52 | (if (empty? rst) 53 | (update value k f) 54 | (chain/chain-eager 55 | value 56 | (wrap-assert-map 57 | #(core/update % k update-in rst f) 58 | "can only apply 'update-in' to resolvables producing maps, given:"))))) 59 | 60 | ;; ### Assoc 61 | 62 | (defn assoc 63 | "Assoc the given value into the given resolvable once it was resolved to a 64 | map." 65 | [value k v] 66 | (chain/chain-eager 67 | value 68 | (wrap-assert-map 69 | #(core/assoc % k v) 70 | "can only apply 'assoc' to resolvables producing maps, given:"))) 71 | 72 | (defn assoc-in 73 | "Assoc the given value into the given resolvable, once the value at 74 | the given path was resolved to a map." 75 | [value ks v] 76 | (if (next ks) 77 | (let [path (butlast ks) 78 | k (last ks)] 79 | (update-in value path #(assoc % k v))) 80 | (assoc value (first ks) v))) 81 | 82 | ;; ## Get 83 | 84 | (defn get 85 | ([value k] (get value k nil)) 86 | ([value k default] 87 | (chain/chain-eager 88 | value 89 | (wrap-assert-map 90 | #(core/get % k default) 91 | "can only apply 'get' to resolvables producing maps, given:")))) 92 | 93 | (defn get-in 94 | ([value ks] (get-in value ks nil)) 95 | ([value ks default] 96 | {:pre [(seq ks)]} 97 | (let [k (first ks)] 98 | (if-let [ks' (next ks)] 99 | (chain/chain-eager 100 | value 101 | (wrap-assert-map 102 | #(get-in (get % k) ks' default) 103 | "can only apply 'get-in' to resolvables producing maps, given:")) 104 | (get value k default))))) 105 | -------------------------------------------------------------------------------- /src/claro/data/ops/then.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.then 2 | (:require [claro.data.ops.chain :as chain])) 3 | 4 | (defn then 5 | "Wrap the given value with a processing function that gets called the moment 6 | the given value is neither a `Resolvable` nor wrapped." 7 | [value f & args] 8 | (chain/chain-eager value #(apply f % args))) 9 | 10 | (defn then! 11 | "Wrap the given value with a processing function that gets called once the 12 | value has been fully resolved. 13 | 14 | Only use this for guaranteed finite expansion!" 15 | [value f & args] 16 | (chain/chain-blocking value #(apply f % args))) 17 | 18 | (defn on 19 | "Wrap the given value with a processing function that gets called 20 | the moment the given value is neither a `Resolvable` nor wrapped, 21 | plus fulfills the given `predicate`." 22 | [value predicate f & args] 23 | (chain/chain-when value predicate #(apply f % args))) 24 | -------------------------------------------------------------------------------- /src/claro/data/transform.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.transform 2 | (:require [claro.data.protocols :as p])) 3 | 4 | (defmacro ^{:added "0.2.7"} extend-list-transform 5 | "Implement the [[Transform]] protocol for the given `resolvable-class`, 6 | assuming it returns a seq of elements to-be-processed with 7 | `element-constructor`. 8 | 9 | ```clojure 10 | (extend-list-transform 11 | PeopleByLocation 12 | [->Person]) 13 | ``` 14 | 15 | This is equivalent to: 16 | 17 | ```clojure 18 | (extend-protocol claro.data/Transform 19 | PeopleByLocation 20 | (transform [_ results] 21 | (mapv ->Person results))) 22 | ``` 23 | 24 | It's also possible to supply extra parameters to be passed to the element 25 | constructor, e.g.: 26 | 27 | ```clojure 28 | (extend-list-transform 29 | PeopleByLocation 30 | [->Person {:by :location}]) 31 | ``` 32 | 33 | This will call `(->Person element {:by :location})` on each element." 34 | ([resolvable-class [element-constructor & args]] 35 | {:pre [resolvable-class element-constructor]} 36 | `(let [constructor# #(~element-constructor % ~@args)] 37 | (extend-protocol p/Transform 38 | ~resolvable-class 39 | (~'transform [_# elements#] 40 | (mapv constructor# elements#))))) 41 | ([resolvable-class element-constructor & more] 42 | `(do 43 | (extend-list-transform ~resolvable-class ~element-constructor) 44 | (extend-list-transform ~@more)))) 45 | 46 | (defmacro ^{:added "0.2.7"} extend-transform 47 | "Implement the [[Transform]] protocol for the given `resolvable-class` by 48 | transforming/renaming fields according to a given field spec. 49 | 50 | ```clojure 51 | (extend-transform 52 | Person 53 | {:pet [->Pet :pet-id] 54 | :location (fn [{:keys [latitude longitude]}] 55 | (->Location latitude longitude)) 56 | :name :username}) 57 | ``` 58 | 59 | This will: 60 | 61 | - create `:pet` as `(->Pet (:pet-id result))`, 62 | - create `:location` as the result of the given function, and 63 | - copy `:username` to `:name`. 64 | 65 | All these take the resolution result (!) as input but will not alter `nil` 66 | values." 67 | ([resolvable-class fields] 68 | {:pre [resolvable-class (map? fields)]} 69 | (letfn [(->fn [[field-key value]] 70 | (let [result (gensym "result")] 71 | (cond (vector? value) 72 | (let [[f & fields] value] 73 | `(fn [~result] 74 | (assoc ~result 75 | ~field-key 76 | (~f ~@(map #(list % result) fields))))) 77 | 78 | (keyword? value) 79 | `(fn [~result] 80 | (assoc ~result 81 | ~field-key 82 | (get ~result ~value))) 83 | 84 | :else 85 | `(let [f# ~value] 86 | (fn [~result] 87 | (assoc ~result 88 | ~field-key 89 | (f# ~result)))))))] 90 | `(let [transform# (comp ~@(map ->fn fields))] 91 | (extend-protocol p/Transform 92 | ~resolvable-class 93 | (~'transform [_# result#] 94 | (some-> result# transform#)))))) 95 | ([resolvable-class fields & more] 96 | `(do 97 | (extend-transform ~resolvable-class ~fields) 98 | (extend-transform ~@more)))) 99 | -------------------------------------------------------------------------------- /src/claro/data/tree.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.tree 4 | [collection :as collection] 5 | [map :as map] 6 | [leaf :as leaf] 7 | [object]] 8 | [potemkin :refer [defprotocol+]])) 9 | 10 | ;; ## Logic 11 | 12 | (defprotocol+ ^:private TreeWrapper 13 | (wrap-tree [value])) 14 | 15 | (defn transform-partial 16 | [value f] 17 | (-> value 18 | (p/partial-value nil) 19 | (f) 20 | (wrap-tree))) 21 | 22 | ;; ## Collections 23 | 24 | (defn- collection->tree 25 | [c] 26 | (if-not (empty? c) 27 | (let [prototype (empty c)] 28 | (collection/make wrap-tree #(into prototype %) c)) 29 | c)) 30 | 31 | (defn- vector->tree 32 | [v] 33 | (if-not (empty? v) 34 | (collection/make wrap-tree identity v) 35 | v)) 36 | 37 | (defn- set->tree 38 | [s] 39 | (if-not (empty? s) 40 | (collection/make wrap-tree set s) 41 | s)) 42 | 43 | (defn- list->tree 44 | [l] 45 | (if-not (empty? l) 46 | (collection/make wrap-tree list* l) 47 | l)) 48 | 49 | ;; ## Maps 50 | 51 | (defn- reassemble-record 52 | [record keys vals] 53 | (into record (map vector keys vals))) 54 | 55 | (defn- record->tree 56 | [record] 57 | (map/make 58 | wrap-tree 59 | #(reassemble-record record %1 %2) 60 | record)) 61 | 62 | (defn- map->tree 63 | [m] 64 | (map/make wrap-tree zipmap m)) 65 | 66 | ;; ## Wrappers 67 | 68 | (extend-protocol TreeWrapper 69 | clojure.lang.IPersistentMap 70 | (wrap-tree [value] 71 | (cond (p/resolvable? value) (leaf/make value) 72 | (record? value) (record->tree value) 73 | :else (map->tree value))) 74 | 75 | clojure.lang.IPersistentVector 76 | (wrap-tree [value] 77 | (vector->tree value)) 78 | 79 | clojure.lang.IPersistentSet 80 | (wrap-tree [value] 81 | (set->tree value)) 82 | 83 | clojure.lang.IPersistentList 84 | (wrap-tree [value] 85 | (list->tree value)) 86 | 87 | clojure.lang.ISeq 88 | (wrap-tree [value] 89 | (list->tree value)) 90 | 91 | clojure.lang.IPersistentCollection 92 | (wrap-tree [value] 93 | (collection->tree value)) 94 | 95 | Object 96 | (wrap-tree [value] 97 | (let [value' (p/unwrap-tree value)] 98 | (cond (p/resolvable? value') 99 | (leaf/make value') 100 | 101 | (identical? value value') 102 | value 103 | 104 | :else 105 | (wrap-tree value')))) 106 | 107 | nil 108 | (wrap-tree [_] 109 | nil)) 110 | -------------------------------------------------------------------------------- /src/claro/data/tree/blocking_composition.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.blocking-composition 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.error :refer [error?]]) 4 | (:import [claro.data.protocols ResolvableTree ])) 5 | 6 | (deftype BlockingComposition [tree f] 7 | ResolvableTree 8 | (wrapped? [this] 9 | true) 10 | (processable? [this] 11 | false) 12 | (unwrap-tree [this] 13 | this) 14 | (partial-value [_ no-partial] 15 | no-partial) 16 | (resolved? [_] 17 | false) 18 | (resolvables* [_] 19 | (p/resolvables* tree)) 20 | (apply-resolved-values [this resolvable->value] 21 | (let [tree' (p/apply-resolved-values tree resolvable->value)] 22 | (cond (= tree tree') this 23 | (error? tree') tree' 24 | (p/resolved? tree') (-> tree' f) 25 | :else (BlockingComposition. tree' f))))) 26 | 27 | (defmethod print-method BlockingComposition 28 | [^BlockingComposition value ^java.io.Writer writer] 29 | (.write writer "<< ") 30 | (print-method (.-tree value) writer) 31 | (.write writer " => ... >>")) 32 | -------------------------------------------------------------------------------- /src/claro/data/tree/collection.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.collection 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.tree.tuple :as tuple]) 4 | (:import [claro.data.protocols ResolvableTree])) 5 | 6 | ;; ## Tree Type 7 | 8 | (deftype ResolvableCollection [prototype tuple] 9 | ResolvableTree 10 | (wrapped? [_] 11 | false) 12 | (processable? [_] 13 | false) 14 | (resolved? [_] 15 | false) 16 | (unwrap-tree [tree] 17 | tree) 18 | (partial-value [_ _] 19 | (prototype (p/partial-value tuple ::none))) 20 | (resolvables* [_] 21 | (p/resolvables* tuple)) 22 | (apply-resolved-values [tree resolvable->values] 23 | (let [tuple' (p/apply-resolved-values tuple resolvable->values)] 24 | (if (p/resolved? tuple') 25 | (prototype tuple') 26 | (ResolvableCollection. prototype tuple'))))) 27 | 28 | (defmethod print-method ResolvableCollection 29 | [^ResolvableCollection value ^java.io.Writer writer] 30 | (print-method (p/partial-value value ::none) writer)) 31 | 32 | ;; ## Constructor 33 | 34 | (defn make 35 | [wrap-fn prototype elements] 36 | (let [tuple (tuple/make wrap-fn elements)] 37 | (if (p/resolved? tuple) 38 | (prototype tuple) 39 | (ResolvableCollection. prototype tuple)))) 40 | -------------------------------------------------------------------------------- /src/claro/data/tree/composition.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.composition 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.error :refer [error?]]) 4 | (:import [claro.data.protocols ResolvableTree])) 5 | 6 | ;; ## Helper 7 | 8 | (defn- throw-resolved-without-predicate! 9 | [value predicate] 10 | (throw 11 | (IllegalStateException. 12 | (format "predicate %s does not hold for fully resolved: %s" 13 | (pr-str predicate) 14 | (pr-str value))))) 15 | 16 | (defn- match-simple-value 17 | [value predicate no-match] 18 | (if (or (not predicate) 19 | (predicate value)) 20 | value 21 | no-match)) 22 | 23 | (defn- match-resolved-value 24 | [value predicate no-match] 25 | (let [result (match-simple-value value predicate no-match)] 26 | (if (not= result no-match) 27 | result 28 | (throw-resolved-without-predicate! value predicate)))) 29 | 30 | (defn- match-partial-value 31 | [value predicate no-match] 32 | (let [value' (p/partial-value value ::none)] 33 | (if (and (not= value' ::none) 34 | (not (p/resolvable? value'))) 35 | (match-simple-value value' predicate no-match) 36 | no-match))) 37 | 38 | (defn match-value 39 | [value predicate no-match] 40 | (cond (or (p/resolvable? value) 41 | (p/wrapped? value)) 42 | no-match 43 | 44 | (p/resolved? value) 45 | (match-resolved-value value predicate no-match) 46 | 47 | :else 48 | (let [value (match-partial-value value predicate ::none)] 49 | (if (not= value ::none) 50 | value 51 | no-match)))) 52 | 53 | ;; ## Resolvable Node 54 | 55 | (deftype ResolvableComposition [tree predicate f] 56 | ResolvableTree 57 | (wrapped? [this] 58 | true) 59 | (processable? [this] 60 | false) 61 | (unwrap-tree [this] 62 | this) 63 | (partial-value [_ no-partial] 64 | no-partial) 65 | (resolved? [_] 66 | false) 67 | (resolvables* [_] 68 | (p/resolvables* tree)) 69 | (apply-resolved-values [this resolvable->value] 70 | (let [tree' (p/apply-resolved-values tree resolvable->value)] 71 | (cond (error? tree') 72 | tree' 73 | 74 | (identical? tree tree') 75 | this 76 | 77 | :else 78 | (let [value (match-value tree' predicate ::none)] 79 | (if (not= value ::none) 80 | (f value) 81 | (ResolvableComposition. tree' predicate f))))))) 82 | 83 | (defmethod print-method ResolvableComposition 84 | [^ResolvableComposition value ^java.io.Writer writer] 85 | (.write writer "<< ") 86 | (print-method (.-tree value) writer) 87 | (.write writer " => ... >>")) 88 | -------------------------------------------------------------------------------- /src/claro/data/tree/leaf.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.leaf 2 | (:require [claro.data.protocols :as p]) 3 | (:import [claro.data.protocols ResolvableTree])) 4 | 5 | (deftype ResolvableLeaf [resolvable] 6 | ResolvableTree 7 | (wrapped? [_] 8 | false) 9 | (processable? [_] 10 | false) 11 | (unwrap-tree [this] 12 | this) 13 | (partial-value [this _] 14 | (.-resolvable this)) 15 | (resolved? [_] 16 | false) 17 | (resolvables* [this] 18 | [(.-resolvable this)]) 19 | (apply-resolved-values [tree resolvable->resolved] 20 | (get resolvable->resolved (.-resolvable tree) tree))) 21 | 22 | (defmethod print-method ResolvableLeaf 23 | [^ResolvableLeaf value ^java.io.Writer writer] 24 | (print-method (.-resolvable value) writer)) 25 | 26 | (defn make 27 | [value] 28 | (->ResolvableLeaf value)) 29 | -------------------------------------------------------------------------------- /src/claro/data/tree/map.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.map 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.tree 4 | [tuple :as tuple] 5 | [utils :as u]]) 6 | (:import [claro.data.protocols ResolvableTree])) 7 | 8 | ;; ## Collector 9 | 10 | (defn- collect-resolvables 11 | [keys-tuple vals-tuple] 12 | (into 13 | (vec (p/resolvables* keys-tuple)) 14 | (p/resolvables* vals-tuple))) 15 | 16 | ;; ## Tree Type 17 | 18 | (deftype ResolvableMap [constructor resolvables keys-tuple vals-tuple] 19 | ResolvableTree 20 | (wrapped? [_] 21 | false) 22 | (processable? [_] 23 | false) 24 | (resolved? [_] 25 | false) 26 | (unwrap-tree [tree] 27 | tree) 28 | (partial-value [_ _] 29 | (constructor 30 | (p/partial-value keys-tuple ::none) 31 | (p/partial-value vals-tuple ::none))) 32 | (resolvables* [tree] 33 | (.-resolvables tree)) 34 | (apply-resolved-values [tree resolvable->values] 35 | (let [keys-tuple' (u/apply-resolution keys-tuple resolvable->values) 36 | vals-tuple' (u/apply-resolution vals-tuple resolvable->values)] 37 | (if (and (p/resolved? keys-tuple') 38 | (p/resolved? vals-tuple')) 39 | (constructor keys-tuple' vals-tuple') 40 | (ResolvableMap. 41 | constructor 42 | (collect-resolvables keys-tuple' vals-tuple') 43 | keys-tuple' 44 | vals-tuple'))))) 45 | 46 | (defmethod print-method ResolvableMap 47 | [^ResolvableMap value ^java.io.Writer writer] 48 | (print-method (p/partial-value value ::none) writer)) 49 | 50 | ;; ## Constructor 51 | 52 | (defn- make-sub-tuple 53 | [resolvables elements] 54 | (if (zero? (count resolvables)) 55 | (persistent! elements) 56 | (tuple/->ResolvableTuple 57 | (persistent! resolvables) 58 | (persistent! elements)))) 59 | 60 | (defn make 61 | [wrap-fn constructor map-value] 62 | (if-not (empty? map-value) 63 | (loop [m (seq map-value) 64 | keys (transient []) 65 | vals (transient []) 66 | key-resolvables (transient []) 67 | val-resolvables (transient []) 68 | resolvables (transient [])] 69 | (cond m 70 | (let [e (first m) 71 | k (wrap-fn (key e)) 72 | v (wrap-fn (val e)) 73 | kr (p/resolvables* k) 74 | vr (p/resolvables* v)] 75 | (recur 76 | (next m) 77 | (conj! keys k) 78 | (conj! vals v) 79 | (reduce conj! key-resolvables kr) 80 | (reduce conj! val-resolvables vr) 81 | (as-> resolvables <> 82 | (reduce conj! <> kr) 83 | (reduce conj! <> vr)))) 84 | 85 | (zero? (count resolvables)) 86 | (constructor 87 | (persistent! keys) 88 | (persistent! vals)) 89 | 90 | :else 91 | (ResolvableMap. 92 | constructor 93 | (persistent! resolvables) 94 | (make-sub-tuple key-resolvables keys) 95 | (make-sub-tuple val-resolvables vals)))) 96 | {})) 97 | -------------------------------------------------------------------------------- /src/claro/data/tree/object.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.object 2 | (:require [claro.data.protocols :as p])) 3 | 4 | (extend-protocol p/ResolvableTree 5 | Object 6 | (wrapped? [_] 7 | false) 8 | (processable? [_] 9 | true) 10 | (unwrap-tree [this] 11 | this) 12 | (partial-value [tree _] 13 | tree) 14 | (resolved? [tree] 15 | true) 16 | (resolvables* [_] 17 | nil) 18 | (apply-resolved-values [tree _] 19 | tree) 20 | 21 | nil 22 | (wrapped? [_] 23 | false) 24 | (processable? [_] 25 | true) 26 | (unwrap-tree [_] 27 | nil) 28 | (partial-value [_ _] 29 | nil) 30 | (resolved? [_] 31 | true) 32 | (resolvables* [_] 33 | nil) 34 | (apply-resolved-values [_ _] 35 | nil)) 36 | -------------------------------------------------------------------------------- /src/claro/data/tree/tuple.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.tuple 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.tree.utils :as u]) 4 | (:import [claro.data.protocols ResolvableTree])) 5 | 6 | ;; ## Tree Type 7 | 8 | (deftype ResolvableTuple [resolvables elements] 9 | ResolvableTree 10 | (wrapped? [_] 11 | false) 12 | (processable? [_] 13 | false) 14 | (resolved? [_] 15 | false) 16 | (unwrap-tree [tree] 17 | tree) 18 | (partial-value [_ _] 19 | elements) 20 | (resolvables* [tree] 21 | (.-resolvables tree)) 22 | (apply-resolved-values [tree resolvable->value] 23 | (let [element-count (int (count elements))] 24 | (loop [elements (transient elements) 25 | resolvables (transient #{}) 26 | index (int 0)] 27 | (cond (< index element-count) 28 | (let [value (.nth ^clojure.lang.ITransientVector elements index) 29 | value' (u/apply-resolution value resolvable->value) 30 | resolvables' (p/resolvables* value')] 31 | (recur 32 | (assoc! elements index value') 33 | (reduce conj! resolvables resolvables') 34 | (inc index))) 35 | 36 | (zero? (count resolvables)) 37 | (persistent! elements) 38 | 39 | :else 40 | (ResolvableTuple. 41 | (vec (persistent! resolvables)) 42 | (persistent! elements))))))) 43 | 44 | ;; ## Constructor 45 | 46 | (defn make 47 | [wrap-fn elements] 48 | (if-not (empty? elements) 49 | (let [elements (into [] (map wrap-fn) elements) 50 | resolvables (into [] u/all-resolvables-xf elements)] 51 | (if-not (empty? resolvables) 52 | (ResolvableTuple. resolvables elements) 53 | elements)) 54 | [])) 55 | -------------------------------------------------------------------------------- /src/claro/data/tree/utils.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree.utils 2 | (:require [claro.data.protocols :as p])) 3 | 4 | (defn- can-resolve? 5 | [tree resolvable->resolved] 6 | (and (not (p/resolved? tree)) 7 | ;; it seems the following check is slower than just trying to apply the 8 | ;; resolution ... 9 | #_(some resolvable->resolved (p/resolvables tree)))) 10 | 11 | (defn apply-resolution 12 | [tree resolvable->resolved] 13 | (if (can-resolve? tree resolvable->resolved) 14 | (p/apply-resolved-values tree resolvable->resolved) 15 | tree)) 16 | 17 | (def all-resolvables-xf 18 | "Transducer to collect all resolvables in a seq of `ResolvableTree`values." 19 | (mapcat #(p/resolvables* %))) 20 | -------------------------------------------------------------------------------- /src/claro/engine.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.engine 2 | "Main resolution and engine logic. 3 | 4 | Claro's resolution engine is powerful and customizable, allowing for flexible 5 | introspection and manipulation of every resolution run. 6 | 7 | See the [Engine][1] documentation for details and examples. 8 | 9 | [1]: 03-engine.md 10 | " 11 | (:refer-clojure :exclude [run!]) 12 | (:require [claro.engine 13 | [core :as core] 14 | [adapter :as adapter] 15 | [multi :as multi] 16 | [selector :as selector] 17 | [protocols :as p]] 18 | #?(:clj [claro.runtime.impl.manifold :as default]) 19 | #?(:cljs [claro.runtime.impl.core-async :as default]) 20 | [potemkin :refer [import-vars]])) 21 | 22 | ;; ## Engine Constructors/Runners 23 | 24 | (def default-impl 25 | "The default deferred implementation used for resolution." 26 | default/impl) 27 | 28 | (def default-opts 29 | "The default engine options." 30 | {:env {} 31 | :selector selector/default-selector 32 | :adapter adapter/default-adapter 33 | :max-cost 32}) 34 | 35 | (def ^:private default-engine 36 | "The pre-prepared default engine." 37 | (core/build default-impl default-opts)) 38 | 39 | (defn engine 40 | "Create a new resolution engine, based on the following options: 41 | 42 | - `:env`: a value that is passed as the `env` parameter to `Resolvable`s' 43 | `resolve!` and `resolve-batch!` functions (default: `{}`), 44 | - `:adapter`: a function that will be called to run calls to `resolve!` and 45 | `resolve-batch!`, 46 | - `:selector`: a `claro.engine.selector/Selector` implementation used during 47 | each iteration to decide what to resolve next, 48 | - `:max-cost`: a value describing the maximum resolution cost for each run, 49 | causing the engine to throw an `IllegalStateException` (default: `32`) if 50 | exceeded, 51 | - `check-cost?`: a flag enabling/disabling cost protection (default: `true`). 52 | 53 | The resulting value's resolution behaviour can be wrapped using 54 | `claro.engine/wrap`." 55 | ([] default-engine) 56 | ([opts] 57 | (if (empty? opts) 58 | default-engine 59 | (engine default-impl opts))) 60 | ([impl opts] 61 | (core/build impl (merge default-opts opts)))) 62 | 63 | (defn multi-engine 64 | "Create a resolution engine that takes a seq of values and resolves them 65 | in-order and independently using the optionally given base engine. 66 | 67 | This is especially useful when resolving multiple mutations since the cache 68 | will be reset between runs." 69 | ([] 70 | (multi-engine default-engine)) 71 | ([base-engine] 72 | (multi/build base-engine))) 73 | 74 | (defn run! 75 | "Resolve the given value using an engine created on-the-fly. See 76 | `claro.engine/engine` for available options. Immediately returns a 77 | deferred." 78 | ([value] (default-engine value)) 79 | ([opts value] ((engine opts) value))) 80 | 81 | (defn run!! 82 | "Resolve the given value using an engine created on-the-fly. See 83 | `claro.engine/engine` for available options. Blocks until the resolved 84 | value has been obtained." 85 | ([value] @(default-engine value)) 86 | ([opts value] @(run! opts value))) 87 | 88 | ;; ## Middlewares 89 | 90 | (import-vars 91 | [claro.engine.core 92 | impl 93 | wrap 94 | wrap-transform 95 | wrap-pre-transform]) 96 | -------------------------------------------------------------------------------- /src/claro/engine/adapter.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.engine.adapter 2 | "Adapters can be used to remove asynchronous execution boilerplate or mediate 3 | between differen deferred implementations." 4 | (:require [claro.runtime.impl :as impl])) 5 | 6 | (defn default-adapter 7 | "This adapter expects `Resolvable` values to already return a deferrable 8 | value." 9 | [_ f] 10 | (f)) 11 | 12 | (defn sync-adapter 13 | "This adapter expects `Resolvable` values to resolve synchronously, wrapping 14 | them in asynchronous processing according to the given implementation." 15 | [impl f] 16 | (impl/run impl f)) 17 | -------------------------------------------------------------------------------- /src/claro/engine/multi.clj: -------------------------------------------------------------------------------- 1 | (ns claro.engine.multi 2 | (:require [claro.engine.core :as engine] 3 | [claro.runtime.impl :as impl])) 4 | 5 | ;; ## Ordered Resolution 6 | 7 | (defn- conj-and-recur 8 | [impl state result] 9 | (->> (-> state 10 | (update :result conj! result) 11 | (update :resolvables next)) 12 | (impl/recur impl))) 13 | 14 | (defn- resolve-next 15 | [{:keys [impl engine opts resolvables result] :as state}] 16 | (if-let [[r & rst] (seq resolvables)] 17 | (let [d (engine/run engine r opts)] 18 | (->> #(conj-and-recur impl state %) 19 | (impl/chain1 impl d))) 20 | (persistent! result))) 21 | 22 | (defn- resolve-ordered! 23 | [engine resolvables opts] 24 | {:pre [(sequential? resolvables)]} 25 | (let [impl (engine/impl engine)] 26 | (cond (next resolvables) 27 | (->> {:impl impl 28 | :engine engine 29 | :opts opts 30 | :resolvables resolvables, 31 | :result (transient [])} 32 | (impl/loop impl resolve-next)) 33 | 34 | (seq resolvables) 35 | (impl/chain1 36 | impl 37 | (engine/run engine (first resolvables) opts) 38 | vector) 39 | 40 | :else (impl/value impl [])))) 41 | 42 | ;; ## Engine 43 | 44 | (deftype MultiEngine [engine] 45 | engine/IEngine 46 | (wrap [_ wrap-fn] 47 | (MultiEngine. (engine/wrap engine wrap-fn))) 48 | (run [_ resolvables opts] 49 | (resolve-ordered! engine resolvables opts)) 50 | (impl [_] 51 | (engine/impl engine)) 52 | 53 | clojure.lang.IFn 54 | (invoke [this resolvable] 55 | (engine/run this resolvable {})) 56 | (invoke [this resolvable opts] 57 | (engine/run this resolvable opts))) 58 | 59 | ;; ## Builder 60 | 61 | (defn build 62 | "Create a new engine targeting in-order resolution of resolvables." 63 | [engine] 64 | (->MultiEngine engine)) 65 | -------------------------------------------------------------------------------- /src/claro/engine/protocols.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.engine.protocols) 2 | -------------------------------------------------------------------------------- /src/claro/engine/resolver.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.engine.resolver 2 | (:require [claro.runtime.impl :as impl] 3 | [claro.data 4 | [error :refer [error?]] 5 | [protocols :as p] 6 | [tree :refer [wrap-tree]]])) 7 | 8 | ;; ## Helpers 9 | 10 | (defn- result-as-map 11 | [batch result] 12 | (if (map? result) 13 | result 14 | (zipmap batch result))) 15 | 16 | (defn- map-kv 17 | [f m] 18 | (persistent! 19 | (reduce 20 | (fn [m e] 21 | (assoc! m (key e) (f (key e) (val e)))) 22 | (transient {}) 23 | m))) 24 | 25 | ;; ## Resolution 26 | 27 | (defn- resolve-them-all! 28 | [impl adapter env [head :as batch]] 29 | (cond (p/batched-resolvable? head) 30 | (adapter impl #(p/resolve-batch! head env batch)) 31 | 32 | (next batch) 33 | (let [deferreds (mapv 34 | (fn [item] 35 | (adapter impl #(p/resolve! item env))) 36 | batch)] 37 | (impl/zip impl deferreds)) 38 | 39 | :else 40 | (let [deferred (adapter impl #(p/resolve! head env))] 41 | (impl/chain1 impl deferred vector)))) 42 | 43 | (defn raw-resolve-fn 44 | "Generate a resolver function for `claro.runtime/run`, suitable for 45 | processing `claro.data.protocols/Resolvable` values." 46 | [impl adapter] 47 | {:pre [impl (fn? adapter)]} 48 | (fn [env batch] 49 | (impl/chain1 50 | impl 51 | (resolve-them-all! impl adapter env batch) 52 | #(result-as-map batch %)))) 53 | 54 | ;; ## Transformation 55 | 56 | (defn wrap-transform 57 | "Generate a function to be called after resolution, postprocessing the 58 | resolved value." 59 | [impl resolver] 60 | (let [transform-fn (fn [resolvable value] 61 | (if (error? value) 62 | value 63 | (p/transform resolvable value)))] 64 | (fn [env batch] 65 | (impl/chain1 66 | impl 67 | (resolver env batch) 68 | #(map-kv transform-fn %))))) 69 | 70 | ;; ## Finalisation 71 | 72 | (defn wrap-finalize 73 | "Generate a function to be called directly before the resolution result 74 | is cached." 75 | [impl resolver] 76 | (fn [env batch] 77 | (impl/chain1 78 | impl 79 | (resolver env batch) 80 | (fn [resolvable->value] 81 | (map-kv #(wrap-tree %2) resolvable->value))))) 82 | 83 | ;; ## Compound Resolver Function 84 | 85 | (defn build 86 | "Combine the given functions to generate a resolver function suitable for 87 | the claro runtime." 88 | [raw-resolve-fn wrappers] 89 | (reduce #(%2 %1) raw-resolve-fn wrappers)) 90 | -------------------------------------------------------------------------------- /src/claro/engine/selector.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.engine.selector 2 | "Selectors let you adjust and optimize the order of resolution on an engine 3 | or tree level. 4 | 5 | See the [Engine][1] documentation. 6 | 7 | [1]: 03-engine.md 8 | " 9 | (:require [potemkin :refer [defprotocol+]])) 10 | 11 | ;; ## Protocol 12 | 13 | (defprotocol+ Selector 14 | (instantiate [selector] 15 | "Generate a selector instance, i.e. a function taking a map of 16 | classes/resolvables and returning a seq of classes to resolve during 17 | the current iteration step.")) 18 | 19 | ;; ## Selectors 20 | 21 | (def default-selector 22 | "Always selects all available classes." 23 | (reify Selector 24 | (instantiate [_] 25 | keys))) 26 | 27 | (defn parallel-selector 28 | "Select at most `n` classes to resolve during each iteration." 29 | [n] 30 | {:pre [(pos? n)]} 31 | (reify Selector 32 | (instantiate [_] 33 | (fn [class->resolvables] 34 | (take n (keys class->resolvables)))))) 35 | 36 | (defn scoring-selector 37 | "Use `(score-fn class resolvables)` to generate a score for each 38 | class, selecting the one with the highest score. 39 | 40 | For example, to always select the class with the most resolvables: 41 | 42 | ```clojure 43 | (scoring-selector 44 | (fn [class resolvables] 45 | (count resolvables))) 46 | ``` 47 | 48 | Or, to assign a score based on class, e.g always resolve `FriendsOf` before 49 | `Person` if applicable: 50 | 51 | ```clojure 52 | (scoring-selector 53 | (fn [class resolvables] 54 | (get {Person 2, FriendsOf 1} class 0))) 55 | ``` 56 | " 57 | [score-fn] 58 | (reify Selector 59 | (instantiate [_] 60 | (fn [class->resolvables] 61 | (->> class->resolvables 62 | (apply max-key #(score-fn (key %) (val %))) 63 | (key) 64 | (vector)))))) 65 | 66 | (defn exact-selector 67 | "Select the given classes in the order they are given, e.g.: 68 | 69 | ```clojure 70 | (exact-selector 71 | [[Person] 72 | [FriendsOf FatherOf] 73 | [Person]]) 74 | ``` 75 | 76 | This can be used on a per-resolution basis, ideally providing the optimal 77 | resolution order: 78 | 79 | ```clojure 80 | (engine/run! 81 | {:selector (exact-selector ...)} 82 | (->Person 1)) 83 | ``` 84 | " 85 | [class-batches & [fallback-selector]] 86 | (let [fallback-selector (or fallback-selector default-selector) 87 | class-batches (map set class-batches)] 88 | (reify Selector 89 | (instantiate [_] 90 | (let [remaining (volatile! class-batches) 91 | fallback (instantiate fallback-selector)] 92 | (fn [class->resolvables] 93 | (let [next-batch (some-> (first @remaining) 94 | (filter (keys class->resolvables)))] 95 | (if (seq next-batch) 96 | (do 97 | (vswap! remaining next) 98 | next-batch) 99 | (fallback class->resolvables))))))))) 100 | -------------------------------------------------------------------------------- /src/claro/middleware/cache.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.cache 2 | "A middleware to allow caching of resolution results." 3 | (:require [claro.data.protocols :as p] 4 | [claro.engine :as engine] 5 | [claro.runtime.impl :as impl] 6 | [claro.middleware 7 | [intercept :refer [wrap-intercept]] 8 | [observe :refer [wrap-observe*]]] 9 | [potemkin :refer [defprotocol+]])) 10 | 11 | ;; ## Protocol 12 | 13 | (defprotocol+ ResolvableCache 14 | "Protocol for cache implementations for resolvables." 15 | (cache-get 16 | [cache env resolvables] 17 | "Lookup cached results for the given resolvables. This should return a map 18 | associating resolvables with their value.") 19 | (cache-put 20 | [cache env resolvable->result] 21 | "Put resolved values into the cache.")) 22 | 23 | ;; ## Middleware 24 | 25 | (defn- cache-writer 26 | [cache] 27 | (fn [env [resolvable] resolvable->result] 28 | (when-not (p/pure-resolvable? resolvable) 29 | (cache-put cache env resolvable->result)))) 30 | 31 | (defn- cache-reader 32 | [cache] 33 | (fn [env batch] 34 | (cache-get cache env batch))) 35 | 36 | (defn wrap-cache 37 | "Wrap the given engine to allow caching and cache lookups of resolvables via 38 | the given cache. 39 | 40 | ```clojure 41 | (defonce cache 42 | (redis-cache ...)) 43 | 44 | (defonce engine 45 | (-> (engine/engine) 46 | (wrap-cache cache))) 47 | ``` 48 | 49 | Note that `PureResolvable` values will never hit the cache." 50 | [engine cache] 51 | {:pre [(satisfies? ResolvableCache cache)]} 52 | (-> engine 53 | (wrap-observe* 54 | engine/wrap-pre-transform 55 | (cache-writer cache)) 56 | (wrap-intercept 57 | (cache-reader cache)))) 58 | -------------------------------------------------------------------------------- /src/claro/middleware/deferred.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.deferred 2 | "Generic middlewares to adjust the resolution deferred." 3 | (:require [claro.engine.core :as engine] 4 | [claro.runtime.impl :as impl])) 5 | 6 | (defn wrap-deferred 7 | "Middleware that will call `f` on any batchwise-resolution deferred value, 8 | if the batch of `Resolvable` values matches `predicate`. For example, to 9 | set a timeout on `Person` batch resolution (assuming Manifold deferreds): 10 | 11 | ```clojure 12 | (def run-engine 13 | (-> (engine/engine) 14 | (wrap-deferred 15 | #(instance? Person (first %)) 16 | (fn [env deferred] 17 | (d/timeout! deferred (:timeout env 1000)))))) 18 | ``` 19 | 20 | > __Note:__ `f` will be called on the environment and the batch. 21 | 22 | If no `predicate` is given `f` will be called on all deferred values." 23 | ([engine f] 24 | (wrap-deferred engine (constantly true) f)) 25 | ([engine predicate f] 26 | {:pre [(ifn? predicate) (ifn? f)]} 27 | (->> (fn [resolver] 28 | (fn [env batch] 29 | (cond->> (resolver env batch) 30 | (predicate batch) (f env)))) 31 | (engine/wrap engine)))) 32 | -------------------------------------------------------------------------------- /src/claro/middleware/intercept.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.intercept 2 | "A middleware to allow partial resolution of batches using a custom resolver." 3 | (:require [claro.data.protocols :as p] 4 | [claro.engine :as engine] 5 | [claro.runtime.impl :as impl])) 6 | 7 | ;; ## Logic 8 | 9 | (defn- resolve-remaining 10 | [impl resolver env batch interception-result] 11 | (let [intercepted (set (keys interception-result))] 12 | (if (empty? intercepted) 13 | (resolver env batch) 14 | (if-let [remaining (seq (remove intercepted batch))] 15 | (impl/chain1 16 | impl 17 | (resolver env remaining) 18 | #(merge interception-result %)) 19 | interception-result)))) 20 | 21 | ;; ## Middleware 22 | 23 | (defn ^{:added "0.2.20"} wrap-intercept 24 | "Wrap the given engine to allow resolution of partial batches using different 25 | means (e.g. a cache lookup). 26 | 27 | ```clojure 28 | (defonce engine 29 | (-> (engine/engine) 30 | (wrap-intercept 31 | (fn [env batch] 32 | (lookup-in-cache! env batch))))) 33 | ``` 34 | 35 | `intercept-fn` has to return a deferred value with a map associating `batch` 36 | elements with their result. Everything that was not resolved will be passed 37 | to the original resolution logic. 38 | 39 | Note that `PureResolvable` batches will never be passed to the interceptor." 40 | [engine intercept-fn] 41 | (let [impl (engine/impl engine)] 42 | (->> (fn [resolver] 43 | (fn [env [resolvable :as batch]] 44 | (if-not (p/pure-resolvable? resolvable) 45 | (impl/chain1 46 | impl 47 | (intercept-fn env batch) 48 | #(resolve-remaining impl resolver env batch %)) 49 | (resolver env batch)))) 50 | (engine/wrap-pre-transform engine)))) 51 | -------------------------------------------------------------------------------- /src/claro/middleware/mock.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.mock 2 | "Generic I/O mocking middlewares." 3 | (:require [claro.engine.core :as engine] 4 | [claro.data.protocols :as p] 5 | [claro.runtime.impl :as impl])) 6 | 7 | ;; ## Logic 8 | 9 | (defn- make-lookup-fn 10 | [class mock-fn more] 11 | {:pre [(even? (count more))]} 12 | (comp 13 | (->> (partition 2 more) 14 | (into {class mock-fn})) 15 | clojure.core/class 16 | first)) 17 | 18 | (defn- make-mock-wrapper 19 | [engine lookup-fn] 20 | (fn [resolver] 21 | (fn [env batch] 22 | (if-let [mock-fn (lookup-fn batch)] 23 | (impl/value 24 | (engine/impl engine) 25 | (->> (for [resolvable batch] 26 | [resolvable (mock-fn resolvable env)]) 27 | (into {}))) 28 | (resolver env batch))))) 29 | 30 | ;; ## Middlewares 31 | 32 | (defn wrap-mock 33 | "Middleware that will prevent calling of `resolve!` or `resolve-batch!` for 34 | the given class, but instead use the given `mock-fn` to compute a result 35 | for each `Resolvable`. `mock-fn` takes the resolvable in question, as well 36 | as the environment as parameters. 37 | 38 | Transformations declared by implementing the [[Transform]] protocol will 39 | still be performed. 40 | 41 | For example, to mock resolution of `Person` records: 42 | 43 | ```clojure 44 | (def run-engine 45 | (-> (engine/engine) 46 | (wrap-mock 47 | Person 48 | (fn [{:keys [id]} env] 49 | {:id id 50 | :name (str \"Person #\" id)})))) 51 | ``` 52 | 53 | > __Note:__ Multiple class/mock-fn pairs can be given." 54 | [engine class mock-fn & more] 55 | (->> (make-lookup-fn class mock-fn more) 56 | (make-mock-wrapper engine) 57 | (engine/wrap-pre-transform engine))) 58 | 59 | (defn wrap-mock-result 60 | "Middleware that will prevent calling of `resolve!` or `resolve-batch!` for 61 | the given class, but instead use the given `mock-fn` to compute a result 62 | for each `Resolvable`. `mock-fn` takes the resolvable in question, as well 63 | as the environment as parameters. 64 | 65 | Transformations declared by implementing the [[Transform]] protocol will 66 | be ignored, so this really has to return the eventual result. 67 | 68 | For example, to mock resolution of `Person` records: 69 | 70 | ```clojure 71 | (def run-engine 72 | (-> (engine/engine) 73 | (wrap-mock-result 74 | Person 75 | (fn [{:keys [id]} env] 76 | {:id id 77 | :name (str \"Person #\" id) 78 | :friends (map ->Person (range id))})))) 79 | ``` 80 | 81 | > __Note:__ Multiple class/mock-fn pairs can be given." 82 | [engine class mock-fn & more] 83 | (->> (make-lookup-fn class mock-fn more) 84 | (make-mock-wrapper engine) 85 | (engine/wrap-transform engine))) 86 | -------------------------------------------------------------------------------- /src/claro/middleware/transform.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.transform 2 | "Generic middlewares to transform resolution results." 3 | (:require [claro.engine.core :as engine] 4 | [claro.runtime.impl :as impl])) 5 | 6 | ;; ## Transform Logic 7 | 8 | (defn- transform! 9 | [predicate transform-fn result] 10 | (->> (for [[resolvable resolved] result] 11 | [resolvable (if (predicate resolvable) 12 | (transform-fn resolvable resolved) 13 | resolved)]) 14 | (into {}))) 15 | 16 | ;; ## Middlewares 17 | 18 | (defn wrap-transform 19 | "Middleware that will pass any `Resolvable` that matches `Predicate` – as 20 | well as the resolved result – to `transform-fn` and use its return value in 21 | place of the actual result. 22 | 23 | For example, to inject the current timestamp into each `Person` record: 24 | 25 | ```clojure 26 | (def run-engine 27 | (-> (engine/engine) 28 | (wrap-transform 29 | #(instance? Person %) 30 | #(assoc %2 :__timestamp (System/currentTimeMillis))))) 31 | ``` 32 | 33 | If no `predicate` is given, all `Resolvable` values will be transformed." 34 | ([engine transform-fn] 35 | (wrap-transform engine (constantly true) transform-fn)) 36 | ([engine predicate transform-fn] 37 | {:pre [(ifn? predicate) (ifn? transform-fn)]} 38 | (->> (fn [resolver] 39 | (fn [env batch] 40 | (impl/chain1 41 | (engine/impl engine) 42 | (resolver env batch) 43 | #(transform! predicate transform-fn %)))) 44 | (engine/wrap-transform engine)))) 45 | 46 | (defn wrap-transform-by-class 47 | "Middleware that will pass any `Resolvable` of one of the given 48 | `classes-to-transform` – as well as the resolved result – to `transform-fn` 49 | and use its return value in place of the actual result. 50 | 51 | For example, to inject the current timestamp into each `Person` record: 52 | 53 | ```clojure 54 | (def run-engine 55 | (-> (engine/engine) 56 | (wrap-transform-classes 57 | [Person] 58 | #(assoc %2 :__timestamp (System/currentTimeMillis))))) 59 | ``` 60 | " 61 | [engine classes-to-transform transformer-fn] 62 | {:pre [(seq classes-to-transform)]} 63 | (let [predicate (fn [resolvable] 64 | (some 65 | #(instance? % resolvable) 66 | classes-to-transform))] 67 | (wrap-transform engine predicate transformer-fn))) 68 | -------------------------------------------------------------------------------- /src/claro/projection.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection 2 | "Powerful tree projection functions. 3 | 4 | These will allow you to convert an infinite tree of `Resolvable` values to 5 | a finite form, performing transformations, injections and selection along the 6 | way. 7 | 8 | See [Projections][1] and [Advanced Projections][2] for a detailed discussion 9 | and examples. 10 | 11 | [1]: 01-projection.md 12 | [2]: 02-advanced-projection.md 13 | " 14 | (:refer-clojure :exclude [apply alias case let merge juxt sort-by]) 15 | (:require [claro.projection 16 | [protocols :refer [project]] 17 | aux 18 | conditional 19 | case 20 | bind 21 | juxt 22 | level 23 | maps 24 | maybe 25 | objects 26 | parameters 27 | remove-nil 28 | sequential 29 | sets 30 | sort 31 | transform 32 | union 33 | value] 34 | [potemkin :refer [import-vars]])) 35 | 36 | ;; ## Projection 37 | 38 | (defn apply 39 | "Project the given value using the given template." 40 | [value template] 41 | (project template value)) 42 | 43 | ;; ## API 44 | 45 | (import-vars 46 | [claro.projection.aux 47 | extract 48 | extract-in] 49 | [claro.projection.objects 50 | leaf 51 | unsafe] 52 | [claro.projection.conditional 53 | conditional 54 | conditional-union] 55 | [claro.projection.case 56 | case 57 | case-resolvable] 58 | [claro.projection.bind 59 | bind 60 | let] 61 | [claro.projection.juxt 62 | juxt* 63 | juxt] 64 | [claro.projection.level 65 | levels] 66 | [claro.projection.maps 67 | alias] 68 | [claro.projection.maybe 69 | maybe 70 | default] 71 | [claro.projection.sort 72 | sort-by] 73 | [claro.projection.transform 74 | prepare 75 | transform 76 | transform-finite] 77 | [claro.projection.parameters 78 | maybe-parameters 79 | parameters] 80 | [claro.projection.remove-nil 81 | remove-nil-elements] 82 | [claro.projection.union 83 | merge* 84 | merge 85 | union* 86 | union] 87 | [claro.projection.value 88 | value 89 | finite-value]) 90 | -------------------------------------------------------------------------------- /src/claro/projection/aux.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.aux 2 | (:require [claro.projection 3 | [objects :refer [leaf]] 4 | [transform :refer [transform]]])) 5 | 6 | (defn ^{:added "0.2.13"} extract-in 7 | "Extract a subtree/leaf located under the given path. 8 | 9 | ```clojure 10 | (-> {:sherlock (->Person 1)} 11 | (projection/apply (extract-in [:sherlock :name])) 12 | (engine/run!!)) 13 | ;; => \"Sherlock\" 14 | ``` 15 | 16 | For non-leaf values, a template can be given that will be applied before 17 | extraction." 18 | ([template ks] 19 | (transform #(get-in % ks) template)) 20 | ([ks] 21 | (extract-in (assoc-in {} ks leaf) ks))) 22 | 23 | (defn extract 24 | "Extract a subtree/leaf located under the given key. 25 | 26 | ```clojure 27 | (-> (->Person 1) 28 | (projection/apply (extract :name)) 29 | (engine/run!!)) 30 | ;; => \"Sherlock\" 31 | ``` 32 | 33 | For non-leaf values, a template can be given that will be applied before 34 | extraction." 35 | ([template k] (extract-in template [k])) 36 | ([k] (extract-in [k]))) 37 | -------------------------------------------------------------------------------- /src/claro/projection/bind.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.bind 2 | (:refer-clojure :exclude [let]) 3 | (:require [claro.projection.protocols :as pr] 4 | [claro.data.ops.then :refer [then! then]] 5 | [clojure.core :as core])) 6 | 7 | ;; ## Record 8 | 9 | (defn- bind-template 10 | [value template bind-fn] 11 | (-> (pr/project template value) 12 | (then! 13 | (fn [partial-value] 14 | (core/let 15 | [template' (bind-fn partial-value)] 16 | (pr/project template' value)))))) 17 | 18 | (deftype BindProjection [template bind-fn] 19 | pr/Projection 20 | (project [_ value] 21 | (then value #(bind-template % template bind-fn)))) 22 | 23 | (defmethod print-method BindProjection 24 | [^BindProjection value ^java.io.Writer w] 25 | (.write w "#")) 28 | 29 | ;; ## Basic Constructor 30 | 31 | (defn bind 32 | "A two-step projection, using a partial projection result to generate the 33 | eventual, full projection. Example: 34 | 35 | ```clojure 36 | (projection/bind 37 | (fn [{:keys [id]}] 38 | {:children 39 | [{:id projection/leaf 40 | :parent-id (projection/value id)}]}) 41 | {:id projection/leaf}) 42 | ``` 43 | 44 | This will use `{:id projection/leaf}` to project the current value and pass 45 | the result to the given function – which is then expected to return the 46 | \"actual\" projection template for the current value. 47 | 48 | This projection is useful to \"remember\" values in the tree." 49 | [bind-fn template] 50 | (->BindProjection template bind-fn)) 51 | 52 | ;; ## Syntactic Sugar 53 | 54 | (defmacro let 55 | "Syntactic sugar for the [[bind]] projection. 56 | 57 | ```clojure 58 | (projection/let [{:keys [id]} {:id projection/leaf}] 59 | {:children [{:id projection/leaf 60 | :parent-id (projection/value id)}]}) 61 | ``` 62 | 63 | is equal to: 64 | 65 | ```clojure 66 | (projection/bind 67 | (fn [{:keys [id]}] 68 | {:children [{:id projection/leaf 69 | :parent-id (projection/value id)}]}) 70 | {:id projection/leaf}) 71 | ``` 72 | 73 | Multiple binding templates are supported (although you'll usually want to 74 | only use one): 75 | 76 | ```clojure 77 | (projection/let [{:keys [id]} {:id projection/leaf} 78 | {:keys [name]} {:name projection/leaf}] 79 | ...) 80 | ``` 81 | " 82 | [bindings & body] 83 | {:pre [(seq bindings) (even? (count bindings))]} 84 | (if (> (count bindings) 2) 85 | `(let [~@(take 2 bindings)] 86 | (let [~@(drop 2 bindings)] 87 | ~@body)) 88 | (core/let [[binding template] bindings] 89 | `(->BindProjection 90 | ~template 91 | (fn [~binding] 92 | ~@body))))) 93 | -------------------------------------------------------------------------------- /src/claro/projection/conditional.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.conditional 2 | (:require [claro.projection.protocols :as pr] 3 | [claro.projection.union :refer [union*]] 4 | [claro.data.error :refer [with-error?]] 5 | [claro.data.protocols :as p] 6 | [claro.data.ops.then :refer [then then!]] 7 | [claro.data.ops.chain :refer [chain-eager chain-when]])) 8 | 9 | ;; ## Record 10 | 11 | (defn- project-match 12 | [condition->template else-template value partial-value] 13 | (second 14 | (or (some 15 | (fn [[condition template]] 16 | (if (condition partial-value) 17 | [:done (pr/project template value)])) 18 | condition->template) 19 | (if else-template 20 | [:done (pr/project else-template value)])))) 21 | 22 | (deftype ConditionalProjection [template 23 | condition->template 24 | else-template] 25 | pr/Projection 26 | (project [_ value] 27 | (with-error? value 28 | (-> (pr/project template value) 29 | (then! 30 | #(project-match condition->template else-template value %)))))) 31 | 32 | (defmethod print-method ConditionalProjection 33 | [^ConditionalProjection value ^java.io.Writer w] 34 | (.write w "# ...>")) 37 | 38 | ;; ## Constructors 39 | 40 | (defn- make-conditional 41 | [partial-template condition template more] 42 | (let [pairs (cons [condition template] (partition 2 more)) 43 | [c maybe-else-template] (last pairs) 44 | [condition->template else-template] 45 | (if (= c :else) 46 | [(butlast pairs) maybe-else-template] 47 | [pairs nil]) ] 48 | (->ConditionalProjection 49 | partial-template 50 | condition->template 51 | else-template))) 52 | 53 | (defn conditional 54 | "Apply the first projection whose predicate matches the value resulting from 55 | projecting `partial-template`. 56 | 57 | ``` 58 | (projection/conditional 59 | {:type projection/leaf} 60 | (comp #{:animal} :type) {:left-paw projection/leaf} 61 | (comp #{:human} :type) {:left-hand projection/leaf}) 62 | ``` 63 | 64 | `:else` can be given to denote the default case: 65 | 66 | ```clojure 67 | (projection/conditional 68 | {:type projection/leaf} 69 | (comp #{:animal} :type) {:left-paw projection/leaf} 70 | :else {:left-hand projection/leaf}) 71 | ``` 72 | 73 | Note that, sometimes, you can express this just as well using a [[bind]] or 74 | [[let]] projection: 75 | 76 | ```clojure 77 | (projection/let [{:keys [type]} {:type projection/leaf}] 78 | (case type 79 | :animal {:left-paw projection/leaf} 80 | :human {:left-hand projection/leaf})) 81 | ``` 82 | " 83 | [partial-template condition template & more] 84 | {:pre [(even? (count more))]} 85 | (make-conditional partial-template condition template more)) 86 | 87 | (defn conditional-union 88 | "Apply and merge all projections whose predicates match the value resulting 89 | from projecting `partial-template`. 90 | 91 | ```clojure 92 | (projection/conditional-union 93 | {:type projection/leaf 94 | :has-children? projection/leaf} 95 | (comp #{:animal} :type) {:left-paw projection/leaf} 96 | (comp #{:human} :type) {:left-hand projection/leaf} 97 | :has-children? {:children [{:name projection/leaf}]}) 98 | ``` 99 | 100 | The matching projections have to produce maps with disjunct sets of keys." 101 | [partial-template condition template & more] 102 | {:pre [(even? (count more))]} 103 | (->> (partition 2 more) 104 | (map 105 | (fn [[condition template]] 106 | (conditional partial-template condition template))) 107 | (cons (conditional partial-template condition template)) 108 | (union*))) 109 | -------------------------------------------------------------------------------- /src/claro/projection/juxt.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.juxt 2 | (:refer-clojure :exclude [juxt]) 3 | (:require [claro.projection.protocols :as pr] 4 | [claro.data.error :refer [with-error?]] 5 | [claro.data.ops.chain :as chain])) 6 | 7 | ;; ## Record 8 | 9 | (deftype JuxtProjection [templates] 10 | pr/Projection 11 | (project [_ value] 12 | (with-error? value 13 | (chain/chain-eager 14 | value 15 | (fn [result] 16 | (with-error? result 17 | (mapv #(pr/project % result) templates))))))) 18 | 19 | (defmethod print-method JuxtProjection 20 | [^JuxtProjection value ^java.io.Writer w] 21 | (.write w "#")) 24 | 25 | ;; ## Constructor 26 | 27 | (defn ^{:added "0.2.13"} juxt* 28 | "Creates a vector with results of projecting the current value with each 29 | of the given `templates` (maintaining order): 30 | 31 | ```clojure 32 | (projection/juxt* 33 | [(projection/extract :id) 34 | (projection/extract :name)]) 35 | ``` 36 | 37 | This, for example, will convert a map with `:id` and `:name` keys to a 38 | tuple." 39 | [templates] 40 | {:pre [(seq templates)]} 41 | (->JuxtProjection templates)) 42 | 43 | (defn ^{:added "0.2.13"} juxt 44 | "Creates a vector with results of projecting the current value with each 45 | of the given `templates` (maintaining order): 46 | 47 | ```clojure 48 | (projection/juxt 49 | (projection/extract :id) 50 | (projection/extract :name)) 51 | ``` 52 | 53 | This, for example, will convert a map with `:id` and `:name` keys to a 54 | tuple." 55 | [& templates] 56 | (juxt* templates)) 57 | -------------------------------------------------------------------------------- /src/claro/projection/level.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.level 2 | (:require [claro.projection.protocols :as pr] 3 | [claro.data.ops 4 | [collections :as c] 5 | [then :refer [then]]])) 6 | 7 | ;; ## Record 8 | 9 | (declare ->LevelProjection) 10 | 11 | (defn- project-map 12 | [m current-level] 13 | (if (pos? current-level) 14 | (let [template (->LevelProjection (dec current-level)) 15 | project #(pr/then-project template %)] 16 | (->> (for [[k v] m] 17 | [(project k) (project v)]) 18 | (into {}))) 19 | {})) 20 | 21 | (defn- project-coll 22 | [c current-level] 23 | (if (pos? current-level) 24 | (let [template (->LevelProjection current-level)] 25 | (c/map-single #(pr/project template %) c)) 26 | (empty c))) 27 | 28 | (defn- project-level 29 | [value current-level] 30 | (cond (not (coll? value)) value 31 | (map? value) (project-map value current-level) 32 | :else (project-coll value current-level))) 33 | 34 | (deftype LevelProjection [n] 35 | pr/Projection 36 | (project [_ value] 37 | (then value #(project-level % n)))) 38 | 39 | (defmethod print-method LevelProjection 40 | [^LevelProjection value ^java.io.Writer w] 41 | (.write w "#")) 44 | 45 | ;; ## Constructor 46 | 47 | (defn levels 48 | "Generate Projection template representing the first `n` levels of a value. 49 | Leafs up to the given level will be maintained. 50 | 51 | E.g. for the following value: 52 | 53 | {:a 0 54 | :b {:c 1} 55 | :d {:e [{:f 2}]}} 56 | 57 | Result for `n` == 1: 58 | 59 | {:a 0, :b {}, :d {}} 60 | 61 | Result for `n` == 2; 62 | 63 | {:a 0, :b {:c 1}, :d {:e []}} 64 | 65 | For `n` >= 3, the full value will be returned." 66 | [n] 67 | {:pre [(pos? n)]} 68 | (->LevelProjection n)) 69 | -------------------------------------------------------------------------------- /src/claro/projection/maybe.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.maybe 2 | (:require [claro.projection.protocols :as pr] 3 | [claro.projection.maps :as maps] 4 | [claro.data.ops.then :refer [then]])) 5 | 6 | ;; ## Maybe 7 | 8 | (deftype MaybeProjection [template] 9 | pr/Projection 10 | (project [_ value] 11 | (then value 12 | #(some->> % (pr/project template)))) 13 | 14 | maps/MapValueProjection 15 | (project-value [this value] 16 | (pr/project this value)) 17 | (project-missing-value [this _] 18 | nil)) 19 | 20 | (defn maybe 21 | "Apply projection template if the value is not `nil`, otherwise just keep the 22 | `nil`. 23 | 24 | ```clojure 25 | (projection/maybe {:name projection/leaf}) 26 | ``` 27 | 28 | Note that this will cause a `nil` to be injected into a result map even if 29 | the respective key is missing." 30 | [template] 31 | (->MaybeProjection template)) 32 | 33 | (defmethod print-method MaybeProjection 34 | [^MaybeProjection value ^java.io.Writer w] 35 | (.write w "#")) 38 | 39 | ;; ## Default 40 | 41 | (deftype DefaultProjection [template default-value] 42 | pr/Projection 43 | (project [_ value] 44 | (then value 45 | #(->> (if (nil? %) 46 | default-value 47 | %) 48 | (pr/project template)))) 49 | 50 | maps/MapValueProjection 51 | (project-value [this value] 52 | (pr/project this value)) 53 | (project-missing-value [this _] 54 | (pr/project template default-value))) 55 | 56 | (defn default 57 | "Apply the given projection to any non-nil value or the given default. 58 | 59 | ```clojure 60 | (projection/default {:name projection/leaf} unknown-person) 61 | ``` 62 | 63 | Note that this will cause the default value to be injected into a result 64 | map even if the respective key is missing." 65 | [template default-value] 66 | (->DefaultProjection template default-value)) 67 | 68 | (defmethod print-method DefaultProjection 69 | [^DefaultProjection value ^java.io.Writer w] 70 | (.write w "#")) 75 | -------------------------------------------------------------------------------- /src/claro/projection/objects.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.objects 2 | (:require [claro.projection.protocols :refer [Projection]] 3 | [claro.data.ops.chain :refer [chain-eager]])) 4 | 5 | ;; ## Helpers 6 | 7 | (defn- leaf? 8 | [value] 9 | (not (coll? value))) 10 | 11 | (defn- assert-leaf 12 | [value] 13 | (when-not (leaf? value) 14 | (throw 15 | (IllegalStateException. 16 | (str "leaf projection template can only be used for non-collection " 17 | "values.\n" 18 | "value: " (pr-str value))))) 19 | value) 20 | 21 | ;; ## Templates 22 | 23 | (deftype LeafProjection [] 24 | Projection 25 | (project [_ value] 26 | (chain-eager value assert-leaf))) 27 | 28 | (def leaf 29 | "Projection template for leaf values (equivalent to `nil` but preferable 30 | since more explicit)." 31 | (->LeafProjection)) 32 | 33 | (extend-protocol Projection 34 | nil 35 | (project [_ value] 36 | (chain-eager value assert-leaf))) 37 | 38 | (deftype UnsafeProjection [] 39 | Projection 40 | (project [_ value] 41 | value)) 42 | 43 | (def unsafe 44 | "Projection template for any kind of value. If this is used in places 45 | where infinite subtrees can occur, engine executions _will_ run forever or 46 | exceed the maximum resolution cost." 47 | (->UnsafeProjection)) 48 | 49 | ;; ## Printing 50 | 51 | (defmethod print-method LeafProjection 52 | [value ^java.io.Writer writer] 53 | (.write writer "#")) 54 | 55 | (defmethod print-method UnsafeProjection 56 | [value ^java.io.Writer writer] 57 | (.write writer "#")) 58 | -------------------------------------------------------------------------------- /src/claro/projection/parameters.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.parameters 2 | (:require [claro.data.protocols :as p] 3 | [claro.data.tree :as tree] 4 | [claro.data.error :refer [with-error?]] 5 | [claro.projection.protocols :as pr])) 6 | 7 | ;; ## Default Implementation 8 | 9 | (defn- assert-allowed-params! 10 | [value params] 11 | (doseq [[k v] params 12 | :let [current (get value k ::none)]] 13 | (when (= current ::none) 14 | (throw 15 | (IllegalArgumentException. 16 | (format 17 | (str "'parameters' projection requires key '%s' to exist.%n" 18 | "parameters: %s%n" 19 | "value: %s") 20 | k 21 | (pr-str params) 22 | (pr-str value))))) 23 | (when-not (nil? current) 24 | (throw 25 | (IllegalArgumentException. 26 | (format 27 | (str "'parameters' projection cannot override non-nil value " 28 | "at key '%s'%n" 29 | "parameters: %s%n" 30 | "value: %s") 31 | k 32 | (pr-str params) 33 | (pr-str value)))))) 34 | value) 35 | 36 | (extend-protocol p/Parameters 37 | clojure.lang.IPersistentMap 38 | (set-parameters [resolvable parameters] 39 | (-> (assert-allowed-params! resolvable parameters) 40 | (into parameters)))) 41 | 42 | ;; ## Parameter Injection 43 | 44 | (defn- assert-resolvable! 45 | [value params] 46 | (when-not (p/resolvable? value) 47 | (throw 48 | (IllegalArgumentException. 49 | (str 50 | "'parameters' projection requires a resolvable.\n" 51 | "parameters: " (pr-str params) "\n" 52 | "value: " (pr-str value))))) 53 | value) 54 | 55 | (defn- inject-params 56 | [value params] 57 | (-> value 58 | (assert-resolvable! params) 59 | (p/set-parameters params))) 60 | 61 | (deftype ParametersProjection [params rest-template] 62 | pr/Projection 63 | (project [_ value] 64 | (with-error? value 65 | (->> #(inject-params % params) 66 | (tree/transform-partial value) 67 | (pr/project rest-template))))) 68 | 69 | (defmethod print-method ParametersProjection 70 | [^ParametersProjection value ^java.io.Writer w] 71 | (.write w "# ") 74 | (print-method (.-rest-template value) w) 75 | (.write w ">")) 76 | 77 | (defn parameters 78 | "Set some fields within a Resolvable record before resolution. Note that: 79 | 80 | - You can only set fields that currently have the value `nil` (i.e. no 81 | overriding of already set fields). 82 | - You can only set fields the record already contains (i.e. records have to 83 | explicitly contain even optional parameter fields). 84 | 85 | These restrictions are intended to make resolution more predictable. Note 86 | that you can always use `prepare` directly to perform arbitrary 87 | injections." 88 | [params rest-template] 89 | {:pre [(map? params)]} 90 | (->ParametersProjection params rest-template)) 91 | 92 | ;; ## Parameter Injection (w/ Null Tolerance) 93 | 94 | (deftype MaybeParametersProjection [params rest-template] 95 | pr/Projection 96 | (project [_ value] 97 | (with-error? value 98 | (->> #(some-> % 99 | (inject-params params) 100 | (->> (pr/project rest-template))) 101 | (tree/transform-partial value))))) 102 | 103 | (defmethod print-method MaybeParametersProjection 104 | [^MaybeParametersProjection value ^java.io.Writer w] 105 | (.write w "# ") 108 | (print-method (.-rest-template value) w) 109 | (.write w ">")) 110 | 111 | (defn ^{:added "0.2.18"} maybe-parameters 112 | "Like [[parameters]] but will ignore `nil` values." 113 | [params rest-template] 114 | {:pre [(map? params)]} 115 | (->MaybeParametersProjection params rest-template)) 116 | -------------------------------------------------------------------------------- /src/claro/projection/protocols.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.protocols 2 | (:require [claro.data.ops.then :refer [then]])) 3 | 4 | (defprotocol Projection 5 | "Protocol for projection templates." 6 | (project [template value] 7 | "Use the given template to ensure the shape of the given value.")) 8 | 9 | (defn then-project 10 | "Use the given projection template to ensure the shape of the, potentially 11 | not fully resolved value." 12 | [template value] 13 | (then value #(project template %))) 14 | -------------------------------------------------------------------------------- /src/claro/projection/remove_nil.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.remove-nil 2 | (:require [claro.projection 3 | [protocols :as p] 4 | [maybe :refer [maybe]] 5 | [objects :refer [leaf]]] 6 | [claro.data.error :refer [with-error?]] 7 | [claro.data.ops 8 | [then :refer [then! then]]])) 9 | 10 | ;; ## Helpers 11 | 12 | (def ^:private marker-seq-projection 13 | "A projection that generates a seq of booleans indicating which elements 14 | are nil (`true`) and which are not." 15 | (reify p/Projection 16 | (project [_ sq] 17 | (with-error? sq 18 | (->> (fn [sq] 19 | (map #(then % nil?) sq)) 20 | (then sq)))))) 21 | 22 | (defn- rewrap-seq 23 | [original sq] 24 | (if (or (list? original) (seq? original)) 25 | (list* sq) 26 | (into (empty original) sq))) 27 | 28 | (defn- remove-nil-elements* 29 | [original] 30 | (let [original' (seq original)] 31 | (-> (p/project marker-seq-projection original') 32 | (then! 33 | (fn [sq] 34 | (->> (map vector original' sq) 35 | (keep 36 | (fn [[value value-is-nil?]] 37 | (if-not value-is-nil? value))) 38 | (rewrap-seq original))))))) 39 | 40 | ;; ## Implementation 41 | 42 | (deftype RemoveNilProjection [template] 43 | p/Projection 44 | (project [_ original] 45 | (with-error? original 46 | (let [result (then original remove-nil-elements*)] 47 | (if template 48 | (then result #(p/project template %)) 49 | result))))) 50 | 51 | (defmethod print-method RemoveNilProjection 52 | [^RemoveNilProjection value ^java.io.Writer w] 53 | (.write w "#")) 58 | 59 | ;; ## Wrappers 60 | 61 | (defn remove-nil-elements 62 | "A projection to remove all `nil` elements from a seq, before applying the 63 | given `template` to it. If no `template` is given, the seq without `nil` 64 | values will be returned directly (and needs to have another projection 65 | applied if infinite subtrees are possible)." 66 | [& [template]] 67 | (->RemoveNilProjection template)) 68 | -------------------------------------------------------------------------------- /src/claro/projection/sequential.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.sequential 2 | (:require [claro.projection.protocols :refer [Projection project]] 3 | [claro.data.error :refer [with-error?]] 4 | [claro.data.ops.chain :as chain])) 5 | 6 | ;; ## Helpers 7 | 8 | (defn- assert-sequential! 9 | [value template] 10 | (when-not (sequential? value) 11 | (throw 12 | (IllegalArgumentException. 13 | (str "projection template is sequential but value is not.\n" 14 | "template: [" (pr-str template) "]\n" 15 | "value: " (pr-str value))))) 16 | value) 17 | 18 | (defprotocol WrapSequential 19 | (wrap-sequential [this values])) 20 | 21 | (extend-protocol WrapSequential 22 | clojure.lang.IPersistentVector 23 | (wrap-sequential [_ values] 24 | values) 25 | 26 | clojure.lang.IPersistentList 27 | (wrap-sequential [_ values] 28 | (chain/chain-blocking* values list*)) 29 | 30 | clojure.lang.ISeq 31 | (wrap-sequential [_ values] 32 | (chain/chain-blocking* values list*)) 33 | 34 | clojure.lang.IPersistentCollection 35 | (wrap-sequential [coll values] 36 | (let [prototype (empty coll)] 37 | (chain/chain-blocking* values #(into prototype %))))) 38 | 39 | (defn- project-elements 40 | [template value] 41 | (with-error? value 42 | (assert-sequential! value template) 43 | (wrap-sequential value (mapv #(project template %) value)))) 44 | 45 | ;; ## Implementation 46 | 47 | (extend-protocol Projection 48 | clojure.lang.Sequential 49 | (project [[template :as sq] value] 50 | {:pre [(= (count sq) 1)]} 51 | (chain/chain-eager value #(project-elements template %)))) 52 | -------------------------------------------------------------------------------- /src/claro/projection/sets.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.sets 2 | (:require [claro.projection.protocols :refer [Projection project]] 3 | [claro.data.error :refer [with-error?]] 4 | [claro.data.ops 5 | [collections :as c] 6 | [then :refer [then then!]]])) 7 | 8 | ;; ## Helpers 9 | 10 | (defn- assert-set! 11 | [value template] 12 | (when-not (and (coll? value) (not (map? value))) 13 | (throw 14 | (IllegalArgumentException. 15 | (str "projection template is set but value is not a collection.\n" 16 | "template: #{" (pr-str template) "}\n" 17 | "value: " (pr-str value))))) 18 | value) 19 | 20 | (defn- project-set 21 | [template value] 22 | (with-error? value 23 | (assert-set! value template) 24 | (then! (mapv #(project template %) value) 25 | set))) 26 | 27 | ;; ## Implementation 28 | 29 | (extend-protocol Projection 30 | clojure.lang.IPersistentSet 31 | (project [sq value] 32 | {:pre [(= (count sq) 1)]} 33 | (let [template (first sq)] 34 | (then value #(project-set template %))))) 35 | -------------------------------------------------------------------------------- /src/claro/projection/sort.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.sort 2 | (:refer-clojure :exclude [sort-by]) 3 | (:require [claro.projection 4 | [protocols :as p] 5 | [transform :as transform]] 6 | [claro.data 7 | [error :refer [with-error?]] 8 | [ops :as ops]])) 9 | 10 | (deftype SortProjection [sort-template output-template] 11 | p/Projection 12 | (project [_ original] 13 | (with-error? original 14 | (->> (fn [sq] 15 | (-> (transform/transform 16 | (fn [sort-keys] 17 | (->> (map vector sort-keys sq) 18 | (clojure.core/sort-by first) 19 | (mapv second))) 20 | [sort-template] 21 | output-template) 22 | (p/project sq))) 23 | (ops/then original))))) 24 | 25 | (defmethod print-method SortProjection 26 | [^SortProjection value ^java.io.Writer w] 27 | (.write w "# ") 31 | (print-method out w)) 32 | (.write w ">")) 33 | 34 | (defn ^{:added "0.2.19"} sort-by 35 | "A projection sorting the sequence that's currently being resolved. 36 | `sort-template` is applied to each element of the sequence to generate 37 | a value to sort by, while `output-template´ is used to further project 38 | the resulting sorted sequence. 39 | 40 | ```clojure 41 | (-> [{:index 3, :value 'third} 42 | {:index 1, :value 'first} 43 | {:index 2, :value 'second}] 44 | (projection/apply 45 | (projection/sort-by 46 | (projection/extract :index) 47 | [{:value projection/leaf}])) 48 | (engine/run!!)) 49 | ;; => [{:value 'first}, {:value 'second}, {:value 'third}] 50 | ``` 51 | 52 | If no `output-template` is given, the resulting tree may not be infinite 53 | (or a further projection has to be applied externally)." 54 | ([sort-template] 55 | (->SortProjection sort-template nil)) 56 | ([sort-template output-template] 57 | {:pre [(some? sort-template) 58 | (some? output-template)]} 59 | (->SortProjection sort-template output-template))) 60 | -------------------------------------------------------------------------------- /src/claro/projection/transform.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.transform 2 | (:require [claro.projection.protocols :as pr] 3 | [claro.data.tree :as tree] 4 | [claro.data.error :refer [with-error?]] 5 | [claro.data.ops.chain :as chain])) 6 | 7 | ;; ## Preparation (before Resolution) 8 | 9 | (defn- apply-preparation 10 | [value f rest-template] 11 | (with-error? value 12 | (->> (tree/transform-partial value f) 13 | (pr/project rest-template)))) 14 | 15 | (deftype Preparation [f rest-template] 16 | pr/Projection 17 | (project [_ value] 18 | (apply-preparation value f rest-template))) 19 | 20 | (defmethod print-method Preparation 21 | [^Preparation value ^java.io.Writer w] 22 | (.write w "#")) 25 | 26 | (defn prepare 27 | "A projection applying a transformation function to a value (before 28 | resolution!), with `rest-template` being used to further project the 29 | resulting value." 30 | [f rest-template] 31 | (->Preparation f rest-template)) 32 | 33 | ;; ## Transformation (after Resolution) 34 | 35 | (deftype Transformation [f input-template output-template] 36 | pr/Projection 37 | (project [_ value] 38 | (with-error? value 39 | (-> (pr/project input-template value) 40 | (chain/chain-blocking 41 | (if output-template 42 | (comp #(pr/project output-template %) f) 43 | f)))))) 44 | 45 | (defmethod print-method Transformation 46 | [^Transformation value ^java.io.Writer w] 47 | (.write w "#")) 50 | 51 | (defn transform 52 | "A projection applying a transformation function to a fully resolved value. 53 | `input-template` is used to project the initial value, `output-template` will 54 | be used to further project the resulting value. 55 | 56 | For example, to extract the `:name` key from a seq of maps: 57 | 58 | ```clojure 59 | (-> [{:name \"Zebra\"}, {:name \"Tiger\"}] 60 | (projection/apply 61 | [(projection/transform :name {:name projection/leaf} projection/leaf)]) 62 | (engine/run!!)) 63 | ;; => [\"Zebra\" \"Tiger\"] 64 | ``` 65 | 66 | If no `output-template` is given, you _have_ to apply projections to 67 | potentially infinite subtrees within the transformation function. 68 | 69 | If the transformation won't introduce any new resolvables, 70 | [[transform-finite]] should be preferred due to its better performance with 71 | deeply nested trees." 72 | ([f input-template] 73 | (->Transformation f input-template nil)) 74 | ([f input-template output-template] 75 | (->Transformation f input-template output-template))) 76 | 77 | ;; ## Transformation to Finite Value 78 | 79 | (deftype FiniteTransformation [f input-template] 80 | pr/Projection 81 | (project [_ value] 82 | (with-error? value 83 | (-> (pr/project input-template value) 84 | (chain/chain-blocking* f))))) 85 | 86 | (defmethod print-method FiniteTransformation 87 | [^FiniteTransformation value ^java.io.Writer w] 88 | (.write w "#")) 91 | 92 | (defn ^{:added "0.2.15"} transform-finite 93 | "Like [[transform]] but assuming that `f` produces a finite value, i.e. 94 | one without any further resolvables. 95 | 96 | For transformations on deeply nested structures this will perform better 97 | than [[transform]] since it avoids re-inspection of the tree." 98 | [f input-template] 99 | (->FiniteTransformation f input-template)) 100 | -------------------------------------------------------------------------------- /src/claro/projection/value.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.projection.value 2 | (:require [claro.projection.protocols :as pr] 3 | [claro.data.error :refer [with-error?]] 4 | [claro.projection 5 | [objects :refer [leaf]] 6 | [maps :as maps]])) 7 | 8 | ;; ## Record 9 | 10 | (deftype ValueProjection [value template] 11 | pr/Projection 12 | (project [_ value'] 13 | (with-error? value' 14 | (if template 15 | (pr/project template value) 16 | value))) 17 | 18 | maps/MapValueProjection 19 | (project-value [this value] 20 | (pr/project this value)) 21 | (project-missing-value [this _] 22 | (if template 23 | (pr/project template value) 24 | value))) 25 | 26 | (defmethod print-method ValueProjection 27 | [^ValueProjection value ^java.io.Writer w] 28 | (let [t (.-template value)] 29 | (.write w "# ") 35 | (print-method (.-template value) w)) 36 | (.write w ">"))) 37 | 38 | ;; ## Constructor 39 | 40 | (defn value 41 | "A projection that replaces any value it encounters with the given one. 42 | `template` will be used for further projection, if given, otherwise [[leaf]] 43 | is used. 44 | 45 | Note that this projection can be used to inject values into a map, i.e. the 46 | result of 47 | 48 | ```clojure 49 | {:id projection/leaf 50 | :name projection/leaf 51 | :visible? (projection/value true)} 52 | ``` 53 | 54 | will always contain a key `:visible?` with value `true` – even if the 55 | original map had no such key." 56 | [value & [template]] 57 | (->ValueProjection value (or template leaf))) 58 | 59 | (defn ^{:added "0.2.3"} finite-value 60 | "Like [[value]] but will not apply any further projection to the given value. 61 | This means that you can use this to inject arbitrary (but finite!) subtrees 62 | into your data. 63 | 64 | (If you still give a potentially infinite resolvable, you'll hit claro's 65 | resolution limits.)" 66 | [value] 67 | (->ValueProjection value nil)) 68 | -------------------------------------------------------------------------------- /src/claro/runtime.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime 2 | (:require [claro.runtime 3 | [application :refer [apply-resolved-batches]] 4 | [impl :as impl] 5 | [inspection :refer [inspect-resolvables]] 6 | [mutation :refer [select-mutation-batches]] 7 | [resolution :refer [resolve-batches!]] 8 | [selection :refer [select-resolvable-batches]] 9 | [state :as state]]) 10 | (:refer-clojure :exclude [run!])) 11 | 12 | (defn- resolve-batches-in-state 13 | [state] 14 | (let [impl (state/impl state) 15 | resolve-deferred (resolve-batches! state)] 16 | (->> (fn [resolvable->value] 17 | (let [value (apply-resolved-batches state resolvable->value)] 18 | (state/finalize state resolvable->value value))) 19 | (impl/chain1 impl resolve-deferred)))) 20 | 21 | (defn run-step 22 | "Run a single resolution step. Return a deferred value with the 23 | state after resolution." 24 | [state] 25 | (let [resolvables (inspect-resolvables state)] 26 | (if-not (empty? resolvables) 27 | (let [batches (or (select-mutation-batches state resolvables) 28 | (select-resolvable-batches state resolvables))] 29 | (if (seq batches) 30 | (-> state 31 | (state/set-batches batches) 32 | (resolve-batches-in-state)) 33 | (state/done state))) 34 | (state/done state)))) 35 | 36 | (defn- run-step-and-recur 37 | "Run a single resolution step, return 'recur' value if resolution is not 38 | done." 39 | [state] 40 | (let [impl (state/impl state) 41 | state-deferred (run-step state)] 42 | (->> (fn [state'] 43 | (if-not (state/done? state') 44 | (impl/recur impl state') 45 | state')) 46 | (impl/chain1 impl state-deferred)))) 47 | 48 | (defn run!* 49 | "Like [[run!]] but will produce the complete resolution state." 50 | [{:keys [impl] :as opts} value] 51 | {:pre [(every? 52 | (comp fn? opts) 53 | [:select-fn :inspect-fn :resolve-fn :apply-fn])]} 54 | (->> (state/initialize opts value) 55 | (impl/loop impl run-step-and-recur))) 56 | 57 | (defn run! 58 | "Run the resolution engine on the given value. `opts` is a map of: 59 | 60 | - `:inspect-fn`: a function that, given a value, returns a seq of all 61 | available resolvables within that value, 62 | - `:select-fn`: a function that, given a seq of resolvable classes returns 63 | those to resolve during the next step, 64 | - `:mutation?`: a function that, given a seq of resolvables, returns whether 65 | or not said resolvable represents a mutation, 66 | - `:resolve-fn`: a function that given a seq of resolvables of the same class 67 | returns a manifold deferred with resolved values in-order, 68 | - `:apply-fn`: a function that takes the original value, as well as a map 69 | of resolvable -> resolved value pairs, and returns a map of `:value` and 70 | `:resolvables`, where `:value` is the now-more-resolved value for the next 71 | - `:cost-fn`: a function that, given a seq of resolvables of the same class, 72 | returns a number describing resolution cost, 73 | - `:partition-fn`: a function that, given a seq of same-class resolvables, 74 | creates disjunct batches of resolvables to independently resolve, 75 | - `:max-cost`: the maximum resolution cost, triggering an 76 | `IllegalStateException` when exceeded. 77 | 78 | Returns a manifold deferred with the resolved result." 79 | [{:keys [impl] :as opts} value] 80 | (impl/chain1 81 | impl 82 | (run!* opts value) 83 | :value)) 84 | -------------------------------------------------------------------------------- /src/claro/runtime/application.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.application 2 | (:require [claro.runtime.state :as state])) 3 | 4 | (defn apply-resolved-batches 5 | [state resolvable->value] 6 | (let [apply-fn (state/opt state :apply-fn) 7 | value (state/value state)] 8 | (apply-fn value resolvable->value))) 9 | -------------------------------------------------------------------------------- /src/claro/runtime/caching.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.caching 2 | (:require [claro.runtime.impl :as impl])) 3 | 4 | (defn init-cache 5 | "Initialize the cache." 6 | [_] 7 | (transient {})) 8 | 9 | (defn update-cache 10 | "Update the cache." 11 | [_ cache resolvable->value] 12 | (reduce 13 | #(assoc! % (key %2) (val %2)) 14 | cache 15 | resolvable->value)) 16 | 17 | (defn read-cache 18 | [_ cache resolvable not-found] 19 | (get cache resolvable not-found)) 20 | -------------------------------------------------------------------------------- /src/claro/runtime/impl.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.impl 2 | (:refer-clojure :exclude [loop recur])) 3 | 4 | ;; ## Rationale 5 | ;; 6 | ;; The runtime should provide resolution capabilities independent of the 7 | ;; actual deferred implementation (manifold, core.async, promises). So, 8 | ;; we need to inject the following functionality: 9 | ;; 10 | ;; - `:deferrable?`: is the value compatible with the deferred impl, 11 | ;; - `->deferred`: convert a value to an instance of the deferred impl, 12 | ;; - `chain`: add postprocessing to a deferred, 13 | ;; - `zip`: concatenate results of multiple deferreds, 14 | ;; - `loop-fn`: run's a function as long as it returns a value created by `:recur-fn`, 15 | ;; - `recur-fn`: advices `:loop-fn` to continue the loop. 16 | ;; 17 | ;; This should enable usage of claro with any kind of deferred library, esp. 18 | ;; ClojureScript ones, without any further adjustments. 19 | 20 | (defn ->deferred-impl 21 | [{:keys [deferrable? 22 | deferred? 23 | ->deferred 24 | value 25 | chain 26 | catch 27 | zip 28 | run 29 | loop-fn 30 | recur-fn] :as impl}] 31 | {:pre [(fn? deferrable?) 32 | (fn? deferred?) 33 | (fn? ->deferred) 34 | (fn? value) 35 | (fn? chain) 36 | (fn? catch) 37 | (fn? zip) 38 | (fn? run) 39 | (fn? loop-fn) 40 | (fn? recur-fn)]} 41 | impl) 42 | 43 | (defn deferrable? 44 | [{:keys [deferrable?]} value] 45 | (deferrable? value)) 46 | 47 | (defn deferred? 48 | [{:keys [deferred?]} value] 49 | (deferred? value)) 50 | 51 | (defn ->deferred 52 | [{:keys [->deferred]} value] 53 | (->deferred value)) 54 | 55 | (defn value 56 | [{:keys [value]} v] 57 | (value v)) 58 | 59 | (defn chain 60 | [{:keys [chain]} value & fs] 61 | (chain value fs)) 62 | 63 | (defn chain1 64 | [{:keys [chain]} value f] 65 | (chain value [f])) 66 | 67 | (defn zip 68 | [{:keys [zip]} deferreds] 69 | (zip deferreds)) 70 | 71 | (defn run 72 | [{:keys [run]} f] 73 | (run f)) 74 | 75 | (defn loop 76 | [{:keys [loop-fn]} f initial-state] 77 | (loop-fn f initial-state)) 78 | 79 | (defn recur 80 | [{:keys [recur-fn]} new-state] 81 | (recur-fn new-state)) 82 | 83 | (defn catch 84 | [{:keys [catch]} value f] 85 | (catch value f)) 86 | -------------------------------------------------------------------------------- /src/claro/runtime/impl/core_async.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.impl.core-async 2 | (:require 3 | #?(:clj [clojure.core.async :as async :refer [channel 17 | [value] 18 | (if (channel? value) 19 | value 20 | (async/go value))) 21 | 22 | (defn- chain 23 | [ch fs] 24 | (if (seq fs) 25 | (let [[f & rst] fs] 26 | (async/go 27 | (let [next-ch (if (channel? ch) 28 | (f (channel ch))) 32 | 33 | (defn- catch-exceptions 34 | [ch f] 35 | (throw 36 | (Exception. 37 | "'catch' not supported for core.async deferrables."))) 38 | 39 | (defn- zip 40 | [chs] 41 | (async/go-loop 42 | [chs (seq chs) 43 | result []] 44 | (if chs 45 | (let [value (Recur state)) 56 | 57 | (defn- async-loop 58 | [f initial-state] 59 | (async/go-loop 60 | [state initial-state] 61 | (let [step (f state) 62 | value (if (channel? step) (deferred ->channel 73 | :value #(async/go %) 74 | :chain chain 75 | :catch catch-exceptions 76 | :zip zip 77 | :run #(async/thread (%)) 78 | :loop-fn async-loop 79 | :recur-fn async-recur}) 80 | -------------------------------------------------------------------------------- /src/claro/runtime/impl/manifold.clj: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.impl.manifold 2 | (:require [manifold.deferred :as d])) 3 | 4 | (def impl 5 | {:deferrable? d/deferrable? 6 | :deferred? d/deferred? 7 | :->deferred d/->deferred 8 | :value d/success-deferred 9 | :chain #(apply d/chain % %2) 10 | :catch d/catch 11 | :zip #(apply d/zip %) 12 | :run #(d/future (%)) 13 | :loop-fn #(d/loop [state %2] (%1 state)) 14 | :recur-fn #(d/recur %)}) 15 | -------------------------------------------------------------------------------- /src/claro/runtime/inspection.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.inspection 2 | (:require [claro.runtime.state :as state])) 3 | 4 | (defn inspect-resolvables 5 | "Analyze the given value and collect all (remaining) resolvables." 6 | [state] 7 | (let [inspect-fn (state/opt state :inspect-fn)] 8 | (inspect-fn (state/value state)))) 9 | -------------------------------------------------------------------------------- /src/claro/runtime/mutation.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.mutation 2 | (:require [claro.runtime.state :as state])) 3 | 4 | (defn- assert-single-mutation! 5 | [mutations] 6 | (when (next mutations) 7 | (throw 8 | (IllegalStateException. 9 | (format 10 | "only one mutation can be resolved per engine run, given %d: %s" 11 | (count mutations) 12 | (pr-str mutations))))) 13 | mutations) 14 | 15 | (defn- throw-unexpected-mutations! 16 | [mutations] 17 | (throw 18 | (IllegalStateException. 19 | (str "can only resolve mutations on the top-level: " 20 | (pr-str (vec mutations)))))) 21 | 22 | (defn select-mutation-batches 23 | [state resolvables] 24 | (when-let [mutation? (state/opt state :mutation?)] 25 | (when-let [mutations (seq (distinct (filter mutation? resolvables)))] 26 | (if (state/first-iteration? state) 27 | [(assert-single-mutation! mutations)] 28 | (throw-unexpected-mutations! mutations))))) 29 | -------------------------------------------------------------------------------- /src/claro/runtime/resolution.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.resolution 2 | (:require [claro.runtime.impl :as impl] 3 | [claro.runtime.state :as state])) 4 | 5 | (defn- assert-deferrable 6 | "Make sure the given value is a deferrable, throw `IllegalStateException` 7 | otherwise." 8 | [impl batch value] 9 | (when-not (impl/deferrable? impl value) 10 | (throw 11 | (IllegalStateException. 12 | (str "'resolve-fn' has to return a deferrable for class " 13 | (-> batch first class (.getName)) 14 | ", returned:" 15 | (-> value class (.getName)))))) 16 | value) 17 | 18 | (defn- generate-deferred 19 | "Create a function that takes batch of resolvables and generates a deferred 20 | containing the in-order results." 21 | [state batch] 22 | (let [resolve-fn (state/opt state :resolve-fn) 23 | env (state/opt state :env {}) 24 | impl (state/impl state)] 25 | (some->> batch 26 | (resolve-fn env) 27 | (assert-deferrable impl batch) 28 | (impl/->deferred impl)))) 29 | 30 | (defn- assert-every-resolution! 31 | [batch resolved-values] 32 | {:pre [(map? resolved-values)]} 33 | (let [missing (keep 34 | #(when (not (contains? resolved-values %)) 35 | %) 36 | batch)] 37 | (when (seq missing) 38 | (throw 39 | (IllegalStateException. 40 | (str "some of the values in the current batch were not resolved.\n" 41 | "missing: " (pr-str (vec missing)) "\n" 42 | "in: " (pr-str (vec batch)) "\n" 43 | "out: " (pr-str resolved-values)))))) 44 | resolved-values) 45 | 46 | (defn- resolve-batch! 47 | "Returns a deferred representing the resolution of the given batch. 48 | `resolve-fn` has to return a deferred with the resolution results 49 | in-order." 50 | [state batch] 51 | (impl/chain1 52 | (state/impl state) 53 | (generate-deferred state batch) 54 | #(assert-every-resolution! batch %))) 55 | 56 | (defn- resolve-batches-with-cache-step! 57 | [state result batch] 58 | (loop [batch batch 59 | result result 60 | uncached (transient [])] 61 | (if (seq batch) 62 | (let [[h & rst] batch 63 | v (state/from-cache state h ::miss)] 64 | (if (not= v ::miss) 65 | (recur rst (assoc-in result [:cached h] v) uncached) 66 | (recur rst result (conj! uncached h)))) 67 | (if-let [rs (seq (persistent! uncached))] 68 | (update result :ds conj (resolve-batch! state rs)) 69 | result)))) 70 | 71 | (defn- resolve-batches-with-cache! 72 | [state] 73 | (reduce 74 | #(resolve-batches-with-cache-step! state %1 %2) 75 | {:cached {}, :ds []} 76 | (state/batches state))) 77 | 78 | (defn resolve-batches! 79 | "Resolve the given batches, returning a deferred with a map of 80 | original value -> resolved value pairs." 81 | [state] 82 | (let [impl (state/impl state) 83 | {:keys [cached ds]} (resolve-batches-with-cache! state) 84 | zipped (impl/zip impl ds)] 85 | (impl/chain1 impl zipped #(into cached %)))) 86 | -------------------------------------------------------------------------------- /src/claro/runtime/selection.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.selection 2 | (:require [claro.runtime.state :as state])) 3 | 4 | (defn- assert-class-selected! 5 | "Make sure at least a single class was selected, otherwise throw 6 | an `IllegalStateException`." 7 | [classes] 8 | (when (empty? classes) 9 | (throw 10 | (IllegalStateException. 11 | "resolvables were available but 'select-fn' did not choose any."))) 12 | classes) 13 | 14 | (defn- assert-classes-valid! 15 | "Make sure all selected classes were actually candidates, otherwise 16 | throw an `IllegalStateException`." 17 | [resolvables classes] 18 | (doseq [class classes] 19 | (when-not (contains? resolvables class) 20 | (throw 21 | (IllegalStateException. 22 | (str "'select-fn' chose an unknown resolvable class:" class))))) 23 | classes) 24 | 25 | (defn select-resolvable-batches 26 | "Use the given `select-fn` (seq of classes -> seq of classes) and 27 | `inspect-fn` (value -> seq of resolvables) to collect batches of 28 | resolvables. Returns a seq of such batches." 29 | [state resolvables] 30 | (let [select-fn (state/opt state :select-fn) 31 | partition-fn (state/opt state :partition-fn vector) 32 | by-class (group-by class (distinct resolvables))] 33 | (->> (select-fn by-class) 34 | (assert-class-selected!) 35 | (assert-classes-valid! by-class) 36 | (mapcat (comp partition-fn by-class)) 37 | (vec)))) 38 | -------------------------------------------------------------------------------- /src/claro/runtime/state.clj: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.state 2 | (:require [claro.runtime.caching :as caching])) 3 | 4 | ;; ## Initialization 5 | 6 | (defn initialize 7 | [opts value] 8 | (transient 9 | {:opts opts 10 | :value value 11 | :done? false 12 | :cache (caching/init-cache opts) 13 | :iteration 0 14 | :cost 0 15 | :batches nil})) 16 | 17 | ;; ## Access 18 | 19 | (defn opt 20 | [{:keys [opts]} k & [default]] 21 | (get opts k default)) 22 | 23 | (defn impl 24 | [state] 25 | (opt state :impl)) 26 | 27 | (defn value 28 | [{:keys [value]}] 29 | value) 30 | 31 | (defn batches 32 | [{:keys [batches]}] 33 | batches) 34 | 35 | (defn first-iteration? 36 | [{:keys [iteration]}] 37 | (zero? iteration)) 38 | 39 | (defn done? 40 | [{:keys [done?]}] 41 | done?) 42 | 43 | (defn done 44 | [state] 45 | (assoc! state :done? true)) 46 | 47 | ;; ## Batches 48 | 49 | (defn assert-cost-limit 50 | [{:keys [opts cost] :as state}] 51 | (let [{:keys [max-cost check-cost?] 52 | :or {max-cost 256, check-cost? true}} opts] 53 | (when (and check-cost? (> cost max-cost)) 54 | (throw 55 | (IllegalStateException. 56 | (format "resolution has exceeded maximum cost: %s > %s" 57 | cost 58 | max-cost))))) 59 | state) 60 | 61 | (defn- update-cost 62 | [{:keys [opts cost batches] :as state}] 63 | (let [{:keys [cost-fn] :or {cost-fn count}} opts] 64 | (->> (reduce 65 | (fn [cost batch] 66 | (+ cost (cost-fn batch))) 67 | cost batches) 68 | (assoc! state :cost) 69 | (assert-cost-limit)))) 70 | 71 | (defn set-batches 72 | [state batches] 73 | (-> state 74 | (assoc! :batches batches) 75 | (update-cost))) 76 | 77 | ;; ## Cache 78 | 79 | (defn from-cache 80 | [{:keys [opts cache]} resolvable not-found] 81 | (caching/read-cache opts cache resolvable not-found)) 82 | 83 | ;; ## Finalization 84 | 85 | (defn- update-cache 86 | [{:keys [opts cache] :as state} resolvable->value] 87 | (let [cache' (caching/update-cache opts cache resolvable->value)] 88 | (assoc! state :cache cache'))) 89 | 90 | (defn- update-iteration-count 91 | [{:keys [:iteration] :as state}] 92 | (assoc! state :iteration (inc iteration))) 93 | 94 | (defn- update-value 95 | [state new-value] 96 | (assoc! state :value new-value)) 97 | 98 | (defn finalize 99 | [state resolvable->value value] 100 | (-> state 101 | (update-value value) 102 | (update-cache resolvable->value) 103 | (update-iteration-count))) 104 | -------------------------------------------------------------------------------- /test/claro/data/error_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.error-test 2 | (:require [clojure.test.check 3 | [properties :as prop] 4 | [generators :as gen] 5 | [clojure-test :refer [defspec]]] 6 | [claro.data.error :refer :all])) 7 | 8 | ;; ## Operations 9 | 10 | (def err 11 | #(error (str %2) {:current-value %1})) 12 | 13 | (def operations 14 | {`+ + 15 | `- - 16 | `* * 17 | `err err}) 18 | 19 | (def gen-operation 20 | (gen/let [op (gen/elements (keys operations)) 21 | arg gen/int] 22 | (list op arg))) 23 | 24 | (def gen-operations 25 | (gen/vector gen-operation)) 26 | 27 | (defn expected-result 28 | [ops call-fn value] 29 | (if-let [[[op arg] & rst] (seq ops)] 30 | (let [f (get operations op) 31 | result (call-fn f value arg)] 32 | (if (error? result) 33 | result 34 | (recur rst call-fn result))) 35 | value)) 36 | 37 | (defn equals? 38 | [v1 v2] 39 | (if (and (error? v1) (error? v2)) 40 | (and (= (error-message v1) (error-message v2)) 41 | (= (error-data v1) (error-data v2))) 42 | (= v1 v2))) 43 | 44 | ;; ## Tests 45 | 46 | (defspec t-unless-error-> 100 47 | (prop/for-all 48 | [initial-value gen/int 49 | operations gen-operations] 50 | (equals? 51 | (expected-result operations #(%1 %2 %3) initial-value) 52 | (eval `(unless-error-> ~initial-value ~@operations))))) 53 | 54 | (defspec t-unless-error->> 100 55 | (prop/for-all 56 | [initial-value gen/int 57 | operations gen-operations] 58 | (equals? 59 | (expected-result operations #(%1 %3 %2) initial-value) 60 | (eval `(unless-error->> ~initial-value ~@operations))))) 61 | -------------------------------------------------------------------------------- /test/claro/data/ops/collections_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.collections-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.data :as data] 10 | [claro.data.ops.collections :as ops] 11 | [claro.engine.fixtures :refer [make-engine]])) 12 | 13 | ;; ## Resolvable 14 | 15 | (defrecord Identity [v] 16 | data/Resolvable 17 | (resolve! [_ _] 18 | v)) 19 | 20 | (def gen-wrapper 21 | (gen/elements 22 | [->Identity 23 | identity])) 24 | 25 | (def gen-collection 26 | (gen/let [nums (gen/vector gen/int) 27 | num-wrappers (gen/vector gen-wrapper (count nums)) 28 | outer-wrapper gen-wrapper] 29 | (gen/return 30 | {:nums nums 31 | :resolvable (outer-wrapper 32 | (map #(%1 %2) num-wrappers nums))}))) 33 | 34 | ;; ## Tests 35 | 36 | (defspec t-map-with-single-collection (test/times 100) 37 | (let [run!! (comp deref (make-engine))] 38 | (prop/for-all 39 | [{:keys [nums resolvable]} gen-collection] 40 | (= (map inc nums) (run!! (ops/map inc resolvable)))))) 41 | 42 | (defspec t-map-with-multiple-collections (test/times 100) 43 | (let [run!! (comp deref (make-engine))] 44 | (prop/for-all 45 | [{nums1 :nums, r1 :resolvable} gen-collection 46 | {nums2 :nums, r2 :resolvable} gen-collection] 47 | (= (map + nums1 nums2) (run!! (ops/map + r1 r2)))))) 48 | 49 | (defspec t-first (test/times 50) 50 | (let [run!! (comp deref (make-engine))] 51 | (prop/for-all 52 | [{:keys [nums resolvable]} gen-collection] 53 | (= (first nums) (run!! (ops/first resolvable)))))) 54 | 55 | (defspec t-nth (test/times 50) 56 | (let [run!! (comp deref (make-engine))] 57 | (prop/for-all 58 | [{:keys [nums resolvable]} gen-collection 59 | n gen/pos-int 60 | wrapper (gen/elements [identity ->Identity])] 61 | (let [value (ops/nth resolvable (wrapper n))] 62 | (if (< n (count nums)) 63 | (= (nth nums n) (run!! value)) 64 | (boolean 65 | (is 66 | (thrown-with-msg? 67 | java.lang.IllegalArgumentException 68 | #"index \d+ out of bounds when calling 'nth'" 69 | (run!! value))))))))) 70 | 71 | (defspec t-take (test/times 50) 72 | (let [run!! (comp deref (make-engine))] 73 | (prop/for-all 74 | [{:keys [nums resolvable]} gen-collection 75 | n gen/pos-int] 76 | (= (take n nums) (run!! (ops/take n resolvable)))))) 77 | 78 | (defspec t-drop (test/times 50) 79 | (let [run!! (comp deref (make-engine))] 80 | (prop/for-all 81 | [{:keys [nums resolvable]} gen-collection 82 | n gen/pos-int] 83 | (= (drop n nums) (run!! (ops/drop n resolvable)))))) 84 | -------------------------------------------------------------------------------- /test/claro/data/ops/fmap_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.fmap-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.data :as data] 10 | [claro.data.ops.fmap :as ops] 11 | [claro.engine.fixtures :refer [make-engine]])) 12 | 13 | ;; ## Resolvable 14 | 15 | (defrecord Identity [v] 16 | data/Resolvable 17 | (resolve! [_ _] 18 | v)) 19 | 20 | (def gen-nums 21 | (gen/not-empty 22 | (gen/vector 23 | (gen/one-of 24 | [gen/int 25 | (gen/fmap ->Identity gen/int)])))) 26 | 27 | (def gen-op 28 | (gen/elements [vector + hash-set])) 29 | 30 | ;; ## Tests 31 | 32 | (defspec t-fmap (test/times 100) 33 | (let [run!! (comp deref (make-engine))] 34 | (prop/for-all 35 | [nums gen-nums, op gen-op] 36 | (let [value (apply ops/fmap op nums)] 37 | (= (apply op (run!! nums)) (run!! value)))))) 38 | 39 | (defspec t-fmap-on (test/times 100) 40 | (let [run!! (comp deref (make-engine))] 41 | (prop/for-all 42 | [nums gen-nums, op gen-op] 43 | (let [value (apply ops/fmap-on #(every? number? %&) op nums)] 44 | (= (apply op (run!! nums)) (run!! value)))))) 45 | 46 | (defspec t-fmap! (test/times 100) 47 | (let [run!! (comp deref (make-engine))] 48 | (prop/for-all 49 | [nums gen-nums, op gen-op] 50 | (let [value (apply ops/fmap! op nums)] 51 | (= (apply op (run!! nums)) (run!! value)))))) 52 | -------------------------------------------------------------------------------- /test/claro/data/ops/maps_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.maps-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.data :as data] 10 | [claro.data.ops.maps :as ops] 11 | [claro.engine.fixtures :refer [make-engine]])) 12 | 13 | ;; ## Generator 14 | 15 | (defn- gen-nested-map 16 | [leave-gen] 17 | (->> (gen/recursive-gen 18 | #(gen/map gen/string-ascii %) 19 | leave-gen) 20 | (gen/such-that map?))) 21 | 22 | (defn- action-gen 23 | [k raw-op claro-op & gens] 24 | (->> (apply gen/tuple gens) 25 | (gen/fmap 26 | (fn [values] 27 | {:form (list* k '% values) 28 | :raw-action #(apply raw-op % values) 29 | :action #(apply claro-op % values)})))) 30 | 31 | (let [k gen/string-ascii 32 | ks (gen/vector k 1 10) 33 | v (gen/return {})] 34 | (def ^:private gen-actions 35 | (gen/vector 36 | (gen/one-of 37 | [(action-gen 'assoc assoc ops/assoc k v) 38 | (action-gen 'assoc-in assoc-in ops/assoc-in ks v) 39 | (action-gen 'update update ops/update k (gen/fmap constantly v)) 40 | (action-gen 'update-in update-in ops/update-in ks (gen/fmap constantly v)) 41 | (action-gen 'select-keys select-keys ops/select-keys ks) 42 | (action-gen 'get get ops/get k) 43 | (action-gen 'get-in get-in ops/get-in ks)]) 44 | 1 20))) 45 | 46 | ;; ## Application 47 | 48 | (defn- reduce-actions 49 | [initial-value k actions] 50 | (reduce #(%2 %1) initial-value (map k actions))) 51 | 52 | ;; ## Tests 53 | 54 | (defrecord Identity [v] 55 | data/Resolvable 56 | (resolve! [_ _] 57 | v)) 58 | 59 | (defspec t-map-ops (test/times 100) 60 | (prop/for-all 61 | [actions gen-actions 62 | unresolved-value (gen-nested-map (gen/elements [{} (->Identity {})]))] 63 | (let [run! (make-engine) 64 | resolved-value @(run! unresolved-value) 65 | value (reduce-actions unresolved-value :action actions)] 66 | (or (= value ::error) 67 | (let [expected (reduce-actions resolved-value :raw-action actions) 68 | result @(run! value)] 69 | (= result expected)))))) 70 | -------------------------------------------------------------------------------- /test/claro/data/ops/then_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.ops.then-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.data :as data] 10 | [claro.data.ops :as ops] 11 | [claro.engine.fixtures :refer [make-engine]])) 12 | 13 | ;; ## Generator 14 | 15 | (defrecord Identity [v] 16 | data/Resolvable 17 | (resolve! [_ _] 18 | v)) 19 | 20 | (def gen-resolvable 21 | (let [not-nan? #(not (and (number? %) (Double/isNaN %)))] 22 | (->> gen/simple-type 23 | (gen/such-that not-nan?) 24 | (gen/fmap ->Identity)))) 25 | 26 | (def gen-nested-resolvable 27 | (gen/recursive-gen 28 | (fn [g] 29 | (gen/not-empty 30 | (gen/one-of 31 | [(gen/vector g) 32 | (gen/set g) 33 | (gen/list g) 34 | (gen/map g g)]))) 35 | gen-resolvable)) 36 | 37 | (deftype Preserve [v]) 38 | 39 | ;; ## Tests 40 | 41 | (defspec t-blocking-composition (test/times 50) 42 | (prop/for-all 43 | [resolvable gen-nested-resolvable] 44 | (let [run! (make-engine) 45 | value (ops/then! resolvable (juxt identity ->Preserve)) 46 | [result preserved] @(run! value)] 47 | (= result (.-v preserved))))) 48 | 49 | (defspec t-eager-composition (test/times 50) 50 | (prop/for-all 51 | [resolvable gen-nested-resolvable] 52 | (let [run! (make-engine) 53 | value (ops/then resolvable (juxt identity ->Preserve)) 54 | [result preserved] @(run! value) 55 | observed (.-v preserved)] 56 | (and (is (not= result observed)) 57 | (is (= result @(run! observed))))))) 58 | 59 | (defspec t-conditional-composition (test/times 100) 60 | (prop/for-all 61 | [resolvable0 gen-resolvable 62 | resolvable1 gen-resolvable] 63 | (let [run! (make-engine) 64 | predicate (fn [{:keys [x y]}] 65 | (and (not (instance? Identity x)) 66 | (not (instance? Identity y)) 67 | (not= (class x) (class y)))) 68 | action (juxt :x :y) 69 | value (ops/on {:x resolvable0, :y resolvable1} predicate action)] 70 | (if (= (-> resolvable0 :v class) (-> resolvable1 :v class)) 71 | (boolean 72 | (is (thrown-with-msg? 73 | IllegalStateException 74 | #"predicate .+ does not hold for fully resolved" 75 | @(run! value)))) 76 | (is (= [(:v resolvable0) (:v resolvable1)] 77 | @(run! value))))))) 78 | 79 | (deftest t-composition 80 | (let [resolvable (->Identity "string") 81 | c (count (:v resolvable)) 82 | run! (make-engine)] 83 | (testing "blocking composition." 84 | (is (= {:x c} @(run! (ops/then! {:x resolvable} update :x count))))) 85 | (testing "eager composition." 86 | (is 87 | (thrown-with-msg? 88 | Exception 89 | #"count not supported" 90 | @(run! (ops/then {:x resolvable} update :x count))))) 91 | (testing "conditional composition." 92 | (is (= {:x c} @(run! (ops/on {:x resolvable} #(-> % :x string?) update :x count))))) 93 | (testing "built-in update." 94 | (is (= {:x c} @(run! (ops/update {:x resolvable} :x count))))))) 95 | 96 | (defspec t-nested-composition (test/times 100) 97 | (prop/for-all 98 | [resolvable gen-resolvable 99 | nesting-level gen/nat 100 | chain-fn (gen/elements [ops/then ops/then!])] 101 | (let [run! (make-engine) 102 | value (chain-fn 103 | (nth (iterate ->Identity resolvable) nesting-level) 104 | ->Preserve) 105 | result @(run! value)] 106 | (is (= (:v resolvable) (.-v result)))))) 107 | -------------------------------------------------------------------------------- /test/claro/data/transform_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.transform-test 2 | (:require [clojure.test.check 3 | [properties :as prop] 4 | [generators :as gen] 5 | [clojure-test :refer [defspec]]] 6 | [claro.engine :as engine] 7 | [claro.data :as data])) 8 | 9 | ;; ## Resolvables 10 | 11 | (defrecord IncResolvable [v] 12 | data/BatchedResolvable 13 | (resolve-batch! [_ _ vs] 14 | (map (comp inc :v) vs))) 15 | 16 | (defrecord RangeResolvable [n] 17 | data/Resolvable 18 | (resolve! [_ _] 19 | (range n))) 20 | 21 | (defrecord OtherRangeResolvable [n] 22 | data/Resolvable 23 | (resolve! [_ _] 24 | (range n))) 25 | 26 | (defrecord Point [x y z] 27 | data/Resolvable 28 | (resolve! [this _] 29 | (into {} this))) 30 | 31 | (defrecord OtherPoint [x y z] 32 | data/Resolvable 33 | (resolve! [this _] 34 | (into {} this))) 35 | 36 | ;; ## Transform 37 | 38 | (data/extend-list-transform 39 | RangeResolvable 40 | [->IncResolvable] 41 | 42 | OtherRangeResolvable 43 | [inc]) 44 | 45 | (data/extend-transform 46 | Point 47 | {:x' [inc :x] 48 | :y' :y 49 | :sum (fn [{:keys [x y z]}] 50 | (+ x y z))} 51 | 52 | OtherPoint 53 | {:x' [->IncResolvable :x] 54 | :y' :y 55 | :sum [+ :x :y :z]}) 56 | 57 | ;; ## Tests 58 | 59 | (defspec t-extend-list-transform 100 60 | (prop/for-all 61 | [n gen/s-pos-int 62 | f (gen/elements [->RangeResolvable ->OtherRangeResolvable])] 63 | (= (map inc (range n)) 64 | (engine/run!! (f n))))) 65 | 66 | (defspec t-extend-transform 100 67 | (prop/for-all 68 | [x gen/int 69 | y gen/int 70 | z gen/int 71 | f (gen/elements [->Point ->OtherPoint])] 72 | (= {:x x, :y y, :z z, :sum (+ x y z), :x' (inc x), :y' y} 73 | (engine/run!! (f x y z))))) 74 | -------------------------------------------------------------------------------- /test/claro/data/tree_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.data.tree-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [clojure.set :as set] 10 | [claro.data.protocols :as p] 11 | [claro.data.tree :as tree])) 12 | 13 | ;; ## Generator 14 | 15 | (defrecord R [x] 16 | p/Resolvable) 17 | 18 | (def gen-resolvables 19 | (gen/fmap 20 | (fn [length] 21 | (set (repeatedly length #(->R (rand-int 1000))))) 22 | gen/s-pos-int)) 23 | 24 | (defn gen-resolvable-tree 25 | [rs] 26 | (gen/recursive-gen 27 | (fn [g] 28 | (gen/one-of 29 | [(gen/list g) 30 | (gen/set g) 31 | (gen/vector g) 32 | (gen/map g g)])) 33 | (gen/one-of [(gen/elements rs) gen/string-ascii]))) 34 | 35 | (def gen-tree 36 | (->> (fn [rs] 37 | (gen/tuple 38 | (gen/return rs) 39 | (gen-resolvable-tree rs))) 40 | (gen/bind gen-resolvables) 41 | (gen/fmap 42 | (fn [[rs tree]] 43 | [rs (tree/wrap-tree tree)])))) 44 | 45 | (def gen-collection 46 | (->> (gen/elements [[] #{}]) 47 | (gen/tuple gen-resolvables) 48 | (gen/fmap 49 | (fn [[rs empty-coll]] 50 | [rs (into empty-coll rs)])))) 51 | 52 | ;; ## Helper 53 | 54 | (defn- ->resolution 55 | [resolvables] 56 | (into {} (map (juxt identity :x) resolvables))) 57 | 58 | (defn- ->partial-resolution 59 | [resolvables ratio] 60 | (->> #(rand-nth (seq resolvables)) 61 | (repeatedly (Math/floor (* (count resolvables) ratio))) 62 | (->resolution))) 63 | 64 | ;; ## No Resolvable Tre 65 | 66 | (let [NaN? #(and (number? %) (Double/isNaN %))] 67 | (def gen-any-non-NaN 68 | "Generator for any value, excluding generation of NaN, b/c NaN breaks equality." 69 | (gen/recursive-gen 70 | gen/container-type 71 | (gen/such-that (complement NaN?) gen/simple-type)))) 72 | 73 | (defspec t-tree-without-resolvables (test/times 100) 74 | (prop/for-all 75 | [value gen-any-non-NaN] 76 | (let [tree (tree/wrap-tree value)] 77 | (= tree value)))) 78 | 79 | ;; ## Resolution 80 | 81 | (defn- attempt-resolution 82 | [tree resolvables] 83 | (or (empty? resolvables) 84 | (let [resolvable->resolved (->partial-resolution resolvables 0.5) 85 | resolved (set (keys resolvable->resolved)) 86 | tree' (p/apply-resolved-values tree resolvable->resolved) 87 | rs (into #{} (p/resolvables tree'))] 88 | (and (is (not-any? resolved rs)) 89 | (is (= rs (set/difference (set resolvables) resolved))))))) 90 | 91 | (defspec t-tree (test/times 200) 92 | (prop/for-all 93 | [[available-resolvables tree] gen-tree] 94 | (let [rs (p/resolvables tree)] 95 | (and (is (every? p/resolvable? rs)) 96 | (is (every? #(contains? available-resolvables %) rs)) 97 | (attempt-resolution tree rs))))) 98 | 99 | ;; ## Collections 100 | 101 | (defspec t-collections (test/times 100) 102 | (prop/for-all 103 | [[available-resolvables coll] gen-collection] 104 | (let [resolvable->value (->resolution available-resolvables) 105 | coll-tree (tree/wrap-tree coll) 106 | result (p/apply-resolved-values coll-tree resolvable->value)] 107 | (and (is (p/resolved? result)) 108 | (is (= (class coll) (class result))) 109 | (or (not (sequential? coll)) (is (= (map :x coll) result))))))) 110 | -------------------------------------------------------------------------------- /test/claro/engine/caching_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.engine.caching-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data :as data] 11 | [claro.data.tree :as tree])) 12 | 13 | ;; ## Generators 14 | 15 | (let [not-nan? #(not (and (number? %) (Double/isNaN %))) 16 | gen-simple (gen/one-of 17 | [gen/int 18 | gen/large-integer 19 | (gen/such-that not-nan? gen/double) 20 | gen/char 21 | gen/string-ascii 22 | gen/ratio 23 | gen/boolean]) 24 | gen-any (gen/frequency 25 | [[10 gen-simple] 26 | [1 (gen/return nil)]])] 27 | (def gen-ephemeral-resolvable 28 | (gen/let [values (gen/not-empty (gen/vector gen-any))] 29 | (gen/return 30 | (let [data (atom values)] 31 | (reify data/Resolvable 32 | (resolve! [this _] 33 | (first (swap! data next))))))))) 34 | 35 | (def gen-nesting-depths 36 | (gen/not-empty (gen/vector (gen/fmap #(min 256 %) gen/nat)))) 37 | 38 | (def gen-identical-resolvables 39 | (gen/let [resolvable gen-ephemeral-resolvable 40 | nesting-depths gen-nesting-depths] 41 | (gen/return 42 | (mapv 43 | (fn [nesting-depth] 44 | (reduce 45 | (fn [value n] 46 | (reify Object 47 | 48 | Object 49 | (toString [_] 50 | (str (hash resolvable) ", nested: " n)) 51 | 52 | data/Resolvable 53 | (resolve! [_ _] 54 | value))) 55 | resolvable (range nesting-depth))) 56 | nesting-depths)))) 57 | 58 | ;; ## Test 59 | 60 | (defn- every-identical? 61 | [sq] 62 | (let [v (first sq)] 63 | (every? #(identical? v %) sq))) 64 | 65 | (defspec t-caching (test/times 100) 66 | (let [run! (make-engine)] 67 | (prop/for-all 68 | [resolvables gen-identical-resolvables] 69 | (let [result (is @(run! resolvables))] 70 | (and (is (= (count resolvables) (count result))) 71 | (is (every-identical? result))))))) 72 | -------------------------------------------------------------------------------- /test/claro/engine/fixtures.clj: -------------------------------------------------------------------------------- 1 | (ns claro.engine.fixtures 2 | (:require [claro.engine :as engine])) 3 | 4 | (defn make-engine 5 | ([] (make-engine (atom []) nil)) 6 | ([v] (if (map? v) 7 | (make-engine (atom []) v) 8 | (make-engine v nil))) 9 | ([resolutions more-opts] 10 | (engine/wrap 11 | (engine/engine (merge {:max-cost Long/MAX_VALUE} more-opts)) 12 | (fn [f] 13 | (fn [env batch] 14 | (swap! resolutions 15 | (fnil conj []) 16 | [(class (first batch)) (count batch)]) 17 | (f env batch)))))) 18 | -------------------------------------------------------------------------------- /test/claro/engine/manifold_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.engine.manifold-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.data :as data] 10 | [claro.engine.fixtures :refer [make-engine]] 11 | [manifold.deferred :as d]) 12 | (:import [java.util.concurrent Callable Executors ExecutorService TimeUnit])) 13 | 14 | ;; ## Resolvables 15 | 16 | (defrecord Single [resolver value] 17 | data/Resolvable 18 | (resolve! [_ _] 19 | (resolver value))) 20 | 21 | (defrecord Batched [resolver value] 22 | data/Resolvable 23 | data/BatchedResolvable 24 | (resolve-batch! [_ _ bs] 25 | (resolver (mapv :value bs)))) 26 | 27 | ;; ## Generators 28 | 29 | (defn gen-resolver 30 | [^ExecutorService executor-service] 31 | (gen/elements 32 | {:d/future #(d/future %) 33 | :d/future-with #(d/future-with executor-service %) 34 | :deferred #(doto (d/deferred) (d/success! %)) 35 | :deferred-with #(doto (d/deferred executor-service) (d/success! %)) 36 | :submit #(.submit executor-service ^Callable (constantly %)) 37 | :future #(future %) 38 | :delay #(delay %) 39 | :promise #(doto (promise) (deliver %))})) 40 | 41 | (defn- gen-resolvable 42 | [executor-service] 43 | (gen/let [value gen/simple-type-printable 44 | [type resolver] (gen-resolver executor-service)] 45 | {:resolvable (->Single resolver value) 46 | :type type 47 | :expected value})) 48 | 49 | (defn- gen-resolvables 50 | [executor-service] 51 | (gen/let [values (gen/vector gen/simple-type-printable 1 8) 52 | [type resolver] (gen-resolver executor-service)] 53 | {:resolvable (mapv #(->Single resolver %) values) 54 | :type type 55 | :expected values})) 56 | 57 | (defn- gen-batched-resolvables 58 | [executor-service] 59 | (gen/let [values (gen/vector gen/simple-type-printable 1 8) 60 | [type resolver] (gen-resolver executor-service)] 61 | {:resolvable (mapv #(->Batched resolver %) values) 62 | :type type 63 | :expected values})) 64 | 65 | ;; ## Fixtures 66 | 67 | (def ^:dynamic *executor-service* nil) 68 | 69 | (use-fixtures 70 | :once 71 | (fn [f] 72 | (let [e (Executors/newSingleThreadExecutor)] 73 | (try 74 | (binding [*executor-service* e] 75 | (f)) 76 | (finally 77 | (.shutdown e)))))) 78 | 79 | ;; ## Tests 80 | 81 | (defmacro resolution-prop 82 | [generator] 83 | `(prop/for-all 84 | [~'{:keys [resolvable expected]} (~generator *executor-service*)] 85 | (let [run!# (make-engine) 86 | ~'result @(run!# ~'resolvable)] 87 | (= ~'expected ~'result)))) 88 | 89 | (defspec t-manifold (test/times 100) 90 | (resolution-prop gen-resolvable)) 91 | 92 | (defspec t-mixed-manifold (test/times 100) 93 | (resolution-prop gen-resolvables)) 94 | 95 | (defspec t-batched-manifold (test/times 100) 96 | (resolution-prop gen-batched-resolvables)) 97 | -------------------------------------------------------------------------------- /test/claro/engine/multi_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.engine.multi-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [claro.test :as test] 8 | [claro.engine 9 | [multi :as multi] 10 | [fixtures :refer [make-engine]]] 11 | [claro.data :as data])) 12 | 13 | ;; ## Resolvable 14 | 15 | (defrecord Inc [n] 16 | data/Resolvable 17 | (resolve! [_ {:keys [::state]}] 18 | (swap! state + n))) 19 | 20 | ;; ## Generators 21 | 22 | (def gen-deltas 23 | (gen/vector gen/pos-int)) 24 | 25 | ;; ## Tests 26 | 27 | (defspec t-multi-engine (test/times 100) 28 | (let [base-engine (make-engine) 29 | multi-engine (multi/build base-engine)] 30 | (prop/for-all 31 | [deltas gen-deltas] 32 | (let [resolvables (map ->Inc deltas)] 33 | (= (rest (reductions + 0 deltas)) 34 | @(multi-engine resolvables {:env {::state (atom 0)}})))))) 35 | -------------------------------------------------------------------------------- /test/claro/engine/mutation_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.engine.mutation-test 2 | (:require [clojure.test :refer :all] 3 | [claro.data :as data] 4 | [claro.engine.fixtures :refer [make-engine]])) 5 | 6 | ;; ## Records 7 | 8 | (defrecord CounterValue [] 9 | data/Resolvable 10 | (resolve! [_ {:keys [counter]}] 11 | @counter)) 12 | 13 | (defrecord Increment [] 14 | data/Mutation 15 | data/Resolvable 16 | (resolve! [_ {:keys [counter]}] 17 | (swap! counter inc) 18 | (->CounterValue))) 19 | 20 | (defrecord IncrementTwo [] 21 | data/Mutation 22 | data/Resolvable 23 | (resolve! [_ {:keys [counter]}] 24 | (swap! counter + 2) 25 | (->CounterValue))) 26 | 27 | (defrecord IllegalIncrement [] 28 | data/Resolvable 29 | (resolve! [_ _] 30 | (->Increment))) 31 | 32 | ;; ## Tests 33 | 34 | (deftest t-mutations 35 | (let [counter (atom 0) 36 | run! (make-engine (atom []) {:env {:counter counter}})] 37 | (testing "successful mutation resolution." 38 | (are [value expected] (= expected @(run! value)) 39 | (->Increment) 1 40 | {:result (->Increment)} {:result 2} 41 | [(->Increment) (->Increment)] [3 3])) 42 | (testing "mutation resolution constraint violations." 43 | (are [value re] (thrown-with-msg? 44 | IllegalStateException 45 | re 46 | @(run! value)) 47 | (->IllegalIncrement) 48 | #"can only resolve mutations on the top-level" 49 | 50 | 51 | [(->Increment) (->IncrementTwo)] 52 | #"only one mutation can be resolved per engine run")))) 53 | -------------------------------------------------------------------------------- /test/claro/middleware/cache_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.cache-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [clojure.set :as set] 9 | [claro.test :as test] 10 | [claro.data :as data] 11 | [claro.engine :as engine] 12 | [claro.middleware.cache :refer :all])) 13 | 14 | ;; ## Resolvable 15 | 16 | (defonce counter (atom 0)) 17 | 18 | (defrecord Counter [id] 19 | data/Resolvable 20 | (resolve! [_ _] 21 | (swap! counter inc))) 22 | 23 | (defrecord CounterPure [id] 24 | data/PureResolvable 25 | data/Resolvable 26 | (resolve! [_ _] 27 | (swap! counter inc))) 28 | 29 | ;; ## Cache 30 | 31 | (defrecord AtomCache [cache] 32 | ResolvableCache 33 | (cache-get 34 | [_ _ resolvables] 35 | (swap! cache vary-meta update :gets (fnil + 0) (count resolvables)) 36 | (select-keys @cache resolvables)) 37 | (cache-put 38 | [_ _ result] 39 | (swap! cache vary-meta update :puts (fnil + 0) (count result)) 40 | (swap! cache merge result)) 41 | 42 | clojure.lang.IDeref 43 | (deref [_] 44 | @cache)) 45 | 46 | (defn atom-cache 47 | [] 48 | (->AtomCache (atom {}))) 49 | 50 | ;; ## Helper 51 | 52 | (defn- run-with-cache 53 | [cache value] 54 | (let [run (-> (engine/engine {:check-cost? false}) 55 | (wrap-cache cache))] 56 | @(run value))) 57 | 58 | (defn- submap? 59 | [v1 v2] 60 | (set/subset? (set v1) (set v2))) 61 | 62 | ;; ## Tests 63 | 64 | (defspec t-wrap-cache (test/times 100) 65 | (let [cache (atom-cache)] 66 | (prop/for-all 67 | [values (->> (gen/fmap ->Counter gen/pos-int) 68 | (gen/vector) 69 | (gen/not-empty))] 70 | (let [cache-before @cache 71 | result (run-with-cache cache values) 72 | cache-after @cache] 73 | (and (not (empty? cache-after)) 74 | (submap? cache-before cache-after)))))) 75 | 76 | (defspec t-wrap-cache-ignores-pure-resolvables (test/times 100) 77 | (let [cache (atom-cache)] 78 | (prop/for-all 79 | [values (gen/vector (gen/fmap ->CounterPure gen/pos-int))] 80 | (let [cache-before @cache 81 | result (run-with-cache cache values) 82 | cache-after @cache] 83 | (and (empty? cache-before) 84 | (empty? cache-after)))))) 85 | -------------------------------------------------------------------------------- /test/claro/middleware/deferred_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.deferred-test 2 | (:require [clojure.test :refer :all] 3 | [claro.data :as data] 4 | [claro.engine :as engine] 5 | [claro.middleware.deferred :refer :all] 6 | [manifold.deferred :as d])) 7 | 8 | (defrecord Person [id] 9 | data/Resolvable 10 | (resolve! [_ env] 11 | ::ok)) 12 | 13 | (deftest t-wrap-deferred 14 | (let [run (-> (engine/engine) 15 | (wrap-deferred 16 | #(instance? Person (first %)) 17 | (fn [env deferred] 18 | (d/chain 19 | deferred 20 | #(->> (for [[resolvable result] %] 21 | [resolvable ::uniform]) 22 | (into {}))))))] 23 | (is (= ::ok @(engine/run! (->Person 1)))) 24 | (is (= ::uniform @(run (->Person 1)))))) 25 | -------------------------------------------------------------------------------- /test/claro/middleware/intercept_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.intercept-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.data :as data] 9 | [claro.engine :as engine] 10 | [claro.middleware.intercept :refer :all])) 11 | 12 | ;; ## Resolvables 13 | 14 | (defrecord Value [value intercept-value] 15 | data/Resolvable 16 | (resolve! [_ _] 17 | value)) 18 | 19 | (defrecord PureValue [value intercept-value] 20 | data/PureResolvable 21 | data/Resolvable 22 | (resolve! [_ _] 23 | value)) 24 | 25 | ;; ## Helper 26 | 27 | (defn run-intercept 28 | [value] 29 | (let [run! (-> (engine/engine {:check-cost? false}) 30 | (wrap-intercept 31 | (fn [_ batch] 32 | (->> (for [{:keys [value intercept-value] :as r} batch 33 | :when intercept-value] 34 | [r intercept-value]) 35 | (into {})))))] 36 | @(run! value))) 37 | 38 | ;; ## Tests 39 | 40 | (defspec t-wrap-intercept (test/times 100) 41 | (prop/for-all 42 | [values (->> (gen/tuple gen/int (gen/one-of [gen/int (gen/return nil)])) 43 | (gen/fmap #(apply ->Value %)) 44 | (gen/vector))] 45 | (= (map 46 | (fn [{:keys [intercept-value value]}] 47 | (or intercept-value value)) 48 | values) 49 | (run-intercept values)))) 50 | 51 | (defspec t-wrap-intercept-ignores-pure-resolvables (test/times 100) 52 | (prop/for-all 53 | [values (->> (gen/tuple gen/int (gen/one-of [gen/int (gen/return nil)])) 54 | (gen/fmap #(apply ->PureValue %)) 55 | (gen/vector))] 56 | (= (map :value values) 57 | (run-intercept values)))) 58 | -------------------------------------------------------------------------------- /test/claro/middleware/mock_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.mock-test 2 | (:require [clojure.test :refer :all] 3 | [claro.data :as data] 4 | [claro.engine :as engine] 5 | [claro.middleware.mock :refer :all])) 6 | 7 | ;; ## Resolvables 8 | 9 | (defn- fetch-person 10 | [id] 11 | {:name (str "Person #" id) 12 | :friend-ids (range (inc id) (+ id 10) 3)}) 13 | 14 | (defrecord Person [id] 15 | data/Resolvable 16 | (resolve! [_ env] 17 | (fetch-person id)) 18 | data/Transform 19 | (transform [_ data] 20 | (assoc data :id id))) 21 | 22 | (defrecord BatchedPerson [id] 23 | data/Resolvable 24 | data/BatchedResolvable 25 | (resolve-batch! [_ env people] 26 | (map (comp fetch-person :id) people)) 27 | data/Transform 28 | (transform [_ data] 29 | (assoc data :id id))) 30 | 31 | ;; ## Mock Engines 32 | 33 | (defn- run-mock 34 | [class input] 35 | (let [run (-> (engine/engine) 36 | (wrap-mock 37 | class 38 | (constantly {:name "Me", :friend-ids []})))] 39 | @(run input))) 40 | 41 | (defn- run-mock-result 42 | [class input] 43 | (let [run (-> (engine/engine) 44 | (wrap-mock-result 45 | class 46 | (constantly {:name "Me", :friend-ids []})))] 47 | @(run input))) 48 | 49 | ;; ## Tests 50 | 51 | (deftest t-wrap-mock 52 | (testing "mocking a `Resolvable`." 53 | (let [input (map ->Person (range 5))] 54 | (testing "actual resolution results." 55 | (is (= (map 56 | (fn [{:keys [id]}] 57 | (assoc (fetch-person id) :id id)) 58 | input) 59 | (engine/run!! input)))) 60 | (testing "mocked results." 61 | (is (= (map 62 | (fn [{:keys [id]}] 63 | {:id id 64 | :name "Me" 65 | :friend-ids []}) 66 | input) 67 | (run-mock Person input)))))) 68 | 69 | (testing "mocking a `BatchedResolvable`." 70 | (let [input (map ->BatchedPerson (range 5))] 71 | (testing "actual resolution results." 72 | (is (= (map 73 | (fn [{:keys [id]}] 74 | (assoc (fetch-person id) :id id)) 75 | input) 76 | (engine/run!! input)))) 77 | (testing "mocked results." 78 | (is (= (map 79 | (fn [{:keys [id]}] 80 | {:id id 81 | :name "Me" 82 | :friend-ids []}) 83 | input) 84 | (run-mock BatchedPerson input))))))) 85 | 86 | (deftest t-wrap-mock-result 87 | (testing "mocking a `Resolvable`." 88 | (let [input (map ->Person (range 5))] 89 | (is (= (map 90 | (fn [{:keys [id]}] 91 | {:name "Me" 92 | :friend-ids []}) 93 | input) 94 | (run-mock-result Person input))))) 95 | 96 | (testing "mocking a `BatchedResolvable`." 97 | (let [input (map ->BatchedPerson (range 5))] 98 | (is (= (map 99 | (fn [{:keys [id]}] 100 | {:name "Me" 101 | :friend-ids []}) 102 | input) 103 | (run-mock-result BatchedPerson input)))))) 104 | -------------------------------------------------------------------------------- /test/claro/middleware/transform_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.middleware.transform-test 2 | (:require [clojure.test :refer :all] 3 | [claro.data :as data] 4 | [claro.engine :as engine] 5 | [claro.middleware.transform :refer :all])) 6 | 7 | ;; ## Resolvables 8 | 9 | (defn- fetch-person 10 | [id] 11 | {:name (str "Person #" id) 12 | :friend-ids (range (inc id) (+ id 10) 3)}) 13 | 14 | (defrecord Person [id] 15 | data/Resolvable 16 | (resolve! [_ env] 17 | (fetch-person id)) 18 | data/Transform 19 | (transform [_ data] 20 | (assoc data :id id))) 21 | 22 | (defrecord BatchedPerson [id] 23 | data/Resolvable 24 | data/BatchedResolvable 25 | (resolve-batch! [_ env people] 26 | (map (comp fetch-person :id) people)) 27 | data/Transform 28 | (transform [_ data] 29 | (assoc data :id id))) 30 | 31 | ;; ## Transform Engines 32 | 33 | (defn- run-transform 34 | [class input] 35 | (let [run (-> (engine/engine) 36 | (wrap-transform 37 | #(instance? class %) 38 | #(assoc %2 :__timestamp (System/currentTimeMillis))))] 39 | @(run input))) 40 | 41 | (defn- run-transform-by-class 42 | [class input] 43 | (let [run (-> (engine/engine) 44 | (wrap-transform-by-class 45 | [class] 46 | #(assoc %2 :__timestamp (System/currentTimeMillis))))] 47 | @(run input))) 48 | 49 | ;; ## Tests 50 | 51 | (deftest t-wrap-transform 52 | (let [input {:people (map ->Person (range 5)) 53 | :batched-people (map ->BatchedPerson (range 6 10))}] 54 | (testing "transforming a `Resolvable`." 55 | (let [{:keys [people batched-people]} 56 | (run-transform Person input)] 57 | (is (every? :__timestamp people)) 58 | (is (not-any? :__timestamp batched-people)))) 59 | (testing "transforming a `BatchedResolvable`." 60 | (let [{:keys [people batched-people]} 61 | (run-transform BatchedPerson input)] 62 | (is (not-any? :__timestamp people)) 63 | (is (every? :__timestamp batched-people)))))) 64 | 65 | (deftest t-wrap-transform-by-class 66 | (let [input {:people (map ->Person (range 5)) 67 | :batched-people (map ->BatchedPerson (range 6 10))}] 68 | (testing "transforming a `Resolvable`." 69 | (let [{:keys [people batched-people]} 70 | (run-transform-by-class Person input)] 71 | (is (every? :__timestamp people)) 72 | (is (not-any? :__timestamp batched-people)))) 73 | (testing "transforming a `BatchedResolvable`." 74 | (let [{:keys [people batched-people]} 75 | (run-transform-by-class BatchedPerson input)] 76 | (is (not-any? :__timestamp people)) 77 | (is (every? :__timestamp batched-people)))))) 78 | -------------------------------------------------------------------------------- /test/claro/projection/alias_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.alias-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data.ops.then :refer [then]] 11 | [claro.projection :as projection])) 12 | 13 | (defspec t-alias (test/times 100) 14 | (let [run! (make-engine)] 15 | (prop/for-all 16 | [value (g/infinite-seq) 17 | end-template (g/valid-template) 18 | key-to-alias (gen/elements [:next :value]) 19 | alias-depth gen/s-pos-int 20 | alias-key gen/string-ascii] 21 | (let [path (vec (repeat alias-depth :next)) 22 | end-template (if (= key-to-alias :next) 23 | end-template 24 | projection/leaf) 25 | raw-template (assoc-in {} (conj path key-to-alias) end-template) 26 | alias-template (->> {(projection/alias alias-key key-to-alias) 27 | end-template} 28 | (assoc-in {} path))] 29 | (= (-> value 30 | (projection/apply alias-template) 31 | (run!) 32 | (deref) 33 | (get-in (conj path alias-key))) 34 | (-> value 35 | (projection/apply raw-template) 36 | (run!) 37 | (deref) 38 | (get-in (conj path key-to-alias)))))))) 39 | 40 | (defspec t-alias-type-mismatch (test/times 25) 41 | (let [run! (make-engine)] 42 | (prop/for-all 43 | [value (g/infinite-seq) 44 | alias-key gen/string-ascii] 45 | (let [template {(projection/alias alias-key :value) projection/leaf}] 46 | (boolean 47 | (is 48 | (thrown-with-msg? 49 | IllegalArgumentException 50 | #"is a map but value is not" 51 | @(-> [value] 52 | (projection/apply template) 53 | (run!))))))))) 54 | 55 | (defspec t-alias-missing-key (test/times 25) 56 | (let [run! (make-engine)] 57 | (prop/for-all 58 | [value (g/infinite-seq) 59 | alias-key gen/string-ascii] 60 | (let [template {(projection/alias alias-key :unknown) projection/leaf}] 61 | (boolean 62 | (is 63 | (thrown-with-msg? 64 | IllegalArgumentException 65 | #"expects key" 66 | @(-> value 67 | (projection/apply template) 68 | (run!))))))))) 69 | 70 | (defspec t-alias-overriding-key (test/times 25) 71 | (let [run! (make-engine)] 72 | (prop/for-all 73 | [value (g/infinite-seq)] 74 | (let [template {(projection/alias :next :value) projection/leaf}] 75 | (boolean 76 | (is 77 | (thrown-with-msg? 78 | IllegalArgumentException 79 | #"would override key" 80 | @(-> value 81 | (projection/apply template) 82 | (run!))))))))) 83 | -------------------------------------------------------------------------------- /test/claro/projection/bind_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.bind-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.data :as data] 10 | [claro.projection :as projection] 11 | [claro.engine.fixtures :refer [make-engine]])) 12 | 13 | ;; ## Resolvable 14 | 15 | (defrecord Identity [v] 16 | data/Resolvable 17 | (resolve! [_ _] 18 | v)) 19 | 20 | (def gen-vals 21 | (gen/vector 22 | (gen/one-of 23 | [gen/int 24 | (gen/fmap ->Identity gen/int)]))) 25 | 26 | (def gen-wrapper 27 | (gen/elements [identity ->Identity])) 28 | 29 | ;; ## Tests 30 | 31 | (defn bind-fn 32 | [vs] 33 | (cond (empty? vs) 34 | (projection/finite-value [255]) 35 | 36 | (even? (first vs)) 37 | (projection/transform 38 | (fn [vs] 39 | [(apply + vs)]) 40 | [projection/leaf]) 41 | 42 | :else 43 | (projection/transform 44 | (fn [vs] 45 | [(apply - vs)]) 46 | [projection/leaf]))) 47 | 48 | (defspec t-bind (test/times 50) 49 | (let [run!! (comp deref (make-engine))] 50 | (prop/for-all 51 | [vs gen-vals, wf gen-wrapper] 52 | (let [projection (projection/bind bind-fn [projection/leaf]) 53 | value (projection/apply (wf vs) projection) 54 | vs' (run!! vs)] 55 | (= (cond (empty? vs') [255] 56 | (even? (first vs')) [(apply + vs')] 57 | :else [(apply - vs')]) 58 | (run!! value)))))) 59 | 60 | (defspec t-let (test/times 50) 61 | (let [run!! (comp deref (make-engine))] 62 | (prop/for-all 63 | [vs gen-vals, wf gen-wrapper] 64 | (let [projection (projection/let [vs [projection/leaf]] 65 | (bind-fn vs)) 66 | value (projection/apply (wf vs) projection) 67 | vs' (run!! vs)] 68 | (= (cond (empty? vs') [255] 69 | (even? (first vs')) [(apply + vs')] 70 | :else [(apply - vs')]) 71 | (run!! value)))))) 72 | -------------------------------------------------------------------------------- /test/claro/projection/conditional_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.conditional-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data.ops.then :refer [then]] 11 | [claro.projection :as projection])) 12 | 13 | (defspec t-conditional-projection (test/times 100) 14 | (let [run! (make-engine)] 15 | (prop/for-all 16 | [template (g/valid-template) 17 | value (g/non-wrapped-infinite-seq)] 18 | (let [value-divisible? (fn [n] 19 | #(and (number? (:value %)) 20 | (zero? (mod (:value %) n)))) 21 | {:keys [n]} value] 22 | (is 23 | (= (cond (zero? (mod n 15)) 24 | {:extra? true} 25 | 26 | (zero? (mod n 3)) 27 | @(-> value 28 | (projection/apply (select-keys template [:value])) 29 | (run!)) 30 | 31 | (zero? (mod n 5)) 32 | @(-> value 33 | (projection/apply (select-keys template [:next])) 34 | (run!)) 35 | 36 | :else {:extra? true, :value n}) 37 | @(-> value 38 | (then assoc :extra? true) 39 | (projection/apply 40 | (projection/conditional 41 | {:value projection/leaf} 42 | (value-divisible? 15) {:extra? projection/leaf} 43 | (value-divisible? 3) (select-keys template [:value]) 44 | (value-divisible? 5) (select-keys template [:next]) 45 | :else {:extra? projection/leaf, :value projection/leaf})) 46 | (run!)))))))) 47 | 48 | (defspec t-conditional-union-projection (test/times 100) 49 | (let [run! (make-engine)] 50 | (prop/for-all 51 | [template (g/valid-template) 52 | value (g/non-wrapped-infinite-seq)] 53 | (let [value-divisible? (fn [n] 54 | #(and (number? (:value %)) 55 | (zero? (mod (:value %) n)))) 56 | {:keys [n]} value] 57 | (is 58 | (= (into {} 59 | [(when (zero? (mod n 3)) 60 | @(-> value 61 | (projection/apply (select-keys template [:value])) 62 | (run!))) 63 | (when (zero? (mod n 5)) 64 | @(-> value 65 | (projection/apply (select-keys template [:next])) 66 | (run!))) 67 | (when (zero? (mod n 15)) 68 | {:extra? true})]) 69 | @(-> value 70 | (then assoc :extra? true) 71 | (projection/apply 72 | (projection/conditional-union 73 | {:value projection/leaf} 74 | (value-divisible? 3) (select-keys template [:value]) 75 | (value-divisible? 5) (select-keys template [:next]) 76 | (value-divisible? 15) {:extra? projection/leaf})) 77 | (run!)))))))) 78 | -------------------------------------------------------------------------------- /test/claro/projection/error_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.error-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [claro.test :as test] 7 | [claro.data :as data] 8 | [claro.projection :as projection] 9 | [claro.projection.generators :refer [gen-projection gen-error]] 10 | [claro.engine.fixtures :refer [make-engine]])) 11 | 12 | (defspec t-projection-retains-error-values (test/times 250) 13 | (let [run! (make-engine)] 14 | (prop/for-all 15 | [projection gen-projection 16 | error gen-error] 17 | (= error 18 | @(-> error 19 | (projection/apply projection) 20 | (run!)))))) 21 | -------------------------------------------------------------------------------- /test/claro/projection/juxt_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.juxt-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data.ops.then :refer [then]] 11 | [claro.projection :as projection])) 12 | 13 | (defn sum-nested-values 14 | [initial] 15 | (->> (projection/juxt 16 | (projection/extract :value) 17 | (projection/extract-in [:next :value]) 18 | (projection/extract-in [:next :next :value])) 19 | (projection/transform #(reduce + initial %)))) 20 | 21 | (defspec t-juxt-projection (test/times 100) 22 | (let [run! (make-engine)] 23 | (prop/for-all 24 | [value (g/infinite-seq) 25 | initial gen/int] 26 | (let [template (sum-nested-values initial) 27 | result @(run! (projection/apply value template)) 28 | expected (->> (iterate inc (:n value)) 29 | (take 3) 30 | (reduce + initial))] 31 | (= expected result))))) 32 | -------------------------------------------------------------------------------- /test/claro/projection/level_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.level-test 2 | (:require [clojure.test.check :as tc] 3 | [clojure.test.check 4 | [clojure-test :refer [defspec]] 5 | [generators :as gen] 6 | [properties :as prop]] 7 | [clojure.test :refer :all] 8 | [claro.test :as test] 9 | [claro.data :as data] 10 | [claro.projection :as projection] 11 | [claro.projection.generators :as g] 12 | [claro.engine.fixtures :refer [make-engine]])) 13 | 14 | (defspec t-level (test/times 50) 15 | (let [run!! (comp deref (make-engine))] 16 | (prop/for-all 17 | [n (gen/fmap (comp inc #(mod % 4)) gen/int) 18 | v (g/infinite-seq)] 19 | (let [value (projection/apply v (projection/levels n))] 20 | (= (->> (run!! value) 21 | (iterate :next) 22 | (take-while seq) 23 | (last) 24 | (:value)) 25 | (+ (:n v) n -1)))))) 26 | -------------------------------------------------------------------------------- /test/claro/projection/maps_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.maps-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.projection :as projection])) 11 | 12 | (defspec t-map-projection (test/times 200) 13 | (let [run! (make-engine)] 14 | (prop/for-all 15 | [template (g/valid-template) 16 | value (g/infinite-seq)] 17 | (let [projected-value (projection/apply value template) 18 | result @(run! projected-value)] 19 | (g/compare-to-template result template (:n value)))))) 20 | 21 | (defspec t-invalid-map-projection (test/times 200) 22 | (let [run! (make-engine)] 23 | (prop/for-all 24 | [template (g/invalid-template) 25 | value (g/infinite-seq)] 26 | (let [projected-value (projection/apply value template)] 27 | (boolean 28 | (is 29 | (thrown-with-msg? 30 | IllegalStateException 31 | #"can only be used for non-collection values" 32 | @(run! projected-value)))))))) 33 | 34 | (defspec t-map-projection-type-mismatch (test/times 200) 35 | (let [run! (make-engine)] 36 | (prop/for-all 37 | [template (g/valid-template) 38 | values (gen/vector (g/infinite-seq))] 39 | (let [projected-value (projection/apply values template)] 40 | (boolean 41 | (is 42 | (thrown-with-msg? 43 | IllegalArgumentException 44 | #"projection template is a map but value is not" 45 | @(run! projected-value)))))))) 46 | -------------------------------------------------------------------------------- /test/claro/projection/maybe_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.maybe-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data.ops :as ops] 11 | [claro.projection :as projection])) 12 | 13 | (defspec t-maybe (test/times 200) 14 | (let [run! (make-engine)] 15 | (prop/for-all 16 | [template (g/valid-template) 17 | value (gen/one-of 18 | [(g/infinite-seq) 19 | (gen/return (g/->Identity nil))])] 20 | (let [maybe-template (projection/maybe template) 21 | should-be-nil? (contains? value :value) 22 | projected-value (projection/apply value maybe-template) 23 | result @(run! projected-value)] 24 | (if should-be-nil? 25 | (nil? result) 26 | (= result @(run! (projection/apply value template)))))))) 27 | 28 | (defspec t-default (test/times 200) 29 | (let [run! (make-engine)] 30 | (prop/for-all 31 | [template (g/valid-template) 32 | value (gen/one-of 33 | [(g/infinite-seq) 34 | (gen/return (g/->Identity nil))]) 35 | default-value (g/infinite-seq-no-mutation)] 36 | (let [default-template (projection/default template default-value) 37 | should-be-nil? (contains? value :value) 38 | projected-value (projection/apply value default-template) 39 | result @(run! projected-value)] 40 | (if should-be-nil? 41 | (= result @(run! (projection/apply default-value template))) 42 | (= result @(run! (projection/apply value template)))))))) 43 | 44 | (deftest t-maybe-on-missing-key 45 | (let [run! (make-engine) 46 | value {:a 0} 47 | template {:b (projection/maybe projection/leaf)}] 48 | (is (= {:b nil} 49 | @(run! (projection/apply value template)))))) 50 | 51 | (deftest t-default-on-missing-key 52 | (let [run! (make-engine) 53 | value {:a 0} 54 | template {:b (projection/default projection/leaf 4)}] 55 | (is (= {:b 4} 56 | @(run! (projection/apply value template)))))) 57 | -------------------------------------------------------------------------------- /test/claro/projection/ops_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.ops-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.data.ops :as ops] 9 | [claro.projection.generators :as g] 10 | [claro.engine.fixtures :refer [make-engine]] 11 | [claro.projection :as projection])) 12 | 13 | (defspec t-projection-on-ops-in-seq (test/times 100) 14 | (let [run! (make-engine)] 15 | (prop/for-all 16 | [template (g/valid-template) 17 | value (g/infinite-seq)] 18 | (let [projected-value (projection/apply 19 | [(ops/then value identity)] 20 | [template]) 21 | result @(run! projected-value)] 22 | (g/compare-to-template (first result) template (:n value)))))) 23 | -------------------------------------------------------------------------------- /test/claro/projection/printability_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.printability-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [claro.test :as test] 7 | [claro.data :as data] 8 | [claro.projection :as projection] 9 | [claro.projection.generators :refer [gen-projection gen-error]] 10 | [claro.engine.fixtures :refer [make-engine]])) 11 | 12 | (defspec t-projections-are-printable (test/times 500) 13 | (let [run! (make-engine)] 14 | (prop/for-all 15 | [projection gen-projection] 16 | (and (not (record? projection)) 17 | (if (coll? projection) 18 | (string? (pr-str projection)) 19 | (.startsWith (pr-str projection) "#Identity gen/int)]))) 26 | 27 | (def gen-wrapper 28 | (gen/elements [identity ->Identity])) 29 | 30 | ;; ## Tests 31 | 32 | (defspec t-remove-nil-elements (test/times 50) 33 | (let [run!! (comp deref (make-engine))] 34 | (prop/for-all 35 | [vs gen-vals 36 | wf gen-wrapper] 37 | (let [value (projection/apply 38 | (wf vs) 39 | (projection/remove-nil-elements))] 40 | (= (remove nil? (run!! vs)) 41 | (run!! value)))))) 42 | 43 | (defspec t-remove-nil-elements-with-template (test/times 50) 44 | (let [run!! (comp deref (make-engine))] 45 | (prop/for-all 46 | [vs (gen/fmap 47 | (fn [vs] 48 | (mapv #(some->> % (hash-map :x 1, :v)) vs)) 49 | gen-vals) 50 | wf gen-wrapper] 51 | (let [value (projection/apply 52 | (wf vs) 53 | (projection/remove-nil-elements 54 | [{:v projection/leaf}]))] 55 | (= (->> (run!! vs) 56 | (remove nil?) 57 | (mapv #(select-keys % [:v]))) 58 | (run!! value)))))) 59 | -------------------------------------------------------------------------------- /test/claro/projection/sequential_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.sequential-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.projection :as projection])) 11 | 12 | (defspec t-sequential-projection (test/times 100) 13 | (let [run! (make-engine)] 14 | (prop/for-all 15 | [template (g/valid-template) 16 | values (gen/vector (g/infinite-seq-no-mutation))] 17 | (let [projected-values (projection/apply values [template]) 18 | results @(run! projected-values)] 19 | (and (vector? results) 20 | (empty? 21 | (for [[result {:keys [n]}] (map vector results values) 22 | :when (not (g/compare-to-template result template n))] 23 | result))))))) 24 | 25 | (defspec t-sequential-projection-type-mismatch (test/times 100) 26 | (let [run! (make-engine)] 27 | (prop/for-all 28 | [template (g/valid-template) 29 | value (g/infinite-seq)] 30 | (let [projected-value (projection/apply value [template])] 31 | (boolean 32 | (is 33 | (thrown-with-msg? 34 | IllegalArgumentException 35 | #"projection template is sequential but value is not" 36 | @(run! projected-value)))))))) 37 | -------------------------------------------------------------------------------- /test/claro/projection/set_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.set-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.projection :as projection])) 11 | 12 | (defspec t-set-projection (test/times 100) 13 | (let [run! (make-engine)] 14 | (prop/for-all 15 | [template (g/valid-template) 16 | values (let [g (g/infinite-seq-no-mutation)] 17 | (gen/one-of 18 | [(gen/vector g) 19 | (gen/list g) 20 | (gen/set g)]))] 21 | (= (->> values 22 | (map #(projection/apply % template)) 23 | (map (comp deref run!)) 24 | (into #{})) 25 | (-> values 26 | (projection/apply #{template}) 27 | (run!) 28 | (deref)))))) 29 | 30 | (defspec t-set-projection-type-mismatch (test/times 100) 31 | (let [run! (make-engine)] 32 | (prop/for-all 33 | [template (g/valid-template) 34 | value (g/infinite-seq)] 35 | (let [projected-value (projection/apply value #{template})] 36 | (boolean 37 | (is 38 | (thrown-with-msg? 39 | IllegalArgumentException 40 | #"projection template is set but value is not" 41 | @(run! projected-value)))))))) 42 | -------------------------------------------------------------------------------- /test/claro/projection/sort_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.sort-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data.ops.then :refer [then]] 11 | [claro.projection :as projection])) 12 | 13 | (defspec t-sort (test/times 100) 14 | (let [run! (make-engine) 15 | run!! (comp deref run! projection/apply)] 16 | (prop/for-all 17 | [values (gen/vector 18 | (gen/one-of 19 | [(g/infinite-seq-no-mutation) 20 | (gen/let [value gen/int] 21 | {:value value})]))] 22 | (let [sort-template (projection/sort-by 23 | (projection/extract :value) 24 | [{:value projection/leaf}]) 25 | result (run!! values sort-template)] 26 | (= result (sort-by :value result)))))) 27 | -------------------------------------------------------------------------------- /test/claro/projection/transform_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.transform-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data.ops.then :refer [then]] 11 | [claro.projection :as projection])) 12 | 13 | (defspec t-transform-with-output-template (test/times 100) 14 | (let [run! (make-engine) 15 | run!! (comp deref run! projection/apply)] 16 | (prop/for-all 17 | [initial-value (g/infinite-seq) 18 | replacement-value (g/infinite-seq-no-mutation) 19 | initial-template (g/valid-template) 20 | replacement-template (g/valid-template)] 21 | (let [observed (promise) 22 | transformation (projection/transform 23 | (fn [v] 24 | (deliver observed v) 25 | replacement-value) 26 | initial-template 27 | replacement-template)] 28 | (and (is (= (run!! initial-value transformation) 29 | (run!! replacement-value replacement-template))) 30 | (is (= (deref observed 0 ::none) 31 | (run!! initial-value initial-template)))))))) 32 | 33 | (defspec t-transform-without-output-template (test/times 100) 34 | (let [run! (make-engine) 35 | run!! (comp deref run! projection/apply)] 36 | (prop/for-all 37 | [initial-value (g/infinite-seq) 38 | replacement-value (g/infinite-seq-no-mutation) 39 | initial-template (g/valid-template) 40 | replacement-template (g/valid-template)] 41 | (let [observed (promise) 42 | transformation (projection/transform 43 | (fn [v] 44 | (deliver observed v) 45 | (projection/apply 46 | replacement-value 47 | replacement-template)) 48 | initial-template)] 49 | (and (is (= (run!! initial-value transformation) 50 | (run!! replacement-value replacement-template))) 51 | (is (= (deref observed 0 ::none) 52 | (run!! initial-value initial-template)))))))) 53 | 54 | (defspec t-transform-without-output-template-but-infinite-tree (test/times 25) 55 | (let [run! (make-engine {:max-cost 256}) 56 | run!! (comp deref run! projection/apply)] 57 | (prop/for-all 58 | [initial-value (g/infinite-seq) 59 | replacement-value (g/infinite-seq-no-mutation) 60 | initial-template (g/valid-template)] 61 | (let [observed (promise) 62 | transformation (projection/transform 63 | (fn [v] 64 | (deliver observed v) 65 | replacement-value) 66 | initial-template)] 67 | (boolean 68 | (is 69 | (thrown-with-msg? 70 | IllegalStateException 71 | #"resolution has exceeded maximum cost" 72 | (run!! initial-value transformation)))))))) 73 | 74 | (defspec t-finite-transform-without-output-template-but-infinite-tree (test/times 25) 75 | (let [run! (make-engine {:max-cost 256}) 76 | run!! (comp deref run! projection/apply)] 77 | (prop/for-all 78 | [initial-value (g/infinite-seq) 79 | replacement-value (g/infinite-seq-no-mutation) 80 | initial-template (g/valid-template)] 81 | (let [observed (promise) 82 | transformation (projection/transform-finite 83 | (fn [v] 84 | (deliver observed v) 85 | replacement-value) 86 | initial-template)] 87 | (= replacement-value (run!! initial-value transformation)))))) 88 | -------------------------------------------------------------------------------- /test/claro/projection/union_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.union-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.data.ops.then :refer [then]] 11 | [claro.projection :as projection])) 12 | 13 | (defspec t-union-projection (test/times 100) 14 | (let [run! (make-engine)] 15 | (prop/for-all 16 | [template (g/valid-template) 17 | value (g/infinite-seq)] 18 | (is (= @(-> value 19 | (projection/apply template) 20 | (run!)) 21 | @(-> value 22 | (projection/apply 23 | (projection/union* 24 | [(select-keys template [:next]) 25 | (select-keys template [:value])])) 26 | (run!))))))) 27 | 28 | (defspec t-union-projection-key-overlap (test/times 100) 29 | (let [run! (make-engine)] 30 | (prop/for-all 31 | [template (g/valid-template) 32 | value (g/infinite-seq)] 33 | (or (empty? template) 34 | (boolean 35 | (is 36 | (thrown-with-msg? 37 | IllegalStateException 38 | #"disjunct keys" 39 | @(-> value 40 | (projection/apply (projection/union* [template template])) 41 | (run!))))))))) 42 | 43 | (defspec t-union-projection-with-alias (test/times 100) 44 | (let [run! (make-engine)] 45 | (prop/for-all 46 | [template (g/valid-template) 47 | value (g/infinite-seq)] 48 | (let [raw @(-> value 49 | (projection/apply template) 50 | (run!))] 51 | (is (= {:nested (select-keys raw [:next]) 52 | :second-nested (select-keys raw [:value])} 53 | @(-> {:nested value} 54 | (projection/apply 55 | (projection/union* 56 | [{:nested (select-keys template [:next])} 57 | {(projection/alias :second-nested :nested) 58 | (select-keys template [:value])}])) 59 | (run!)))))))) 60 | 61 | (defspec t-merge-projection (test/times 100) 62 | (let [run! (make-engine)] 63 | (prop/for-all 64 | [template (g/valid-template) 65 | value (g/infinite-seq)] 66 | (is (= @(-> value 67 | (projection/apply template) 68 | (run!)) 69 | @(-> value 70 | (projection/apply 71 | (projection/merge* 72 | [(select-keys template [:next]) 73 | (select-keys template [:value])])) 74 | (run!))))))) 75 | 76 | (defspec t-merge-projection-key-overlap (test/times 100) 77 | (let [run! (make-engine)] 78 | (prop/for-all 79 | [template1 (g/valid-template) 80 | template2 (g/valid-template) 81 | value (g/infinite-seq)] 82 | (is (= (merge 83 | @(-> value 84 | (projection/apply template1) 85 | (run!)) 86 | @(-> value 87 | (projection/apply template2) 88 | (run!))) 89 | @(-> value 90 | (projection/apply (projection/merge* [template1 template2])) 91 | (run!))))))) 92 | -------------------------------------------------------------------------------- /test/claro/projection/value_test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.projection.value-test 2 | (:require [clojure.test.check 3 | [clojure-test :refer [defspec]] 4 | [generators :as gen] 5 | [properties :as prop]] 6 | [clojure.test :refer :all] 7 | [claro.test :as test] 8 | [claro.projection.generators :as g] 9 | [claro.engine.fixtures :refer [make-engine]] 10 | [claro.projection :as projection])) 11 | 12 | (defspec t-value-injection (test/times 200) 13 | (let [run! (make-engine)] 14 | (prop/for-all 15 | [template (g/valid-template) 16 | value (g/infinite-seq) 17 | value-to-inject gen/simple-type-printable 18 | value-op (gen/elements [projection/value projection/finite-value])] 19 | (let [template-with-injection 20 | (assoc template 21 | :extra-value 22 | (value-op value-to-inject)) 23 | projected-value 24 | (projection/apply value template) 25 | projected-value-with-injection 26 | (projection/apply value template-with-injection)] 27 | (= @(run! projected-value-with-injection) 28 | (-> @(run! projected-value) 29 | (assoc :extra-value value-to-inject))))))) 30 | 31 | (defspec t-value-override (test/times 200) 32 | (let [run! (make-engine)] 33 | (prop/for-all 34 | [value (g/infinite-seq) 35 | value-to-inject gen/simple-type-printable 36 | value-op (gen/elements [projection/value projection/finite-value])] 37 | (let [template {:next (value-op value-to-inject)} 38 | projected-value (projection/apply value template)] 39 | (= {:next value-to-inject} 40 | @(run! projected-value)))))) 41 | -------------------------------------------------------------------------------- /test/claro/runtime/impls_test.cljc: -------------------------------------------------------------------------------- 1 | (ns claro.runtime.impls-test 2 | (:require [clojure.test :refer :all] 3 | [claro.runtime.impl :as impl] 4 | [claro.runtime.impl 5 | [core-async :as core-async] 6 | #?(:clj [manifold :as manifold])])) 7 | 8 | ;; ## Test Harness 9 | 10 | (defn test-impl 11 | [impl] 12 | (let [impl (is (impl/->deferred-impl impl)) 13 | chain #(apply impl/chain impl %&) 14 | zip #(impl/zip impl %) 15 | value #(impl/value impl %) 16 | run #(impl/run impl %) 17 | loop #(impl/loop impl %1 %2) 18 | recur #(impl/recur impl %) 19 | deferred? #(impl/deferred? impl %)] 20 | (testing "values." 21 | (let [d (is (value :value))] 22 | (is (deferred? d)) 23 | (is (impl/deferrable? impl d)) 24 | (is (= d (impl/->deferred impl d))))) 25 | (testing "run." 26 | (let [d (run (constantly :value))] 27 | (is (deferred? d)) 28 | (is (impl/deferrable? impl d)) 29 | (is (= d (impl/->deferred impl d))) 30 | (chain d (fn [value] (is (= :value value)))))) 31 | (testing "chain." 32 | (is (deferred? 33 | (chain 34 | (value 0) 35 | inc 36 | inc 37 | (fn [v] (is (= v 2))))))) 38 | (testing "chain w/ intermediate deferreds." 39 | (is (deferred? 40 | (chain 41 | (value 0) 42 | #(value (+ % 2)) 43 | (fn [v] (is (= v 2))))))) 44 | (testing "zip." 45 | (let [z (zip [])] 46 | (is (deferred? z)) 47 | (chain z (fn [v] (is (= [] v))))) 48 | (let [z (zip [(value 0) (value 1) (value 2)])] 49 | (is (deferred? z)) 50 | (chain z (fn [v] (is (= [0 1 2] v)))))) 51 | (testing "loop/recur." 52 | (letfn [(inc-step [x] 53 | (if (< x 10) 54 | (chain 55 | (value (inc x)) 56 | recur) 57 | (value x)))] 58 | (let [l (loop inc-step 0)] 59 | (is (deferred? l)) 60 | (chain l (fn [v] (is (= 10 v))))))))) 61 | 62 | (defn test-catch 63 | [impl] 64 | (let [chain #(apply impl/chain impl %&) 65 | catch #(apply impl/catch impl %&) 66 | value #(impl/value impl %)] 67 | (testing "catch." 68 | (-> (value ::no-error) 69 | (chain 70 | (fn [_] 71 | (throw (Exception. "WHAT")))) 72 | (catch 73 | (fn [^Throwable t] 74 | (is (= (.getMessage t) "WHAT")) 75 | ::error)) 76 | (chain 77 | (fn [v] 78 | (is (= ::error v)))))))) 79 | 80 | ;; ## Tests (Clojure) 81 | 82 | #?(:clj 83 | (deftest t-manifold 84 | (test-impl manifold/impl) 85 | (test-catch manifold/impl))) 86 | 87 | ;; ## Tests (Clojure + ClojureScript) 88 | (deftest t-core-async 89 | (test-impl core-async/impl) 90 | (is 91 | (thrown-with-msg? 92 | Exception 93 | #"'catch' not supported" 94 | (test-catch core-async/impl)))) 95 | -------------------------------------------------------------------------------- /test/claro/test.clj: -------------------------------------------------------------------------------- 1 | (ns claro.test 2 | (:require [com.gfredericks.test.chuck :as chuck])) 3 | 4 | (defn times 5 | [n] 6 | (chuck/times n)) 7 | --------------------------------------------------------------------------------