├── scripts ├── nrepl ├── shadow-node-repl ├── shadow-run-tests-simple └── shadow-run-tests-advanced ├── .clj-kondo ├── taoensso │ └── encore │ │ ├── config.edn │ │ └── taoensso │ │ └── encore.clj ├── metosin │ ├── malli │ │ └── config.edn │ └── malli-types │ │ └── config.edn ├── config.edn └── funcool │ └── promesa │ └── config.edn ├── src └── promisespromises │ ├── error │ └── protocols.cljc │ ├── test │ ├── malli.cljc │ └── reduce.cljc │ ├── util │ ├── repl.cljs │ └── macro.cljc │ ├── stream.cljc │ ├── promise.cljc │ ├── test.cljs │ ├── promise │ └── retry.cljc │ ├── stream │ ├── test.cljc │ ├── protocols.cljc │ ├── types.cljc │ ├── transport.cljc │ ├── chunk.cljc │ ├── promesa_csp.cljc │ ├── manifold.clj │ ├── core_async.cljs │ ├── zip_impl.cljc │ ├── operations.cljc │ └── cross_impl.cljc │ ├── error.cljc │ └── test.clj ├── package.json ├── resources └── clj-kondo │ └── clj-kondo.exports │ └── com.github.yapsterapp │ └── promisespromises │ └── config.edn ├── .gitignore ├── LICENSE ├── pom.xml ├── shadow-cljs.edn ├── .github └── workflows │ └── clojure.yml ├── deps.edn ├── README.md └── test └── promisespromises ├── promise └── retry_test.cljc └── stream ├── zip_impl_test.cljc ├── transport_test.cljc ├── cross_impl_test.cljc └── old_cross_test.cljz /scripts/nrepl: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | clj -M:nrepl 4 | -------------------------------------------------------------------------------- /.clj-kondo/taoensso/encore/config.edn: -------------------------------------------------------------------------------- 1 | {:hooks {:analyze-call {taoensso.encore/defalias taoensso.encore/defalias}}} 2 | -------------------------------------------------------------------------------- /.clj-kondo/metosin/malli/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {malli.experimental/defn schema.core/defn} 2 | :linters {:unresolved-symbol {:exclude [(malli.core/=>)]}}} 3 | -------------------------------------------------------------------------------- /scripts/shadow-node-repl: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # npx shadow-cljs -d nrepl:1.0.0 -d cider/piggieback:0.5.3 -d refactor-nrepl:3.6.0 -d cider/cider-nrepl:0.29.0 node-repl 4 | 5 | clojure -A:shadow-cljs -A:shadow-node-repl node-repl 6 | -------------------------------------------------------------------------------- /src/promisespromises/error/protocols.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.error.protocols) 2 | 3 | (defprotocol IErrorWrapper 4 | (-unwrap [_] "unwrap and maybe throw") 5 | (-unwrap-value [_] "unwrap any error value, never throwing")) 6 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "promisespromises", 3 | "version": "3.0.0", 4 | "description": "promisespromises", 5 | "dependencies": { 6 | }, 7 | "devDependencies": { 8 | "shadow-cljs": "^2.22.9" 9 | }, 10 | "scripts": { 11 | } 12 | } 13 | -------------------------------------------------------------------------------- /resources/clj-kondo/clj-kondo.exports/com.github.yapsterapp/promisespromises/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as 2 | {promisespromises.test/deftest clojure.test/deftest 3 | promisespromises.test/testing clojure.test/testing 4 | promisespromises.test/is clojure.test/is 5 | promisespromises.test/tlet clojure.core/let}} 6 | -------------------------------------------------------------------------------- /scripts/shadow-run-tests-simple: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )" 4 | 5 | cd $DIR/.. 6 | npm ci 7 | 8 | clojure -A:shadow-cljs -A:test release node-test-simple && 9 | node -r source-map-support/register target/node-test-simple/node-tests.js 10 | -------------------------------------------------------------------------------- /scripts/shadow-run-tests-advanced: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )" 4 | 5 | cd $DIR/.. 6 | npm ci 7 | 8 | clojure -A:shadow-cljs -A:test release node-test-advanced && 9 | node -r source-map-support/register target/node-test-advanced/node-tests.js 10 | -------------------------------------------------------------------------------- /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as 2 | {promisespromises.test/deftest clojure.test/deftest 3 | promisespromises.test/testing clojure.test/testing 4 | promisespromises.test/is clojure.test/is 5 | promisespromises.test/tlet clojure.core/let} 6 | 7 | :linters 8 | {:unused-namespace {:exclude [taoensso.timbre]} 9 | 10 | :unused-referred-var 11 | {:exclude {taoensso.timbre [trace debug info warn error fatal]}}}} 12 | -------------------------------------------------------------------------------- /src/promisespromises/test/malli.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.test.malli 2 | (:require 3 | #?(:clj [malli.instrument :as mi]) 4 | )) 5 | 6 | ;; defns get arity checking 7 | #?(:cljs (defn before-fn [] true)) 8 | #?(:cljs (defn after-fn [] true)) 9 | 10 | (def instrument-fns-fixture 11 | #?(:clj 12 | (fn [f] 13 | (mi/instrument!) 14 | (f)) 15 | 16 | :cljs 17 | {:before before-fn 18 | :after after-fn})) 19 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .calva/output-window/ 2 | .classpath 3 | .clj-kondo/.cache 4 | .cpcache 5 | .eastwood 6 | .factorypath 7 | .hg/ 8 | .hgignore 9 | .java-version 10 | .lein-* 11 | .lsp/.cache 12 | .lsp/sqlite.db 13 | .nrepl-history 14 | .nrepl-port 15 | .project 16 | .rebel_readline_history 17 | .settings 18 | .shadow-cljs 19 | .socket-repl-port 20 | .sw* 21 | .vscode 22 | *.class 23 | *.jar 24 | *.swp 25 | *~ 26 | /checkouts 27 | /classes 28 | /node_modules 29 | /target 30 | -------------------------------------------------------------------------------- /src/promisespromises/util/repl.cljs: -------------------------------------------------------------------------------- 1 | (ns promisespromises.util.repl 2 | (:require 3 | [promesa.core :as p])) 4 | 5 | (defrecord Error [error]) 6 | 7 | (defn error? 8 | [v] 9 | (instance? Error v)) 10 | 11 | (defn capture 12 | "capture a promise in an atom - for easy repl inspection" 13 | [p] 14 | (let [a (atom ::unfulfilled)] 15 | (p/handle 16 | p 17 | (fn [succ err] 18 | (if (some? err) 19 | (reset! a (->Error err)) 20 | (reset! a succ)))) 21 | 22 | a)) 23 | -------------------------------------------------------------------------------- /.clj-kondo/funcool/promesa/config.edn: -------------------------------------------------------------------------------- 1 | {:lint-as {promesa.core/-> clojure.core/-> 2 | promesa.core/->> clojure.core/->> 3 | promesa.core/as-> clojure.core/as-> 4 | promesa.core/let clojure.core/let 5 | promesa.core/plet clojure.core/let 6 | promesa.core/loop clojure.core/loop 7 | promesa.core/recur clojure.core/recur 8 | promesa.core/with-redefs clojure.core/with-redefs 9 | promesa.core/doseq clojure.core/doseq}} 10 | -------------------------------------------------------------------------------- /.clj-kondo/taoensso/encore/taoensso/encore.clj: -------------------------------------------------------------------------------- 1 | (ns taoensso.encore 2 | (:require 3 | [clj-kondo.hooks-api :as hooks])) 4 | 5 | (defn defalias [{:keys [node]}] 6 | (let [[sym-raw src-raw] (rest (:children node)) 7 | src (if src-raw src-raw sym-raw) 8 | sym (if src-raw 9 | sym-raw 10 | (symbol (name (hooks/sexpr src))))] 11 | {:node (with-meta 12 | (hooks/list-node 13 | [(hooks/token-node 'def) 14 | (hooks/token-node (hooks/sexpr sym)) 15 | (hooks/token-node (hooks/sexpr src))]) 16 | (meta src))})) 17 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | Copyright © 2022 EMPLOYEE REPUBLIC LIMITED 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 5 | 6 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 7 | 8 | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 9 | -------------------------------------------------------------------------------- /src/promisespromises/stream.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream 2 | (:refer-clojure :exclude [concat count filter map mapcat reduce reductions]) 3 | (:require 4 | [promisespromises.stream.transport :as transport] 5 | [promisespromises.stream.operations :as operations] 6 | [promisespromises.stream.cross-impl :as cross-impl])) 7 | 8 | (def stream transport/stream) 9 | (def stream? transport/stream?) 10 | (def put! transport/put!) 11 | (def error! transport/error!) 12 | (def take! transport/take!) 13 | (def close! transport/close!) 14 | (def connect-via transport/connect-via) 15 | 16 | (def put-all! operations/put-all!) 17 | (def put-all-and-close! operations/put-all-and-close!) 18 | (def ->source operations/->source) 19 | (def realize-each operations/realize-each) 20 | (def transform operations/transform) 21 | (def map operations/map) 22 | (def mapcon operations/mapcon) 23 | (def zip operations/zip) 24 | (def mapcat operations/mapcat) 25 | (def filter operations/filter) 26 | (def reductions operations/reductions) 27 | (def reduce operations/reduce) 28 | (def count operations/count) 29 | (def chunkify operations/chunkify) 30 | 31 | (def cross cross-impl/cross) 32 | -------------------------------------------------------------------------------- /pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4.0.0 4 | com.github.yapsterapp 5 | promisespromises 6 | promisespromises 7 | 8 | 9 | The MIT License (MIT) 10 | https://mit-license.org/ 11 | 12 | 13 | 14 | src 15 | 16 | 17 | src 18 | 19 | 20 | 21 | 22 | 23 | clojars 24 | https://repo.clojars.org/ 25 | 26 | 27 | 28 | 29 | clojars 30 | Clojars repository 31 | https://clojars.org/repo 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /src/promisespromises/util/macro.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.util.macro 2 | #?(:cljs (:require-macros [promisespromises.util.macro]))) 3 | 4 | ;; from https://github.com/plumatic/schema/blob/master/src/clj/schema/macros.clj 5 | 6 | #?(:clj 7 | (defn cljs-env? 8 | "Take the &env from a macro, and tell whether we are expanding into cljs." 9 | [env] 10 | (boolean (:ns env)))) 11 | 12 | #?(:clj 13 | (defmacro if-cljs 14 | "Return then if we are generating cljs code and else for Clojure code. 15 | https://groups.google.com/d/msg/clojurescript/iBY5HaQda4A/w1lAQi9_AwsJ" 16 | [then else] 17 | (if (cljs-env? &env) then else))) 18 | 19 | #?(:clj 20 | (defmacro try-catch 21 | "A cross-platform variant of try-catch that catches all normal exceptions. 22 | Does not support finally, and does not take an exception class." 23 | [& body] 24 | (let [try-body (butlast body) 25 | [catch sym & catch-body :as _catch-form] (last body)] 26 | (assert (= catch 'catch)) 27 | (assert (symbol? sym)) 28 | `(if-cljs 29 | (try ~@try-body (~'catch :default ~sym ~@catch-body)) 30 | (try ~@try-body (~'catch Exception ~sym ~@catch-body)))))) 31 | -------------------------------------------------------------------------------- /src/promisespromises/promise.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.promise 2 | #?(:cljs (:require-macros [promisespromises.promise])) 3 | (:require 4 | [promesa.core] 5 | [promisespromises.util.macro])) 6 | 7 | (defmacro always 8 | "catch any sync exception from evaluating body, and wrap 9 | in an errored promise - allowing a single promise-based 10 | control-flow in promise chains" 11 | [body] 12 | `(promisespromises.util.macro/try-catch 13 | ~body 14 | (catch e# (promesa.core/rejected e#)))) 15 | 16 | (defmacro catch-always 17 | "catch any sync or promise error" 18 | [body handler] 19 | `(promesa.core/catch 20 | (always ~body) 21 | ~handler)) 22 | 23 | (defmacro chain-always 24 | "always chain" 25 | [body handler] 26 | `(promesa.core/chain 27 | (always ~body) 28 | ~handler)) 29 | 30 | (defmacro handle-always 31 | "handly any sync or promise error" 32 | [body handler] 33 | `(promesa.core/handle 34 | (always ~body) 35 | ~handler)) 36 | 37 | (defmacro merge-always 38 | "merge both branches of a promise into a variant" 39 | [p] 40 | `(handle-always 41 | ~p 42 | (fn [v# err#] 43 | (if (some? err#) 44 | [::error err#] 45 | [::ok v#])))) 46 | -------------------------------------------------------------------------------- /shadow-cljs.edn: -------------------------------------------------------------------------------- 1 | ;; shadow-cljs configuration 2 | {:deps {:aliases [:shadow-cljs]} 3 | 4 | :builds 5 | {:node-test-simple {:target :node-test 6 | :output-to "target/node-test-simple/node-tests.js" 7 | :ns-regexp ".*-test" 8 | :autorun false 9 | :devtools {:preloads []} 10 | :compiler-options {:optimizations :simple 11 | :source-map true} 12 | :closure-defines {}} 13 | 14 | :node-test-advanced {:target :node-test 15 | :output-to "target/node-test-advanced/node-tests.js" 16 | :ns-regexp ".*-test" 17 | :autorun false 18 | :devtools {:preloads []} 19 | :compiler-options {:optimizations :advanced 20 | :source-map true} 21 | :closure-defines {}} 22 | 23 | :node-test-autorun {:target :node-test 24 | :output-to "target/node-test-autorun/node-tests.js" 25 | :ns-regexp ".*-test" 26 | :autorun true 27 | :compiler-options {} 28 | :closure-defines {}}}} 29 | -------------------------------------------------------------------------------- /src/promisespromises/test.cljs: -------------------------------------------------------------------------------- 1 | (ns promisespromises.test 2 | (:require-macros 3 | [cljs.test] 4 | [promisespromises.util.macro] 5 | [promesa.core] 6 | [promisespromises.test] 7 | [promisespromises.test.reduce]) 8 | (:require 9 | [cljs.test] 10 | [promisespromises.util.macro] 11 | [promesa.core] 12 | [taoensso.timbre] 13 | [promisespromises.test.reduce])) 14 | 15 | (defn compose-fixtures 16 | "deals properly with cljs async map fixtures" 17 | [f1 f2] 18 | (let [{f1-before :before 19 | f1-after :after} (if (map? f1) 20 | f1 21 | {:before f1}) 22 | {f2-before :before 23 | f2-after :after} (if (map? f2) 24 | f2 25 | {:before f2})] 26 | {:before (fn [] 27 | (when (some? f1-before) (f1-before)) 28 | (when (some? f2-before) (f2-before)) 29 | true) 30 | :after (fn [] 31 | (when (some? f1-after) (f1-after)) 32 | (when (some? f2-after) (f2-after)) 33 | true)})) 34 | 35 | (defn with-log-level-fixture 36 | [level] 37 | (let [cl (or (:level taoensso.timbre/*config*) 38 | :info)] 39 | {:before (fn [] 40 | (taoensso.timbre/set-level! level) 41 | true) 42 | :after (fn [] 43 | (taoensso.timbre/set-level! cl) 44 | true)})) 45 | -------------------------------------------------------------------------------- /.github/workflows/clojure.yml: -------------------------------------------------------------------------------- 1 | name: Run tests 2 | 3 | on: 4 | push: 5 | branches: [ "trunk" ] 6 | pull_request: 7 | branches: [ "trunk" ] 8 | 9 | jobs: 10 | build: 11 | 12 | runs-on: ubuntu-latest 13 | 14 | steps: 15 | - uses: actions/checkout@v3 16 | 17 | - name: Prepare java 18 | uses: actions/setup-java@v3 19 | with: 20 | distribution: 'zulu' 21 | java-version: '11' 22 | 23 | - name: Install clojure tools 24 | uses: DeLaGuardo/setup-clojure@10.1 25 | with: 26 | cli: 1.11.1.1208 # Clojure CLI based on tools.deps 27 | bb: 1.0.170 # Babashka 28 | clj-kondo: 2023.01.16 # Clj-kondo 29 | cljstyle: 0.15.0 # cljstyle 30 | zprint: 1.2.4 # zprint 31 | 32 | - name: Cache clojure dependencies 33 | uses: actions/cache@v3 34 | with: 35 | path: | 36 | ~/.m2/repository 37 | ~/.gitlibs 38 | ~/.deps.clj 39 | # List all files containing dependencies: 40 | key: cljdeps-${{ hashFiles('deps.edn') }} 41 | restore-keys: cljdeps- 42 | 43 | - name: Build and Run Clojure tests 44 | run: clojure -T:build ci 45 | 46 | - name: Run ClojureScript simple-compilation tests 47 | run: ./scripts/shadow-run-tests-simple 48 | 49 | - name: Run ClojureScript advanced-compilation tests 50 | run: ./scripts/shadow-run-tests-advanced 51 | -------------------------------------------------------------------------------- /.clj-kondo/metosin/malli-types/config.edn: -------------------------------------------------------------------------------- 1 | {:linters {:unresolved-symbol {:exclude [(malli.core/=>)]}, 2 | :type-mismatch {:namespaces {prpr3.stream.cross {cross {:arities {2 {:args [{:op :keys, 3 | :opt {:prpr3.stream.cross/key-comparator :fn, 4 | :prpr3.stream.cross/product-sort :fn, 5 | :prpr3.stream.cross.op.n-left-join/n :int, 6 | :prpr3.stream.cross/finalizer :fn, 7 | :prpr3.stream.cross/target-chunk-size :int}, 8 | :req {:prpr3.stream.cross/keys {:op :rest, 9 | :spec [:keyword 10 | :any]}, 11 | :prpr3.stream.cross/op :keyword}} 12 | :any], 13 | :ret :any}}}}}}}} 14 | -------------------------------------------------------------------------------- /deps.edn: -------------------------------------------------------------------------------- 1 | {:paths ["src"] 2 | :deps {org.clojure/clojure {:mvn/version "1.11.1"} 3 | 4 | org.clojure/clojurescript {:mvn/version "1.11.60"} 5 | org.clojure/core.async {:mvn/version "1.6.673"} 6 | 7 | com.taoensso/timbre {:mvn/version "6.0.4"} 8 | 9 | metosin/malli {:mvn/version "0.10.0"} 10 | com.github.mccraigmccraig/promesa {:mvn/version "10.0.608"} 11 | manifold/manifold {:mvn/version "0.3.0"} 12 | org.clojure/math.combinatorics {:mvn/version "0.1.6"} 13 | frankiesardo/linked {:mvn/version "1.3.0"}} 14 | 15 | :aliases 16 | {:test 17 | {:extra-paths ["test"] 18 | :extra-deps {io.github.cognitect-labs/test-runner 19 | {:git/tag "v0.5.1" :git/sha "dfb30dd"}}} 20 | 21 | :build {:deps {io.github.seancorfield/build-clj 22 | {:git/tag "v0.8.2" :git/sha "0ffdb4c"}} 23 | :ns-default build} 24 | 25 | :shadow-cljs 26 | {:extra-deps {thheller/shadow-cljs {:mvn/version "2.22.9"}} 27 | :main-opts ["-m" "shadow.cljs.devtools.cli"]} 28 | 29 | :shadow-node-repl 30 | {:extra-deps {nrepl/nrepl {:mvn/version "1.1.0-alpha1"} 31 | cider/piggieback {:mvn/version "0.5.3"} 32 | refactor-nrepl/refactor-nrepl {:mvn/version "3.6.0"} 33 | cider/cider-nrepl {:mvn/version "0.29.0"}}} 34 | 35 | :nrepl 36 | {:extra-paths ["../promesa/src"] 37 | :extra-deps 38 | {nrepl/nrepl {:mvn/version "1.1.0-alpha1"} 39 | cider/cider-nrepl {:mvn/version "0.29.0"} 40 | refactor-nrepl/refactor-nrepl {:mvn/version "3.6.0"}} 41 | 42 | :main-opts 43 | ["-m" "nrepl.cmdline" 44 | 45 | "--middleware" 46 | "[refactor-nrepl.middleware/wrap-refactor,cider.nrepl/cider-middleware]"] 47 | }}} 48 | -------------------------------------------------------------------------------- /src/promisespromises/promise/retry.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.promise.retry 2 | (:require 3 | [promesa.core :as pr] 4 | [promisespromises.promise :as prpr] 5 | [promisespromises.error :as err] 6 | [taoensso.timbre :refer [warn]])) 7 | 8 | (defn retry-n* 9 | "execute a fn repeatedly until it succeeds 10 | - f - a 1-args function of try-count, yielding a promise 11 | - max-retries - maximum number of times to re-try f before 12 | giving up (if 0 then f will be invoked just once) 13 | - delay-ms - delay between invocations of f" 14 | [f log-description max-retries delay-ms] 15 | 16 | #_{:clj-kondo/ignore [:loop-without-recur]} 17 | (pr/loop [n 0] 18 | (prpr/handle-always 19 | (do 20 | (when (> n 0) 21 | (warn "retrying promise:" n log-description)) 22 | (f n)) 23 | 24 | (fn [r e] 25 | 26 | (if (some? e) 27 | (if (< n max-retries) 28 | 29 | (pr/chain 30 | 31 | (pr/timeout 32 | (pr/deferred) 33 | delay-ms 34 | ::timeout) 35 | 36 | (fn [_] 37 | (pr/recur (inc n)))) 38 | 39 | (err/wrap-uncaught e)) 40 | 41 | r))))) 42 | 43 | (defn retry-n 44 | [f log-description max-retries delay-ms] 45 | (pr/let [r (retry-n* f log-description max-retries delay-ms)] 46 | (err/unwrap r))) 47 | 48 | (defn retry 49 | "execute a fn repeatedly until it succeeds 50 | - f - a 0-args function, yielding a promise 51 | - max-retries - maximum number of times to re-try f before 52 | giving up (if 0 then f will be invoked just once) 53 | - delay-ms - delay between invocations of f" 54 | [f log-description max-retries delay-ms] 55 | 56 | (retry-n 57 | (fn [_n] (f)) 58 | log-description 59 | max-retries 60 | delay-ms)) 61 | -------------------------------------------------------------------------------- /src/promisespromises/stream/test.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.test 2 | (:require 3 | [promesa.core :as pr] 4 | [promisespromises.promise :as prpr] 5 | [promisespromises.stream.protocols :as pt] 6 | [promisespromises.stream.transport :as stream.transport] 7 | )) 8 | 9 | (defn stream-of 10 | "returns a stream of the individual values 11 | (*not* chunked)" 12 | [vs] 13 | (let [s (stream.transport/stream)] 14 | (stream.transport/put-all-and-close! s vs) 15 | s)) 16 | 17 | (defn consume 18 | "consume a stream to a vector. an error 19 | will be added to the end of the vector 20 | as [::error ]" 21 | [s] 22 | (pr/loop [rs []] 23 | (prpr/handle-always 24 | (stream.transport/take! s ::drained) 25 | (fn [v e] 26 | (cond 27 | (some? e) (conj rs [::error e]) 28 | 29 | (= ::drained v) rs 30 | 31 | :else 32 | (pr/recur (conj rs v))))))) 33 | 34 | (defn safe-take! 35 | "transport/take! (with unwrapping) from a stream returning 36 | Promise<[::ok ]> | Promise<[::error ]>" 37 | [s & args] 38 | (prpr/handle-always 39 | (apply stream.transport/take! s args) 40 | (fn [v e] 41 | (if (some? e) 42 | [::error e] 43 | [::ok v])))) 44 | 45 | (defn safe-consume 46 | "keep safe-take! ing until ::closed, returning 47 | a vector of safe-take!s" 48 | [s] 49 | #_{:clj-kondo/ignore [:loop-without-recur]} 50 | (pr/loop [r []] 51 | (pr/let [[_t v :as t-v] (safe-take! s ::closed)] 52 | (if (= ::closed v) 53 | (conj r t-v) 54 | (pr/recur (conj r t-v)))))) 55 | 56 | 57 | (defn safe-low-take! 58 | "take! directly from a stream impl without any unwrapping 59 | Promise<[::ok ]> | Promise<[::error ]>" 60 | [s & args] 61 | (prpr/handle-always 62 | (apply pt/-take! s args) 63 | (fn [v e] 64 | (if (some? e) 65 | [::error e] 66 | [::ok v])))) 67 | 68 | (defn safe-low-consume 69 | "keep safe-low-take! ing until ::closed, returning 70 | a vector of safe-low-take!s" 71 | [s] 72 | #_{:clj-kondo/ignore [:loop-without-recur]} 73 | (pr/loop [r []] 74 | (pr/let [[_t v :as t-v] (safe-low-take! s ::closed)] 75 | (if (= ::closed v) 76 | (conj r t-v) 77 | (pr/recur (conj r t-v)))))) 78 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # promisespromises 2 | 3 | [![Build Status](https://github.com/yapsterapp/promisespromises/actions/workflows/clojure.yml/badge.svg)](https://github.com/yapsterapp/promisespromises/actions) 4 | [![Clojars Project](https://img.shields.io/clojars/v/com.github.yapsterapp/promisespromises.svg)](https://clojars.org/com.github.yapsterapp/promisespromises) 5 | [![cljdoc badge](https://cljdoc.org/badge/com.github.yapsterapp/promisespromises)](https://cljdoc.org/d/com.github.yapsterapp/promisespromises) 6 | 7 | A cross-platform Clojure+Script asynchronous streams API - with 8 | error-propagation and transparent chunking. 9 | Modelled on the [Manifold streams API](https://github.com/clj-commons/manifold) 10 | and using [Promesa CSP](https://funcool.github.io/promesa/latest/channels.html) 11 | as its transport. 12 | 13 | ## promisespromises.streams 14 | 15 | Implements a [Manifold-like](https://github.com/yapsterapp/promisespromises/blob/trunk/src/prpr/stream.cljc) 16 | asynchronous streams API. The underlying backpressure-sensitive 17 | Promise + Stream model is the same as Manifold, and the API follows the 18 | [Manifold streams API](https://github.com/clj-commons/manifold) closely 19 | 20 | ``` clojure 21 | (require '[promisespromises.stream :as s]) 22 | (def s (s/stream)) 23 | (s/put-all-and-close! s [0 1 2 3 4]) 24 | (def r (->> s (s/map inc) (s/reduce ::add +))) 25 | ;; => 15 26 | ``` 27 | 28 | It does a few things which vanilla Manifold doesn't: 29 | 30 | * **error propagation** - errors occuring during stream operations 31 | (`map`, `reduce`, `transform` &c) propagate downstream 32 | * **chunking** - streams can be (mostly) transparently chunked for 33 | improved performance (through fewer callbacks) 34 | * **uniform clj and cljs API** - you can use the same asynchronous 35 | co-ordination code on clj and cljs 36 | * **stream-joins** - `promisespromises.stream/cross` joins streams 37 | sorted in a key - it has various styles of join - inner, outer, 38 | left-n, merge, intersect, union - 39 | and can be used for a sensible constant-memory approach to 40 | in-memory joins with databases such as cassandra 41 | 42 | The `promisespromises.stream` API comes from work with cold streams, but 43 | stream objects are just 44 | [Promesa CSP](https://funcool.github.io/promesa/latest/channels.html) 45 | channels, and promise objects are just Promesa Promises, so you can 46 | always fall back to Promesa if you need something a bit different 47 | -------------------------------------------------------------------------------- /src/promisespromises/stream/protocols.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.protocols) 2 | 3 | ;; cross-platform interface to build a stream 4 | (defprotocol IStreamFactory 5 | (-stream 6 | [_] 7 | [_ buffer] 8 | [_ buffer xform] 9 | #?(:clj [_ buffer xform executor]))) 10 | 11 | (defprotocol IMaybeStream 12 | (-stream? [this])) 13 | 14 | (extend-protocol IMaybeStream 15 | #?(:clj Object :cljs default) 16 | (-stream? [_] false)) 17 | 18 | ;; cross-platform stream interface. 19 | ;; under the hood these will be regular manifold streams 20 | ;; or core.async chans and the full manifold/core.async 21 | ;; API will be there for more complex stream processing 22 | (defprotocol IStream 23 | (-closed? [s]) 24 | (-put! 25 | [sink val] 26 | [sink val timeout timeout-val]) 27 | (-take! 28 | [source] 29 | [source default-val] 30 | [source default-val timeout timeout-val]) 31 | (-close! [this]) 32 | (-connect-via 33 | [source f sink] 34 | [source f sink opts]) 35 | (-wrap-value [_ v]) 36 | (-buffer [_ n])) 37 | 38 | ;; a chunk of values which can be placed on a stream and 39 | ;; will be handled as if the values themselves were on the stream, 40 | ;; leading to much less resource-intensive stream processing in 41 | ;; some circumstances (where data naturally comes in chunks, 42 | ;; e.g. pages of db-query results) 43 | (defprotocol IStreamChunk 44 | (-chunk-values [this]) 45 | (-chunk-flatten [this] "flatten any nested promises returning Promise")) 46 | 47 | ;; a stateful object for efficiently accumulating chunks 48 | (defprotocol IStreamChunkBuilder 49 | (-start-chunk [_] [_ val]) 50 | (-add-to-chunk [_ val]) 51 | (-add-all-to-chunk [_ vals]) 52 | (-finish-chunk [_] [_ val]) 53 | (-discard-chunk [_]) 54 | (-building-chunk? [_]) 55 | (-chunk-state [_])) 56 | 57 | ;; a potentially wrapped value on a stream 58 | (defprotocol IStreamValue 59 | (-unwrap-value [_])) 60 | 61 | (defprotocol IStreamError 62 | (-unwrap-error [_])) 63 | 64 | ;; j.u.c wraps errors in platform exceptions... 65 | ;; this protocol helps us unwrap them 66 | (defprotocol IPlatformErrorWrapper 67 | (-unwrap-platform-error [_])) 68 | 69 | (defprotocol IChunkConsumer 70 | (-peek-chunk [_] 71 | "peek a single chunk or value") 72 | (-take-chunk! [_] 73 | "take chunks or plain values from a stream paying attention to errors 74 | - returns Promise") 75 | (-pushback-chunk! [_ chunk-or-val] 76 | "push a chunk or values back onto the logical stream (into the buffer)")) 77 | 78 | (defprotocol IValueConsumer 79 | (-peek-value [_] 80 | "peek a single value") 81 | (-take-value! [_] 82 | "take single values from a stream paying attention to chunks and errors 83 | - returns Promise")) 84 | -------------------------------------------------------------------------------- /src/promisespromises/test/reduce.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.test.reduce 2 | (:require 3 | [promesa.core :as pr] 4 | [promisespromises.promise :as prpr] 5 | [promisespromises.error :as err])) 6 | 7 | (def max-depth 20) 8 | 9 | (defn seq-of-fns? 10 | [v] 11 | (and 12 | (sequential? v) 13 | (every? fn? v))) 14 | 15 | (defn reduce-pr-fns* 16 | "sequentially reduce a seq of 17 | promise-returning 0-args fns into 18 | Promise<[results]>" 19 | [fns] 20 | #_{:clj-kondo/ignore [:loop-without-recur]} 21 | (pr/loop [rs [] 22 | depth 0 23 | fns fns] 24 | 25 | ;; (prn "reduce-pr-fns: loop" (count rs) depth (count fns)) 26 | 27 | (let [[f & remf] fns] 28 | (if (nil? f) 29 | 30 | rs 31 | 32 | (prpr/catch-always 33 | (let [r-p (f)] 34 | ;; (prn "reduce-pr-fns: result-p" depth (type r-p)) 35 | 36 | (pr/let [r r-p] 37 | ;; (prn "reduce-pr-fns: derefed result" depth (type r)) 38 | 39 | (cond 40 | 41 | ;; if a form returns a single fn (or a promise of a fn) 42 | ;; and we're not beyond the max-depth, then call it 43 | (fn? r) 44 | #_{:clj-kondo/ignore [:redundant-do]} 45 | (do 46 | ;; (prn "single fn") 47 | (if (< depth max-depth) 48 | (pr/recur 49 | rs 50 | (inc depth) 51 | ;; remf is a list, so conj puts r at the front 52 | (conj remf r)) 53 | 54 | (err/wrap-uncaught 55 | (ex-info "testing : max depth exceeded" 56 | {:max-depth max-depth})))) 57 | 58 | ;; if a form returns a seq of fns, then call them 59 | ;; in order 60 | (seq-of-fns? r) 61 | #_{:clj-kondo/ignore [:redundant-do]} 62 | (do 63 | ;; (prn "seq-of-fns") 64 | (if (< depth max-depth) 65 | (pr/recur 66 | rs 67 | (inc depth) 68 | (concat r remf)) 69 | 70 | (err/wrap-uncaught 71 | (ex-info "testing : max depth exceeded" 72 | {:max-depth max-depth})))) 73 | 74 | :else 75 | #_{:clj-kondo/ignore [:redundant-do]} 76 | (do 77 | ;; (prn "normal result") 78 | (pr/recur 79 | (conj rs r) 80 | 0 81 | remf))))) 82 | 83 | (fn [e] 84 | (err/wrap-uncaught e))))))) 85 | 86 | (defn reduce-pr-fns 87 | [nm fns] 88 | ;; (println "reduce-pr-fns*: " nm) 89 | (pr/let [r (reduce-pr-fns* fns)] 90 | ;; (println "reduce-pr-fns*: " nm ": done") 91 | (err/unwrap r))) 92 | -------------------------------------------------------------------------------- /src/promisespromises/stream/types.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.types 2 | (:require 3 | #?(:cljs [cljs.core :refer [IEquiv]]) 4 | [promesa.core :as pr] 5 | [promisespromises.stream.protocols :as pt])) 6 | 7 | (extend-protocol pt/IStreamValue 8 | #?(:clj Object :cljs default) 9 | (-unwrap-value [this] this) 10 | 11 | nil 12 | (-unwrap-value [_this] nil)) 13 | 14 | ;; core.async channels don't support nil values, 15 | ;; but we would like clj and cljs to be as similar 16 | ;; as possible, so we'll wrap nils when we are 17 | ;; using core.async 18 | (deftype StreamNil [] 19 | pt/IStreamValue 20 | (-unwrap-value [_] nil) 21 | 22 | #?@(:clj 23 | [Object 24 | (equals [_a b] 25 | (instance? StreamNil b))] 26 | 27 | :cljs 28 | [IEquiv 29 | (-equiv [this other] (and 30 | (= (type this) (type other)) 31 | (= (.-x this) (.-x other))))])) 32 | 33 | (defn stream-nil 34 | [] 35 | (->StreamNil)) 36 | 37 | (defn stream-nil? 38 | [v] 39 | (instance? StreamNil v)) 40 | 41 | (deftype StreamPromise [p] 42 | pt/IStreamValue 43 | (-unwrap-value [_] p)) 44 | 45 | (defn stream-promise 46 | [p] 47 | (->StreamPromise p)) 48 | 49 | (defn stream-promise? 50 | [v] 51 | (instance? StreamPromise v)) 52 | 53 | ;; neither core.async nor manifold have error-states on 54 | ;; streams/chans - so we'll model errors by putting a 55 | ;; wrapped value onto a stream and closing it immediately 56 | ;; thereafter. whenever an error value is taken from a 57 | ;; stream it will result in an errored promise or a 58 | ;; downstream stream also getting a wrapped error-value/closed 59 | (deftype StreamError [err] 60 | pt/IStreamError 61 | (-unwrap-error [_] err) 62 | pt/IStreamValue 63 | (-unwrap-value [_] 64 | ;; (warn err "unwrapping StreamError" (ex-data err)) 65 | (throw err))) 66 | 67 | (defn stream-error? 68 | [v] 69 | (instance? StreamError v)) 70 | 71 | (defn stream-error 72 | [err] 73 | (if (stream-error? err) 74 | err 75 | (->StreamError err))) 76 | 77 | (extend-protocol pt/IStreamChunk 78 | #?(:clj Object 79 | :cljs default) 80 | (-chunk-flatten [this] this) 81 | 82 | nil 83 | (-chunk-flatten [_] nil)) 84 | 85 | (declare ->StreamChunk) 86 | 87 | (deftype StreamChunk [values] 88 | pt/IStreamChunk 89 | 90 | (-chunk-values [_] values) 91 | (-chunk-flatten [_] 92 | (pr/let [realized-values (pr/all values)] 93 | (->StreamChunk realized-values))) 94 | 95 | #?@(:clj [Object 96 | (equals [a b] 97 | (and (instance? StreamChunk b) 98 | (= (.-values a) (.-values b))))] 99 | :cljs [IEquiv 100 | (-equiv [a b] 101 | (and (instance? StreamChunk b) 102 | (= (.-values a) (.-values b))))])) 103 | 104 | #?(:clj 105 | (defmethod print-method StreamChunk [x writer] 106 | (.write writer "#Chunk<") 107 | (print-method (pt/-chunk-values x) writer) 108 | (.write writer ">"))) 109 | 110 | (defn stream-chunk? 111 | [v] 112 | (instance? StreamChunk v)) 113 | 114 | (defn stream-chunk 115 | [values] 116 | (let [values (vec values)] 117 | (when (<= (count values) 0) 118 | (throw (ex-info "empty chunk not allowed" {}))) 119 | (->StreamChunk values))) 120 | -------------------------------------------------------------------------------- /test/promisespromises/promise/retry_test.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.promise.retry-test 2 | (:require 3 | [promisespromises.test :refer [deftest testing is with-log-level]] 4 | [promesa.core :as pr] 5 | [promisespromises.promise :as prpr] 6 | [promisespromises.promise.retry :as sut])) 7 | 8 | (deftest retry-n-test 9 | (with-log-level :info 10 | (testing "returns an immediately successful result" 11 | (let [f (fn [n] 12 | (is (= n 0)) 13 | (pr/resolved ::ok))] 14 | 15 | (pr/let [r (sut/retry-n f ::retry-test 1 0)] 16 | (is (= ::ok r))))) 17 | 18 | (testing "works with 0 retries" 19 | (let [f (fn [n] 20 | (is (= n 0)) 21 | (pr/resolved ::ok))] 22 | 23 | (pr/let [r (sut/retry-n f ::retry-test 0 0)] 24 | (is (= ::ok r)))) 25 | (let [x (ex-info "boo" {:boo "boo"}) 26 | f (fn [n] 27 | (is (= n 0)) 28 | (pr/rejected x))] 29 | 30 | (pr/let [[k r] (prpr/merge-always 31 | (sut/retry-n f ::retry-test 0 0))] 32 | (is (= ::prpr/error k)) 33 | (is (= {:boo "boo"} (ex-data r)))))) 34 | 35 | (testing "retries as specified" 36 | (let [ns (atom #{0 1 2}) 37 | cnt (atom 0) 38 | f (fn [n] 39 | (swap! ns disj n) 40 | (if (> (swap! cnt inc) 2) 41 | (pr/resolved ::ok) 42 | (pr/rejected (ex-info "boo" {:boo "boo"}))))] 43 | 44 | (pr/let [r (sut/retry-n f ::retry-test 3 0)] 45 | (is (empty? @ns)) 46 | (is (= ::ok r))))) 47 | 48 | (testing "fails when out of retries" 49 | (let [x (ex-info "boo" {:boo "boo"}) 50 | ns (atom #{4 5 6}) 51 | cnt (atom 0) 52 | f (fn [n] 53 | (swap! ns disj (+ n 4)) 54 | (if (> (swap! cnt inc) 2) 55 | (pr/resolved ::ok) 56 | (pr/rejected x)))] 57 | 58 | (pr/let [[r-k r-v] (prpr/merge-always 59 | (sut/retry-n f ::retry-test 1 0))] 60 | (is (= #{6} @ns)) 61 | (is (= ::prpr/error r-k)) 62 | (is (= x r-v))))))) 63 | 64 | (deftest retry-test 65 | (with-log-level :error 66 | 67 | (testing "returns an immediately successful result" 68 | (let [f (fn [] (pr/resolved ::ok))] 69 | (pr/let [r (sut/retry f ::retry-test 1 0)] 70 | (is (= ::ok r))))) 71 | 72 | (testing "works with 0 retries" 73 | (let [f (fn [] (pr/resolved ::ok))] 74 | (pr/let [r (sut/retry f ::retry-test 0 0)] 75 | (is (= ::ok r)))) 76 | (let [x (ex-info "boo" {:boo "boo"}) 77 | f (fn [] (pr/rejected x))] 78 | (pr/let [[k r] (prpr/merge-always 79 | (sut/retry f ::retry-test 0 0))] 80 | (is (= ::prpr/error k)) 81 | (is (= {:boo "boo"} (ex-data r)))))) 82 | 83 | (testing "retries as specified" 84 | (let [cnt (atom 0) 85 | f (fn [] (if (> (swap! cnt inc) 2) 86 | (pr/resolved ::ok) 87 | (pr/rejected (ex-info "boo" {:boo "boo"}))))] 88 | (pr/let [r (sut/retry f ::retry-test 2 0)] 89 | (is (= ::ok r))))) 90 | 91 | (testing "fails when out of retries" 92 | (let [x (ex-info "boo" {:boo "boo"}) 93 | cnt (atom 0) 94 | f (fn [] (if (> (swap! cnt inc) 2) 95 | (pr/resolved ::ok) 96 | (pr/rejected x)))] 97 | (pr/let [[r-k r-v] (prpr/merge-always 98 | (sut/retry f ::retry-test 1 0))] 99 | (is (= ::prpr/error r-k)) 100 | (is (= x r-v))))))) 101 | -------------------------------------------------------------------------------- /src/promisespromises/error.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.error 2 | (:refer-clojure :exclude [ex-info]) 3 | (:require 4 | [clojure.core :as clj] 5 | #?(:clj [clojure.pprint :as pprint]) 6 | [promisespromises.error.protocols :as pt])) 7 | 8 | (defn ex-info 9 | ([type] 10 | (ex-info type {} nil)) 11 | ([type map] 12 | (ex-info type map nil)) 13 | ([type map cause] 14 | (clj/ex-info 15 | (str type) 16 | (assoc map :error/type type) 17 | cause))) 18 | 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | ;;; define UncaughtErrorWrapper and CaughtErrorWrapper types 21 | ;;; to wrap javascript errors, preventing auto-rejection of promises 22 | ;;; when returnin an error as the value 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 | 25 | 26 | ;; UncaughtErrorWrapper is an error which is wrapped with the intention 27 | ;; that it should be eventually rethrown (when unwrapped) 28 | (deftype UncaughtErrorWrapper [err] 29 | pt/IErrorWrapper 30 | (-unwrap [_] (throw err)) 31 | (-unwrap-value [_] err) 32 | 33 | ;; #?@(:clj [clojure.lang.IDeref 34 | ;; (deref [_] err)] 35 | ;; :cljs [IDeref 36 | ;; (-deref [_] err)]) 37 | ) 38 | 39 | #?(:clj 40 | (defn print-uncaught-error-wrapper 41 | [uew ^java.io.Writer w] 42 | (.write w "#UncaughtErrorWrapper [") 43 | (print-method (pt/-unwrap-value uew) w) 44 | (.write w "]"))) 45 | 46 | #?(:clj 47 | (defmethod print-method UncaughtErrorWrapper [this ^java.io.Writer w] 48 | (print-uncaught-error-wrapper this w))) 49 | 50 | #?(:clj 51 | (defmethod print-dup UncaughtErrorWrapper [this ^java.io.Writer w] 52 | (print-uncaught-error-wrapper this w))) 53 | 54 | #?(:clj 55 | (.addMethod pprint/simple-dispatch 56 | UncaughtErrorWrapper 57 | (fn [uew] 58 | (print-uncaught-error-wrapper uew *out*)))) 59 | 60 | #?(:cljs 61 | (extend-protocol IPrintWithWriter 62 | UncaughtErrorWrapper 63 | (-pr-writer [uew writer _] 64 | (write-all writer "#UncaughtErrorWrapper[" (pt/-unwrap uew) "]")))) 65 | 66 | 67 | ;; CaughtErrorWrapper is an error which is wrapped with the intention 68 | ;; that it should be treated as a value and *not* rethrown when unwrapped 69 | (deftype CaughtErrorWrapper [err] 70 | pt/IErrorWrapper 71 | (-unwrap [_] err) 72 | (-unwrap-value [_] err) 73 | 74 | ;; #?@(:clj [clojure.lang.IDeref 75 | ;; (deref [_] err)] 76 | ;; :cljs [IDeref 77 | ;; (-deref [_] err)]) 78 | ) 79 | 80 | #?(:clj 81 | (defn print-caught-error-wrapper 82 | [uew ^java.io.Writer w] 83 | (.write w "#CaughtErrorWrapper [") 84 | (print-method (pt/-unwrap uew) w) 85 | (.write w "]"))) 86 | 87 | #?(:clj 88 | (defmethod print-method CaughtErrorWrapper [this ^java.io.Writer w] 89 | (print-caught-error-wrapper this w))) 90 | 91 | #?(:clj 92 | (defmethod print-dup CaughtErrorWrapper [this ^java.io.Writer w] 93 | (print-caught-error-wrapper this w))) 94 | 95 | #?(:clj 96 | (.addMethod pprint/simple-dispatch 97 | CaughtErrorWrapper 98 | (fn [uew] 99 | (print-caught-error-wrapper uew *out*)))) 100 | 101 | #?(:cljs 102 | (extend-protocol IPrintWithWriter 103 | CaughtErrorWrapper 104 | (-pr-writer [uew writer _] 105 | (write-all writer "#CaughtErrorWrapper[" (pt/-unwrap uew) "]")))) 106 | 107 | 108 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 109 | ;;; implement UncaughtErrorWrapper and CaughtErrorWrapper types 110 | ;;; behaviours 111 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 112 | 113 | (extend-protocol pt/IErrorWrapper 114 | #?(:clj Object :cljs default) 115 | (-unwrap [this] this) 116 | (-unwrap-value [this] this) 117 | 118 | nil 119 | (-unwrap [_this] nil) 120 | (-unwrap-value [_this] nil)) 121 | 122 | (defn uncaught-wrapper? 123 | [v] 124 | (instance? UncaughtErrorWrapper v)) 125 | 126 | (defn caught-wrapper? 127 | [v] 128 | (instance? CaughtErrorWrapper v)) 129 | 130 | (defn wrapper? 131 | [v] 132 | (or 133 | (instance? UncaughtErrorWrapper v) 134 | (instance? CaughtErrorWrapper v))) 135 | 136 | (defn wrap-uncaught 137 | [err] 138 | (UncaughtErrorWrapper. err)) 139 | 140 | (defn wrap-caught 141 | [err] 142 | (CaughtErrorWrapper. err)) 143 | 144 | (defn unwrap 145 | "unwrap and maybe throw" 146 | [e] 147 | (pt/-unwrap e)) 148 | 149 | (defn unwrap-value 150 | "unwrap value, never throwing" 151 | [e] 152 | (pt/-unwrap-value e)) 153 | -------------------------------------------------------------------------------- /test/promisespromises/stream/zip_impl_test.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.zip-impl-test 2 | (:require 3 | [promesa.core :as pr] 4 | [promisespromises.test :refer [deftest testing is]] 5 | [promisespromises.stream.protocols :as pt] 6 | [promisespromises.stream.types :as types] 7 | [promisespromises.stream.transport :as transport] 8 | [promisespromises.stream.zip-impl :as sut])) 9 | 10 | (deftest chunk-zip-test 11 | (testing "zips plain value streams" 12 | (let [a (transport/stream) 13 | _ (transport/put-all-and-close! a [0 1 2]) 14 | b (transport/stream) 15 | _ (transport/put-all-and-close! b [::foo ::bar]) 16 | 17 | out (sut/chunk-zip a b)] 18 | 19 | (pr/let [r1 (transport/take! out ::closed) 20 | r2 (transport/take! out ::closed) 21 | r3 (transport/take! out ::closed) 22 | ] 23 | (is (= [0 ::foo] r1)) 24 | (is (= [1 ::bar] r2)) 25 | (is (= ::closed r3))))) 26 | 27 | (testing "zips chunked streams" 28 | 29 | (testing "streams of different lengths" 30 | (let [a (transport/stream) 31 | _ (transport/put-all-and-close! a [(types/stream-chunk [0 1 2])]) 32 | b (transport/stream) 33 | _ (transport/put-all-and-close! b [(types/stream-chunk [::foo ::bar])]) 34 | 35 | out (sut/chunk-zip a b)] 36 | 37 | (pr/let [r1 (transport/take! out ::closed) 38 | r2 (transport/take! out ::closed)] 39 | (is (types/stream-chunk? r1)) 40 | (is (= [[0 ::foo] 41 | [1 ::bar]] 42 | (pt/-chunk-values r1))) 43 | (is (= ::closed r2))))) 44 | 45 | (testing "chunks of different sizes" 46 | (let [a (transport/stream) 47 | _ (transport/put-all-and-close! a [(types/stream-chunk [0 1 2]) 48 | (types/stream-chunk [3])]) 49 | b (transport/stream) 50 | _ (transport/put-all-and-close! b [(types/stream-chunk [::foo ::bar]) 51 | (types/stream-chunk [::baz ::blah])]) 52 | 53 | out (sut/chunk-zip a b)] 54 | 55 | (pr/let [r1 (transport/take! out ::closed) 56 | r2 (transport/take! out ::closed) 57 | r3 (transport/take! out ::closed) 58 | r4 (transport/take! out ::closed)] 59 | (is (types/stream-chunk? r1)) 60 | (is (types/stream-chunk? r2)) 61 | (is (types/stream-chunk? r3)) 62 | (is (= [[0 ::foo] 63 | [1 ::bar]] (pt/-chunk-values r1))) 64 | (is (= [[2 ::baz]] (pt/-chunk-values r2))) 65 | (is (= [[3 ::blah]] (pt/-chunk-values r3))) 66 | (is (= ::closed r4)))))) 67 | 68 | (testing "zips mixed streams" 69 | (let [a (transport/stream) 70 | _ (transport/put-all-and-close! a [0 (types/stream-chunk [1 2])]) 71 | b (transport/stream) 72 | _ (transport/put-all-and-close! b [(types/stream-chunk [::foo ::bar])]) 73 | 74 | out (sut/chunk-zip a b)] 75 | 76 | (pr/let [r1 (transport/take! out ::closed) 77 | r2 (transport/take! out ::closed) 78 | r3 (transport/take! out ::closed)] 79 | (is (= [0 ::foo] r1)) 80 | (is (types/stream-chunk? r2)) 81 | (is (= [[1 ::bar]] (pt/-chunk-values r2))) 82 | (is (= ::closed r3))))) 83 | 84 | (testing "propagates errors" 85 | (let [a (transport/stream) 86 | _ (transport/put-all-and-close! a [(types/stream-chunk [0 1]) 87 | (types/stream-error 88 | (ex-info "boo!" 89 | {:boo "boo!"}))]) 90 | b (transport/stream) 91 | _ (transport/put-all-and-close! b [::foo (types/stream-chunk [::bar])]) 92 | 93 | out (sut/chunk-zip a b)] 94 | 95 | (pr/let [r1 (transport/take! out ::closed) 96 | r2 (transport/take! out ::closed) 97 | [k3 r3] (pr/handle 98 | (transport/take! out ::closed) 99 | (fn [succ err] 100 | (if (some? err) 101 | [::error err] 102 | [::ok succ])))] 103 | (is (= [0 ::foo] r1)) 104 | (is (types/stream-chunk? r2)) 105 | (is (= [[1 ::bar]] (pt/-chunk-values r2))) 106 | (is (= ::error k3)) 107 | (is (= {:boo "boo!"} 108 | (-> r3 109 | (transport/unwrap-platform-error) 110 | (ex-data))))))) 111 | ) 112 | -------------------------------------------------------------------------------- /src/promisespromises/stream/transport.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.transport 2 | "low-level transport - covers put!ing onto and 3 | take!ing from a stream, error propagation, 4 | special value wrapping/unwrapping and 5 | stream connection" 6 | (:require 7 | [promesa.core :as pr] 8 | [taoensso.timbre :refer [warn]] 9 | [promisespromises.promise :as prpr] 10 | [promisespromises.stream.protocols :as pt] 11 | [promisespromises.stream.types :as types] 12 | #?(:clj [promisespromises.stream.manifold :as stream.manifold] 13 | :cljs [promisespromises.stream.core-async :as stream.async]) 14 | [promisespromises.stream.promesa-csp :as stream.promesa-csp]) 15 | (:refer-clojure 16 | :exclude [map filter mapcat reductions reduce concat])) 17 | 18 | (defn default-stream-factory 19 | [] 20 | stream.promesa-csp/stream-factory) 21 | 22 | (def stream-factory 23 | (atom (default-stream-factory))) 24 | 25 | (defn stream 26 | ([] 27 | (pt/-stream @stream-factory)) 28 | ([buffer] 29 | (pt/-stream @stream-factory buffer)) 30 | ([buffer xform] 31 | (pt/-stream @stream-factory buffer xform)) 32 | #?(:clj 33 | ([buffer xform executor] 34 | (pt/-stream @stream-factory buffer xform executor)))) 35 | 36 | (defn stream? 37 | [v] 38 | (pt/-stream? v)) 39 | 40 | (defn close! 41 | [s] 42 | (pt/-close! s)) 43 | 44 | (defn closed? 45 | "not in the public API, because it's so often a race condition, 46 | but may be sometimes useful for inspection" 47 | [s] 48 | (pt/-closed? s)) 49 | 50 | (defn put! 51 | "put a value onto a stream with backpressure - returns 52 | Promise which eventually resolves to: 53 | - true when the value was accepted onto the stream 54 | - false if the stream was closed 55 | - timeout-val if the put! timed out" 56 | ([sink val] 57 | (pt/-put! 58 | sink 59 | (pt/-wrap-value sink val))) 60 | ([sink val timeout timeout-val] 61 | (pt/-put! 62 | sink 63 | (pt/-wrap-value sink val) 64 | timeout 65 | timeout-val))) 66 | 67 | (defn error! 68 | "mark a stream as errored 69 | 70 | puts an marker wrapper with the error on to the stream, 71 | and then closes it. consuming fns will throw an error 72 | when they encounter it, so errors are always propagated 73 | 74 | it would be nicer if the underlying stream/channel had 75 | an error state, but this is the best to be done without 76 | wrapping the underlying stream/channel" 77 | [sink err] 78 | (let [wrapped-err (types/stream-error err)] 79 | (-> 80 | (pt/-put! sink wrapped-err) 81 | (pr/handle 82 | (fn [_ _] 83 | (pt/-close! sink))) 84 | (pr/handle 85 | (fn [_ _] 86 | ;; return false so that error! can be used like a put! 87 | ;; in connect fns 88 | false))))) 89 | 90 | (defn put-all! 91 | "put all values onto a stream with backpressure 92 | returns Promise yielding true if all 93 | values were accepted onto the stream, false otherwise" 94 | [sink vals] 95 | #_{:clj-kondo/ignore [:loop-without-recur]} 96 | (pr/loop [vals vals] 97 | ;; (prn "put-all! in:" vals) 98 | (if (empty? vals) 99 | true 100 | (pr/chain 101 | (put! sink (first vals)) 102 | (fn [result] 103 | ;; (prn "put-all! out:" result) 104 | (if result 105 | (pr/recur (rest vals)) 106 | false)))))) 107 | 108 | (defn put-all-and-close! 109 | [sink vals] 110 | (pr/handle 111 | (put-all! sink vals) 112 | (fn [s e] 113 | (close! sink) 114 | (if (some? e) 115 | (pr/rejected e) 116 | s)))) 117 | 118 | (defn take! 119 | "take a value from a stream - returns Promise 120 | which evantually resolves to: 121 | - a value when one becomes available 122 | - nil or default-val if the stream closes 123 | - timeout-val if no value becomes available in timeout ms 124 | - an error if the stream errored (i.e. an error occurred 125 | during some upstream operation) 126 | 127 | NOTE take! API would ideally not return chunks, but it curently does... 128 | don't currently have a good way of using a consumer/ChunkConsumer 129 | in the public API, since i don't really want to wrap the underlying stream 130 | or channel in something else" 131 | ([source] 132 | (pr/chain 133 | (pt/-take! source) 134 | pt/-unwrap-value)) 135 | ([source default-val] 136 | (pr/chain 137 | (pt/-take! source default-val) 138 | pt/-unwrap-value)) 139 | ([source default-val timeout timeout-val] 140 | (pr/chain 141 | (pt/-take! source default-val timeout timeout-val) 142 | pt/-unwrap-value))) 143 | 144 | (defn unwrap-platform-error 145 | [x] 146 | (if (satisfies? pt/IPlatformErrorWrapper x) 147 | (pt/-unwrap-platform-error x) 148 | x)) 149 | 150 | (defn safe-connect-via-fn 151 | "return a new connect-via fn which handles errors 152 | in the connect fn or from the source and error!s 153 | the sink" 154 | [f sink] 155 | 156 | (fn [val] 157 | ;; (prn "safe-connect-via-fn: value" val) 158 | (prpr/handle-always 159 | 160 | ;; always apply f to unwrapped values 161 | (-> val 162 | (pt/-unwrap-value) 163 | (f)) 164 | 165 | (fn [success err] 166 | ;; (warn "safe-connect-via-fn: handle" success err) 167 | 168 | (if (some? err) 169 | (error! sink err) 170 | 171 | ;; we don't need to put! the value onto sink 172 | ;; f will already have done that... we just 173 | ;; return f's return value 174 | success))))) 175 | 176 | (defn connect-via 177 | "feed all messages from src into callback on the 178 | understanding that they will eventually propagate into 179 | dst 180 | 181 | the return value of callback should be a boolean or 182 | promise yielding a boolean. when false the downstream sink 183 | is assumed to be closed and the connection is severed" 184 | ([source f sink] 185 | (pt/-connect-via 186 | source 187 | (safe-connect-via-fn f sink) 188 | sink 189 | nil)) 190 | ([source f sink opts] 191 | (pt/-connect-via 192 | source 193 | (safe-connect-via-fn f sink) 194 | sink 195 | opts))) 196 | -------------------------------------------------------------------------------- /src/promisespromises/stream/chunk.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.chunk 2 | (:require 3 | #?(:clj [clojure.core :refer [print-method]]) 4 | [promesa.core :as pr] 5 | [promisespromises.error :as err] 6 | [promisespromises.stream.protocols :as pt] 7 | [promisespromises.stream.transport :as transport] 8 | [promisespromises.stream.types :as types])) 9 | 10 | (def default-chunk-size 1000) 11 | 12 | (deftype StreamChunkBuilder [records-a] 13 | pt/IStreamChunkBuilder 14 | (-start-chunk [_] 15 | (when (some? @records-a) 16 | (throw (err/ex-info ::chunk-already-building {:records-a @records-a}))) 17 | (reset! records-a (transient []))) 18 | 19 | (-start-chunk [_ val] 20 | (when (some? @records-a) 21 | (throw (err/ex-info ::chunk-already-building {:records-a @records-a}))) 22 | (reset! records-a (transient [val]))) 23 | 24 | (-add-to-chunk [_ val] 25 | (when (nil? @records-a) 26 | (throw (err/ex-info ::no-chunk-building {}))) 27 | (swap! records-a conj! val)) 28 | 29 | (-add-all-to-chunk [_ vals] 30 | (when (nil? @records-a) 31 | (throw (err/ex-info ::no-chunk-building {}))) 32 | (swap! 33 | records-a 34 | (fn [records] 35 | (reduce 36 | (fn [r v] (conj! r v)) 37 | records 38 | vals)))) 39 | 40 | (-finish-chunk [_] 41 | (when (nil? @records-a) 42 | (throw (err/ex-info ::no-chunk-building {}))) 43 | (let [records (persistent! @records-a)] 44 | (reset! records-a nil) 45 | (types/stream-chunk records))) 46 | 47 | (-finish-chunk [_ val] 48 | (when (nil? @records-a) 49 | (throw (err/ex-info ::no-chunk-building {}))) 50 | (swap! records-a conj! val) 51 | (let [records (persistent! @records-a)] 52 | (reset! records-a nil) 53 | (types/stream-chunk records))) 54 | 55 | (-discard-chunk [_] 56 | (reset! records-a nil)) 57 | 58 | (-building-chunk? [_] (some? @records-a)) 59 | 60 | (-chunk-state [_] @records-a)) 61 | 62 | #?(:clj 63 | (defmethod print-method StreamChunkBuilder [x writer] 64 | (.write writer "#promisespromises.stream.ChunkBuilder<") 65 | (print-method (pt/-chunk-state x) writer) 66 | (.write writer ">"))) 67 | 68 | (defn stream-chunk-builder 69 | [] 70 | (->StreamChunkBuilder (atom nil))) 71 | 72 | (defn should-finish-chunk? 73 | "true if building a chunk and: 74 | 75 | - (nil? partition-by) and (>= chunk-size target-chunk-size) 76 | - (some? partition-by-fn) 77 | and (>= chunk-size target-chunk-size) 78 | and (not= (partition-by-fn (last chunk-state) (partition-by next-value)))" 79 | 80 | [chunk-builder target-chunk-size partition-by-fn next-value] 81 | (if (pt/-building-chunk? chunk-builder) 82 | 83 | (or 84 | 85 | (and (nil? partition-by-fn) 86 | (>= (count (pt/-chunk-state chunk-builder)) 87 | target-chunk-size)) 88 | 89 | (let [ch-data(pt/-chunk-state chunk-builder)] 90 | (and (some? partition-by-fn) 91 | (>= (count ch-data) 92 | target-chunk-size) 93 | (not= (partition-by-fn (nth ch-data (-> ch-data count dec))) 94 | (partition-by-fn next-value))))) 95 | 96 | false)) 97 | 98 | (defn make-chunker-xform 99 | "return a transducer which builds chunks from a stream, optionally 100 | partition-by the stream ensuring that partitions never span 101 | chunk boundaries 102 | 103 | NOTE that no timeout is possible with a transducer 104 | 105 | - target-chunk-size : will wrap a chunk when this size is exceeded, 106 | or as soon as possible afterwards (if a chunk is received, or 107 | partition-by is given) 108 | - partition-by-fn : also partition-by the stream with this fn and 109 | ensure partitions never cross chunk boundaries" 110 | ([target-chunk-size] 111 | (make-chunker-xform target-chunk-size nil)) 112 | 113 | ([target-chunk-size partition-by-fn] 114 | (let [cb (stream-chunk-builder)] 115 | (fn [rf] 116 | (fn 117 | ([] (rf)) 118 | 119 | ([result] 120 | (when (pt/-building-chunk? cb) 121 | (let [ch (pt/-finish-chunk cb)] 122 | (rf result (if (some? partition-by-fn) 123 | (types/stream-chunk 124 | (partition-by 125 | partition-by-fn 126 | (pt/-chunk-values ch))) 127 | ch)))) 128 | (rf result)) 129 | 130 | ([result input] 131 | (if (pt/-building-chunk? cb) 132 | 133 | (if (should-finish-chunk? cb target-chunk-size partition-by-fn input) 134 | (do 135 | (let [ch (pt/-finish-chunk cb)] 136 | (rf result (if (some? partition-by-fn) 137 | (types/stream-chunk 138 | (partition-by 139 | partition-by-fn 140 | (pt/-chunk-values ch))) 141 | ch))) 142 | (pt/-start-chunk cb input)) 143 | 144 | (pt/-add-to-chunk cb input)) 145 | 146 | (pt/-start-chunk cb input)) 147 | 148 | result)))))) 149 | 150 | (defn dechunk 151 | "given a stream of mixed unchunked-values and chunks 152 | return a stream of 153 | [::unchunked|::chunk-start|::chunk|::chunk-end val]" 154 | [s] 155 | (let [s' (transport/stream)] 156 | (transport/connect-via 157 | s 158 | (fn [v] 159 | (cond 160 | (types/stream-chunk? v) 161 | (let [vals (pt/-chunk-values v) 162 | n (count vals)] 163 | (pr/chain 164 | (transport/put! s' [::chunk-start (first vals)]) 165 | (fn [_] 166 | (when (> n 2) 167 | (transport/put-all! 168 | s' 169 | (-> vals 170 | (subvec 1 (- n 2)) 171 | (as-> % 172 | (map (fn [v] 173 | [::chunk v]) 174 | %)))))) 175 | (fn [_] 176 | (transport/put! s' [::chunk-end (last vals)])))) 177 | 178 | :else 179 | (transport/put! s' [::unchunked v]))) 180 | s'))) 181 | 182 | (defn rechunk 183 | "given a stream of 184 | [::unchunked|::chunk-start|::chunk|::chunk-end val] 185 | return a stream of unchunked values and chunks" 186 | [s] 187 | (let [s' (transport/stream) 188 | chunk-builder-a (atom (stream-chunk-builder))] 189 | (transport/connect-via 190 | s 191 | (fn [[k v]] 192 | (condp = k 193 | 194 | ::chunk-start 195 | (do 196 | (pt/-start-chunk @chunk-builder-a v) 197 | true) 198 | 199 | ::chunk 200 | (do 201 | (pt/-add-to-chunk @chunk-builder-a v) 202 | true) 203 | 204 | ::chunk-end 205 | (let [chunk (pt/-finish-chunk @chunk-builder-a v)] 206 | (transport/put! s' chunk)) 207 | 208 | 209 | ::unchunked 210 | (transport/put! s' v))) 211 | s'))) 212 | -------------------------------------------------------------------------------- /src/promisespromises/test.clj: -------------------------------------------------------------------------------- 1 | (ns promisespromises.test 2 | (:require 3 | [clojure.test] 4 | [promesa.core] 5 | [taoensso.timbre] 6 | [promisespromises.test.reduce] 7 | [promisespromises.util.macro] 8 | [promisespromises.promise] 9 | [promisespromises.promise :as prpr])) 10 | 11 | ;; lord help me 12 | 13 | (defonce test-binding-frame (atom nil)) 14 | 15 | (defmacro record-test-binding-frame 16 | [& body] 17 | ;; pass the actual original binding frame around, not a clone, 18 | ;; so that any changes on other threads make their way back to the 19 | ;; original thread 20 | `(let [orig-frame# (clojure.lang.Var/getThreadBindingFrame)] 21 | (try 22 | (reset! test-binding-frame orig-frame#) 23 | ~@body 24 | (finally 25 | (reset! test-binding-frame nil))))) 26 | 27 | (defmacro with-test-binding-frame 28 | [& body] 29 | `(let [curr-frame# (clojure.lang.Var/getThreadBindingFrame)] 30 | (when (nil? @test-binding-frame) 31 | (throw 32 | (ex-info 33 | "test-async missing ? (nil test-binding-frame)" 34 | {}))) 35 | (try 36 | (clojure.lang.Var/resetThreadBindingFrame @test-binding-frame) 37 | ~@body 38 | (finally 39 | (clojure.lang.Var/resetThreadBindingFrame curr-frame#))))) 40 | 41 | ;; a bunch of test macros for comparable async testing 42 | ;; in clj or cljs... some just reference the underlying clojure.test 43 | ;; macros, but are here to make ns :require forms simpler... 44 | 45 | (defmacro use-fixtures 46 | [& body] 47 | `(promisespromises.util.macro/if-cljs 48 | (cljs.test/use-fixtures ~@body) 49 | (clojure.test/use-fixtures ~@body))) 50 | 51 | (defmacro test-async 52 | "the body of test-async is a form or forms that 53 | when evaluated return: 54 | 55 | | Promise | fn | Sequence 56 | 57 | test-async *serially* evaluates the forms, and any which yield 58 | fn or Sequence will be immediately called, also serially" 59 | [nm & forms] 60 | (let [;; wrap each form into a 0-args fn 61 | fs (for [form forms] 62 | `(fn [] ~form))] 63 | 64 | `(promisespromises.util.macro/if-cljs 65 | 66 | (cljs.test/async 67 | done# 68 | 69 | (promesa.core/handle 70 | (do 71 | (println " " ~(str nm)) 72 | (promesa.core/let [r# (promisespromises.test.reduce/reduce-pr-fns 73 | ~(str nm) 74 | [~@fs])])) 75 | (fn [succ# e#] 76 | (when (some? e#) 77 | (cljs.test/report {:type :error 78 | :message (str e#) 79 | :error e#})) 80 | ;; (println " " ~(str nm) ":done") 81 | (done#)))) 82 | 83 | (let [body# (fn [] 84 | (with-test-binding-frame 85 | (promisespromises.test.reduce/reduce-pr-fns 86 | ~(str nm) 87 | [~@fs])))] 88 | (record-test-binding-frame 89 | (println " " ~(str nm)) 90 | @(body#) 91 | ;; (println " " ~(str nm) ":done") 92 | ))))) 93 | 94 | (defmacro deftest* 95 | [nm & body] 96 | `(promisespromises.util.macro/if-cljs 97 | (cljs.test/deftest ~nm ~@body) 98 | (clojure.test/deftest ~nm ~@body))) 99 | 100 | (defmacro deftest 101 | "define a test whose body will be evaluated with test-async. it 102 | looks very like a normal sync deftest, **but it is not**. there are 103 | some caveats, viz: 104 | 105 | NOTE: when using a let to provide common values to a series of 106 | testing forms, use a tlet instead - it will wrap the forms 107 | as a vector of 0-args fns, so none get forgotten (let only 108 | returns its final value) and they all get evaluated serially 109 | 110 | NOTE: use the same name as clojure.test/deftest because CIDER 111 | recognizes it and uses it to find tests" 112 | [nm & body] 113 | `(promisespromises.test/deftest* ~nm 114 | (promisespromises.test/test-async ~(str nm) ~@body))) 115 | 116 | (defmacro tlet 117 | "a let which turns its body forms into a vector of 0-args fns, 118 | to be used inside deftests so that all the testing forms inside 119 | the let are retained and evaluated serially" 120 | [bindings & forms] 121 | (let [;; wrap each form into a 0-args fn 122 | fs (for [form forms] 123 | `(fn [] ~form))] 124 | `(let ~bindings 125 | [ ~@fs ]))) 126 | 127 | (defmacro is 128 | [& body] 129 | `(promisespromises.util.macro/if-cljs 130 | (cljs.test/is ~@body) 131 | (with-test-binding-frame 132 | (clojure.test/is ~@body)))) 133 | 134 | (defmacro testing 135 | "each testing form body is evaluated in the same manner as a deftest 136 | body" 137 | [s & forms] 138 | (when (not-empty forms) 139 | (let [;; wrap each form into a 0-args fn 140 | fs (for [form forms] 141 | `(fn [] ~form))] 142 | `(fn [] 143 | (promisespromises.util.macro/if-cljs 144 | (do 145 | (println " " ~s) 146 | ;; underlying testing macro loses the result, which messes up 147 | ;; our ()->Promise closure reducing method, so explicitly 148 | ;; capture the result in an atom 149 | (let [r# (atom nil)] 150 | (cljs.test/testing 151 | (reset! r# (promisespromises.test.reduce/reduce-pr-fns ~s [~@fs]))) 152 | @r#)) 153 | 154 | (with-test-binding-frame 155 | (do 156 | (println " " ~s) 157 | ;; underlying testing macro loses the result, which messes up 158 | ;; our ()->Promise closure reducing method, so explicitly 159 | ;; capture the result in an atom 160 | (let [r# (atom nil)] 161 | (clojure.test/testing 162 | (reset! r# (promisespromises.test.reduce/reduce-pr-fns ~s [~@fs]))) 163 | @r#)))))))) 164 | 165 | (defmacro with-log-level 166 | "temporarily set the log-level while executing the forms" 167 | [log-level & forms] 168 | (let [;; wrap each form into a 0-args fn 169 | fs (for [form forms] 170 | `(fn [] ~form))] 171 | 172 | `(let [cl# (or (:level taoensso.timbre/*config*) 173 | :info)] 174 | 175 | (taoensso.timbre/set-level! ~log-level) 176 | 177 | (promesa.core/finally 178 | 179 | ;; put a fn which can't fail at the head, so that 180 | ;; we only need the promise-based finally 181 | (promisespromises.test.reduce/reduce-pr-fns ~(str log-level) (into [(constantly true)] 182 | [~@fs])) 183 | 184 | (fn [_# _#] 185 | (taoensso.timbre/set-level! cl#)))))) 186 | 187 | (defn with-log-level-fixture 188 | [level] 189 | (fn [f] 190 | (let [cl (or (:level taoensso.timbre/*config*) :info)] 191 | ;; (println "with-log-level-fixture" cl "->" level) 192 | (taoensso.timbre/set-level! level) 193 | 194 | (promesa.core/finally 195 | (f) 196 | 197 | ;; (println "with-log-level-fixture:done" level "->" cl) 198 | (taoensso.timbre/set-level! cl))))) 199 | 200 | (def compose-fixtures 201 | clojure.test/compose-fixtures) 202 | -------------------------------------------------------------------------------- /src/promisespromises/stream/promesa_csp.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.promesa-csp 2 | (:require 3 | [promesa.exec.csp :as sp] 4 | #?(:cljs [promesa.exec.csp.channel :refer [Channel]]) 5 | [promisespromises.stream.protocols :as pt] 6 | [promisespromises.stream.types :as types] 7 | [promesa.core :as pr] 8 | [promisespromises.promise :as prpr]) 9 | (:import 10 | #?(:clj [promesa.exec.csp.channel Channel]))) 11 | 12 | (defn promesa-csp-stream 13 | ([] (sp/chan)) 14 | ([buffer] (sp/chan buffer)) 15 | ([buffer xform] (sp/chan buffer xform)) 16 | #?(:clj ([buffer xform _executor] (sp/chan buffer xform)))) 17 | 18 | (deftype StreamFactory [] 19 | pt/IStreamFactory 20 | (-stream [_] (promesa-csp-stream)) 21 | (-stream [_ buffer] (promesa-csp-stream buffer)) 22 | (-stream [_ buffer xform] (promesa-csp-stream buffer xform)) 23 | #?(:clj 24 | (-stream [_ buffer xform executor] 25 | (promesa-csp-stream buffer xform executor)))) 26 | 27 | (def stream-factory (->StreamFactory)) 28 | 29 | (extend-protocol pt/IMaybeStream 30 | Channel 31 | (-stream? [_] true)) 32 | 33 | (defn promesa-csp-put! 34 | ([sink val] 35 | (sp/put sink val)) 36 | 37 | ([sink val timeout timeout-val] 38 | ;; (prn "promesa-csp-put!" sink val timeout timeout-val) 39 | (let [timeout-ch (sp/timeout-chan timeout)] 40 | 41 | (pr/let [[v ch] (sp/alts 42 | [[sink val] 43 | timeout-ch] 44 | :priority true)] 45 | (if (= ch timeout-ch) 46 | timeout-val 47 | v))))) 48 | 49 | (defn promesa-csp-error! 50 | "this is also implemented in impl.. but circular deps..." 51 | [sink err] 52 | (pr/chain 53 | (pt/-put! sink (types/stream-error err)) 54 | (fn [_] 55 | (pt/-close! sink)) 56 | (fn [_] 57 | ;; return false so that -error! can be used like a put! 58 | ;; in connect fns 59 | false))) 60 | 61 | (defn promesa-csp-take! 62 | ([source] 63 | (sp/take source)) 64 | 65 | ([source default-val] 66 | (pr/let [v (sp/take source)] 67 | (if (some? v) v default-val))) 68 | 69 | ([source default-val timeout timeout-val] 70 | (let [timeout-ch (sp/timeout-chan timeout)] 71 | 72 | (pr/let [[v ch] (sp/alts 73 | [source 74 | timeout-ch] 75 | :priority true)] 76 | (cond 77 | (= ch timeout-ch) timeout-val 78 | (nil? v) default-val 79 | :else v))))) 80 | 81 | (defn promesa-csp-close! 82 | [ch] 83 | (sp/close! ch)) 84 | 85 | (defn promesa-csp-connect-via 86 | "feed all messages from src into callback on the 87 | understanding that they will eventually propagate into 88 | dst 89 | 90 | the return value of callback should be a promise yielding 91 | either true or false. when false the downstream sink 92 | is assumed to be closed and the connection is severed" 93 | ([src callback dst] 94 | (promesa-csp-connect-via src callback dst nil)) 95 | ([src 96 | callback 97 | dst 98 | {close-src? :promisespromises.stream/upstream? 99 | close-sink? :promisespromises.stream/downstream? 100 | :as _opts}] 101 | 102 | #_{:clj-kondo/ignore [:loop-without-recur]} 103 | (pr/loop [] 104 | ;; (prn "promesa-csp-connect-via: pre-take!") 105 | 106 | (-> (pt/-take! src ::closed) 107 | 108 | (prpr/handle-always 109 | (fn [v err] 110 | ;; (prn "promesa-csp-connect-via: value" v err) 111 | 112 | (cond 113 | (some? err) 114 | (promesa-csp-error! dst err) 115 | 116 | (= ::closed v) 117 | ;; src has closed 118 | (do 119 | (when close-sink? 120 | (pt/-close! dst)) 121 | ::closed) 122 | 123 | :else 124 | ;; callback is reponsible for putting 125 | ;; messages on to dst 126 | (callback v)))) 127 | 128 | 129 | (prpr/handle-always 130 | (fn [result err] 131 | ;; (prn "promesa-csp-connect-via: result" result err) 132 | 133 | (cond 134 | (some? err) 135 | (do 136 | (pt/-close! src) 137 | (promesa-csp-error! dst err)) 138 | 139 | (true? result) 140 | #_{:clj-kondo/ignore [:redundant-do]} 141 | (do 142 | ;; (prn "promesa-csp-connect-via: recur") 143 | #_{:clj-kondo/ignore [:recur-argument-count]} 144 | (pr/recur)) 145 | 146 | :else 147 | (do 148 | ;; manifold default to not always closing the src 149 | ;; when the connection terminates... but manifold has 150 | ;; a behaviour where the src will always close when its 151 | ;; last sink is removed, which means that sources don't 152 | ;; leak after their sinks are removed 153 | ;; 154 | ;; core.async does not have this behavious, so we 155 | ;; default to closing the source by default when a 156 | ;; connection is broken 157 | 158 | (when-not (false? close-src?) 159 | (promesa-csp-close! src)) 160 | 161 | (if (= ::closed result) 162 | true 163 | false))))))))) 164 | 165 | (defn promesa-csp-wrap-value 166 | "nils can't be put directly on core.async chans, 167 | so to present a very similar API on both clj+cljs we 168 | wrap nils for core.async 169 | 170 | promises can be put on a core.async chan, but cause 171 | problems with promesa-csp-take! because auto-unwrapping 172 | causes Promise from the stream to be 173 | indistinguishable from a closed channel - so wrapping 174 | promises sidesteps this" 175 | [v] 176 | (cond 177 | (nil? v) (types/stream-nil) 178 | (pr/promise? v) (types/stream-promise v) 179 | :else v)) 180 | 181 | (defn promesa-csp-buffer 182 | ([ch n] 183 | (sp/pipe 184 | ch 185 | (sp/chan n)))) 186 | 187 | (def default-connect-via-opts 188 | {;; standard manifold default 189 | :promisespromises.stream/downstream? true 190 | ;; *not* the standard manifold default - but we 191 | ;; can easily implement this behaviour for core.async too 192 | ;; so going with it for cross-platform consistency 193 | :promisespromises.stream/upstream? true}) 194 | 195 | (extend-protocol pt/IStream 196 | Channel 197 | (-closed? [s] 198 | (sp/closed? s)) 199 | 200 | (-put! 201 | ([sink val] (promesa-csp-put! sink val)) 202 | ([sink val timeout timeout-val] (promesa-csp-put! sink val timeout timeout-val))) 203 | 204 | (-take! 205 | ([source] (promesa-csp-take! source)) 206 | ([source default-val] (promesa-csp-take! source default-val)) 207 | ([source default-val timeout timeout-val] 208 | (promesa-csp-take! source default-val timeout timeout-val))) 209 | 210 | (-close! [this] (promesa-csp-close! this)) 211 | 212 | (-connect-via 213 | ([source f sink] (promesa-csp-connect-via source f sink default-connect-via-opts)) 214 | ([source f sink opts] (promesa-csp-connect-via 215 | source 216 | f 217 | sink 218 | (merge default-connect-via-opts opts)))) 219 | 220 | (-wrap-value [_s v] (promesa-csp-wrap-value v)) 221 | (-buffer [s n] (promesa-csp-buffer s n))) 222 | -------------------------------------------------------------------------------- /src/promisespromises/stream/manifold.clj: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.manifold 2 | (:require 3 | [manifold.deferred :as m.deferred] 4 | [manifold.stream :as m.stream] 5 | [promisespromises.stream.protocols :as p] 6 | [promesa.core :as promise] 7 | [promesa.protocols :as promise.p]) 8 | (:import 9 | [manifold.stream.default Stream] 10 | [manifold.stream SinkProxy SourceProxy SplicedStream BufferedStream] 11 | [manifold.deferred Deferred SuccessDeferred ErrorDeferred LeakAwareDeferred] 12 | [java.util.concurrent ExecutionException CompletionException])) 13 | 14 | (defn manifold-stream 15 | ([] (m.stream/stream)) 16 | ([buffer] (m.stream/stream buffer)) 17 | ([buffer xform] (m.stream/stream buffer xform)) 18 | ([buffer xform executor] (m.stream/stream buffer xform executor))) 19 | 20 | (deftype StreamFactory [] 21 | p/IStreamFactory 22 | (-stream [_] (manifold-stream)) 23 | (-stream [_ buffer] (manifold-stream buffer)) 24 | (-stream [_ buffer xform] (manifold-stream buffer xform)) 25 | (-stream [_ buffer xform executor] (manifold-stream buffer xform executor))) 26 | 27 | (def stream-factory (->StreamFactory)) 28 | 29 | (extend-protocol p/IMaybeStream 30 | Stream 31 | (-stream? [_v] true) 32 | 33 | SinkProxy 34 | (-stream? [_v] true) 35 | 36 | SourceProxy 37 | (-stream? [_v] true) 38 | 39 | SplicedStream 40 | (-stream? [_v] true) 41 | 42 | BufferedStream 43 | (-stream? [_v] true)) 44 | 45 | (defn promise->deferred 46 | [v] 47 | (if (promise/promise? v) 48 | (m.deferred/->deferred v) 49 | v)) 50 | 51 | (def default-connect-via-opts 52 | {;; standard manifold default 53 | :promisespromises.stream/downstream? true 54 | ;; *not* the standard manifold default - but we 55 | ;; can easily implement this behaviour for core.async too 56 | ;; so going with it for cross-platform consistency 57 | :promisespromises.stream/upstream? true}) 58 | 59 | (defn manifold-connect-via-opts 60 | [{downstream? :promisespromises.stream/downstream? 61 | upstream? :promisespromises.stream/upstream? 62 | timeout :promisespromises.stream/timeout 63 | description :promisespromises.stream/description}] 64 | (cond-> {} 65 | (some? downstream?) (assoc :downstream? downstream?) 66 | (some? upstream?) (assoc :upstream? upstream?) 67 | (some? timeout) (assoc :timeout timeout) 68 | (some? description) (assoc :description description))) 69 | 70 | (extend-protocol p/IStream 71 | Stream 72 | (-closed? [s] 73 | (m.stream/closed? s)) 74 | 75 | (-put! 76 | ([sink val] 77 | (m.stream/put! sink val)) 78 | ([sink val timeout timeout-val] 79 | (m.stream/try-put! sink val timeout timeout-val))) 80 | 81 | (-take! 82 | ([source] 83 | (m.stream/take! source)) 84 | ([source default-val] 85 | (m.stream/take! source default-val)) 86 | ([source default-val timeout timeout-val] 87 | (m.stream/try-take! source default-val timeout timeout-val))) 88 | 89 | (-close! [this] (m.stream/close! this)) 90 | 91 | (-connect-via 92 | ([source f sink] 93 | (let [f' (comp promise->deferred f)] 94 | (m.stream/connect-via 95 | source 96 | f' 97 | sink 98 | (manifold-connect-via-opts default-connect-via-opts)))) 99 | ([source f sink opts] 100 | (let [f' (comp promise->deferred f)] 101 | (m.stream/connect-via 102 | source 103 | f' 104 | sink 105 | (manifold-connect-via-opts 106 | (merge default-connect-via-opts opts)))))) 107 | 108 | ;; don't need to wrap anything for manifold 109 | (-wrap-value [_ v] v) 110 | 111 | (-buffer [s n] 112 | (m.stream/buffer s n))) 113 | 114 | (extend-protocol p/IPlatformErrorWrapper 115 | ExecutionException 116 | (-unwrap-platform-error [this] (ex-cause this)) 117 | CompletionException 118 | (-unwrap-platform-error [this] (ex-cause this))) 119 | 120 | (defn ->promesa 121 | [d] 122 | (let [p (promise/deferred)] 123 | (m.deferred/on-realized 124 | d 125 | (fn [v] (promise/resolve! p v)) 126 | (fn [err] (promise/reject! p err))) 127 | p)) 128 | 129 | (extend-protocol promise.p/IPromiseFactory 130 | Deferred 131 | (-promise [d] 132 | (->promesa d)) 133 | 134 | SuccessDeferred 135 | (-promise [d] 136 | (->promesa d)) 137 | 138 | ErrorDeferred 139 | (-promise [d] 140 | (->promesa d)) 141 | 142 | LeakAwareDeferred 143 | (-promise [d] 144 | (->promesa d))) 145 | 146 | (extend-protocol promise.p/IPromise 147 | Deferred 148 | (-bind 149 | ([d f] 150 | (-> d (->promesa) (promise.p/-bind f))) 151 | ([d f executor] 152 | (-> d (->promesa) (promise.p/-bind f executor)))) 153 | 154 | (-map 155 | ([d f] 156 | (-> d (->promesa) (promise.p/-map f))) 157 | ([d f executor] 158 | (-> d (->promesa) (promise.p/-map f executor)))) 159 | 160 | (-catch 161 | ([d f] 162 | (-> d (->promesa) (promise.p/-catch f))) 163 | ([d f executor] 164 | (-> d (->promesa) (promise.p/-catch f executor)))) 165 | 166 | (-handle 167 | ([d f] 168 | (-> d (->promesa) (promise.p/-handle f))) 169 | ([d f executor] 170 | (-> d (->promesa) (promise.p/-handle f executor)))) 171 | 172 | (-finally 173 | ([d f] 174 | (-> d (->promesa) (promise.p/-finally f))) 175 | ([d f executor] 176 | (-> d (->promesa) (promise.p/-finally f executor)))) 177 | 178 | SuccessDeferred 179 | (-bind 180 | ([d f] 181 | (-> d (->promesa) (promise.p/-bind f))) 182 | ([d f executor] 183 | (-> d (->promesa) (promise.p/-bind f executor)))) 184 | 185 | (-map 186 | ([d f] 187 | (-> d (->promesa) (promise.p/-map f))) 188 | ([d f executor] 189 | (-> d (->promesa) (promise.p/-map f executor)))) 190 | 191 | (-catch 192 | ([d f] 193 | (-> d (->promesa) (promise.p/-catch f))) 194 | ([d f executor] 195 | (-> d (->promesa) (promise.p/-catch f executor)))) 196 | 197 | (-handle 198 | ([d f] 199 | (-> d (->promesa) (promise.p/-handle f))) 200 | ([d f executor] 201 | (-> d (->promesa) (promise.p/-handle f executor)))) 202 | 203 | (-finally 204 | ([d f] 205 | (-> d (->promesa) (promise.p/-finally f))) 206 | ([d f executor] 207 | (-> d (->promesa) (promise.p/-finally f executor)))) 208 | 209 | ErrorDeferred 210 | (-bind 211 | ([d f] 212 | (-> d (->promesa) (promise.p/-bind f))) 213 | ([d f executor] 214 | (-> d (->promesa) (promise.p/-bind f executor)))) 215 | 216 | (-map 217 | ([d f] 218 | (-> d (->promesa) (promise.p/-map f))) 219 | ([d f executor] 220 | (-> d (->promesa) (promise.p/-map f executor)))) 221 | 222 | (-catch 223 | ([d f] 224 | (-> d (->promesa) (promise.p/-catch f))) 225 | ([d f executor] 226 | (-> d (->promesa) (promise.p/-catch f executor)))) 227 | 228 | (-handle 229 | ([d f] 230 | (-> d (->promesa) (promise.p/-handle f))) 231 | ([d f executor] 232 | (-> d (->promesa) (promise.p/-handle f executor)))) 233 | 234 | (-finally 235 | ([d f] 236 | (-> d (->promesa) (promise.p/-finally f))) 237 | ([d f executor] 238 | (-> d (->promesa) (promise.p/-finally f executor)))) 239 | 240 | LeakAwareDeferred 241 | (-bind 242 | ([d f] 243 | (-> d (->promesa) (promise.p/-bind f))) 244 | ([d f executor] 245 | (-> d (->promesa) (promise.p/-bind f executor)))) 246 | 247 | (-map 248 | ([d f] 249 | (-> d (->promesa) (promise.p/-map f))) 250 | ([d f executor] 251 | (-> d (->promesa) (promise.p/-map f executor)))) 252 | 253 | (-catch 254 | ([d f] 255 | (-> d (->promesa) (promise.p/-catch f))) 256 | ([d f executor] 257 | (-> d (->promesa) (promise.p/-catch f executor)))) 258 | 259 | (-handle 260 | ([d f] 261 | (-> d (->promesa) (promise.p/-handle f))) 262 | ([d f executor] 263 | (-> d (->promesa) (promise.p/-handle f executor)))) 264 | 265 | (-finally 266 | ([d f] 267 | (-> d (->promesa) (promise.p/-finally f))) 268 | ([d f executor] 269 | (-> d (->promesa) (promise.p/-finally f executor))))) 270 | -------------------------------------------------------------------------------- /src/promisespromises/stream/core_async.cljs: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.core-async 2 | (:require 3 | [clojure.core.async :as async] 4 | [cljs.core.async.impl.channels :refer [ManyToManyChannel]] 5 | [cljs.core.async.impl.protocols :as impl.proto] 6 | [promisespromises.stream.protocols :as pt] 7 | [promisespromises.stream.types :as types] 8 | [promesa.core :as pr] 9 | [promisespromises.promise :as prpr] 10 | [promisespromises.error :as err])) 11 | 12 | (defn async-stream 13 | ([] (async/chan)) 14 | ([buffer] (async/chan buffer)) 15 | ([buffer xform] (async/chan buffer xform))) 16 | 17 | (deftype StreamFactory [] 18 | pt/IStreamFactory 19 | (-stream [_] (async-stream)) 20 | (-stream [_ buffer] (async-stream buffer)) 21 | (-stream [_ buffer xform] (async-stream buffer xform))) 22 | 23 | (def stream-factory (->StreamFactory)) 24 | 25 | (extend-protocol pt/IMaybeStream 26 | ManyToManyChannel 27 | (-stream? [_] true)) 28 | 29 | (defn async-put! 30 | ([sink val] 31 | ;; (prn "async-put!" val) 32 | (let [r (pr/deferred)] 33 | ;; (prn "async-put!" val) 34 | (async/put! sink val #(pr/resolve! r %)) 35 | r)) 36 | 37 | ([sink val timeout timeout-val] 38 | ;; (prn "async-put!" sink val timeout timeout-val) 39 | (let [timeout-ch (async/timeout timeout) 40 | 41 | alt-ch (async/go 42 | (async/alt! 43 | [[sink val]] true 44 | timeout-ch timeout-val 45 | :priority true)) 46 | 47 | r (pr/deferred)] 48 | 49 | (async/take! alt-ch #(pr/resolve! r %)) 50 | 51 | r))) 52 | 53 | (defn async-error! 54 | "this is also implemented in impl.. but circular deps..." 55 | [sink err] 56 | (pr/chain 57 | (pt/-put! sink (types/stream-error err)) 58 | (fn [_] 59 | (pt/-close! sink)) 60 | (fn [_] 61 | ;; return false so that -error! can be used like a put! 62 | ;; in connect fns 63 | false))) 64 | 65 | (defn async-take! 66 | ([source] 67 | (let [r (pr/deferred)] 68 | (async/take! source #(pr/resolve! r %)) 69 | r)) 70 | ([source default-val] 71 | (let [r (pr/deferred) 72 | dr (pr/chain r (fn [v] (if (some? v) v default-val)))] 73 | (async/take! source #(pr/resolve! r %)) 74 | dr)) 75 | 76 | ([source default-val timeout timeout-val] 77 | (let [timeout-ch (async/timeout timeout) 78 | 79 | alt-ch (async/go 80 | (async/alt! 81 | source ([v] v) 82 | timeout-ch ::timeout 83 | :priority true)) 84 | 85 | r (pr/deferred) 86 | 87 | dr (pr/chain r (fn [v] 88 | (cond 89 | (= ::timeout v) timeout-val 90 | 91 | (some? v) v 92 | 93 | :else 94 | default-val)))] 95 | 96 | (async/take! alt-ch #(pr/resolve! r %)) 97 | 98 | dr))) 99 | 100 | (defn async-close! 101 | [ch] 102 | (async/close! ch)) 103 | 104 | (defn async-connect-via 105 | "feed all messages from src into callback on the 106 | understanding that they will eventually propagate into 107 | dst 108 | 109 | the return value of callback should be a promise yielding 110 | either true or false. when false the downstream sink 111 | is assumed to be closed and the connection is severed" 112 | ([src callback dst] 113 | (async-connect-via src callback dst nil)) 114 | ([src 115 | callback 116 | dst 117 | {close-src? :promisespromises.stream/upstream? 118 | close-sink? :promisespromises.stream/downstream? 119 | :as _opts}] 120 | 121 | #_{:clj-kondo/ignore [:loop-without-recur]} 122 | (pr/loop [] 123 | ;; (prn "async-connect-via: pre-take!") 124 | 125 | (-> (pt/-take! src ::closed) 126 | 127 | (prpr/handle-always 128 | (fn [v err] 129 | ;; (prn "async-connect-via: value" v err) 130 | 131 | (cond 132 | (some? err) 133 | (async-error! dst err) 134 | 135 | (= ::closed v) 136 | ;; src has closed 137 | (do 138 | (when close-sink? 139 | (pt/-close! dst)) 140 | ::closed) 141 | 142 | :else 143 | ;; callback is reponsible for putting 144 | ;; messages on to dst 145 | (callback v)))) 146 | 147 | 148 | (prpr/handle-always 149 | (fn [result err] 150 | ;; (prn "async-connect-via: result" result err) 151 | 152 | (cond 153 | (some? err) 154 | (do 155 | (pt/-close! src) 156 | (async-error! dst err)) 157 | 158 | (true? result) 159 | #_{:clj-kondo/ignore [:redundant-do]} 160 | (do 161 | ;; (prn "async-connect-via: recur") 162 | #_{:clj-kondo/ignore [:recur-argument-count]} 163 | (pr/recur)) 164 | 165 | :else 166 | (do 167 | ;; manifold default to not always closing the src 168 | ;; when the connection terminates... but manifold has 169 | ;; a behaviour where the src will always close when its 170 | ;; last sink is removed, which means that sources don't 171 | ;; leak after their sinks are removed 172 | ;; 173 | ;; core.async does not have this behavious, so we 174 | ;; default to closing the source by default when a 175 | ;; connection is broken 176 | 177 | (when-not (false? close-src?) 178 | (async-close! src)) 179 | 180 | (if (= ::closed result) 181 | true 182 | false))))))))) 183 | 184 | (defn async-wrap-value 185 | "nils can't be put directly on core.async chans, 186 | so to present a very similar API on both clj+cljs we 187 | wrap nils for core.async 188 | 189 | promises can be put on a core.async chan, but cause 190 | problems with async-take! because auto-unwrapping 191 | causes Promise from the stream to be 192 | indistinguishable from a closed channel - so wrapping 193 | promises sidesteps this" 194 | [v] 195 | (cond 196 | (nil? v) (types/stream-nil) 197 | (pr/promise? v) (types/stream-promise v) 198 | :else v)) 199 | 200 | (defn async-buffer 201 | ([ch n] 202 | (async/pipe 203 | ch 204 | (async/chan n)))) 205 | 206 | (def default-connect-via-opts 207 | {;; standard manifold default 208 | :promisespromises.stream/downstream? true 209 | ;; *not* the standard manifold default - but we 210 | ;; can easily implement this behaviour for core.async too 211 | ;; so going with it for cross-platform consistency 212 | :promisespromises.stream/upstream? true}) 213 | 214 | (extend-protocol pt/IStream 215 | ManyToManyChannel 216 | (-closed? [s] 217 | (impl.proto/closed? s)) 218 | 219 | (-put! 220 | ([sink val] (async-put! sink val)) 221 | ([sink val timeout timeout-val] (async-put! sink val timeout timeout-val))) 222 | 223 | (-take! 224 | ([source] (async-take! source)) 225 | ([source default-val] (async-take! source default-val)) 226 | ([source default-val timeout timeout-val] 227 | (async-take! source default-val timeout timeout-val))) 228 | 229 | (-close! [this] (async-close! this)) 230 | 231 | (-connect-via 232 | ([source f sink] (async-connect-via source f sink default-connect-via-opts)) 233 | ([source f sink opts] (async-connect-via 234 | source 235 | f 236 | sink 237 | (merge default-connect-via-opts opts)))) 238 | 239 | (-wrap-value [_s v] (async-wrap-value v)) 240 | (-buffer [s n] (async-buffer s n))) 241 | -------------------------------------------------------------------------------- /src/promisespromises/stream/zip_impl.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.zip-impl 2 | "consume from multiple streams in a chunk and 3 | error sensitive way" 4 | (:require 5 | [promesa.core :as pr] 6 | [promisespromises.promise :as prpr] 7 | [promisespromises.error :as err] 8 | [promisespromises.stream.protocols :as pt] 9 | [promisespromises.stream.transport :as transport] 10 | [promisespromises.stream.types :as types] 11 | [promisespromises.stream :as-alias stream])) 12 | 13 | ;; maintains some state 14 | ;; uses a buffer list of unconsumed values allowing 15 | ;; - chunk values to be added to the end of the buffer 16 | ;; - values to be removed from the front of the buffer 17 | ;; - pushback to be prepended to the front buffer 18 | ;; - end-of-stream to be marked with :promisespromises.stream/end in the buffer 19 | ;; - errors to be marked with a stream-error in the buffer 20 | 21 | (deftype ValueConsumer [s buf-a] 22 | pt/IValueConsumer 23 | (-peek-value [_] 24 | (let [buf @buf-a] 25 | (if (not-empty buf) 26 | 27 | (first buf) 28 | 29 | (pr/let [v (pt/-take! s ::stream/end)] 30 | (cond 31 | 32 | ;; terminal conditions 33 | (or (= ::stream/end v) 34 | (types/stream-error? v)) 35 | (do 36 | (swap! buf-a conj v) 37 | v) 38 | 39 | ;; append all of chunk to buf 40 | (types/stream-chunk? v) 41 | (let [[v :as vals] (list* (pt/-chunk-values v))] 42 | (reset! buf-a vals) 43 | v) 44 | 45 | ;; append value to buf 46 | :else 47 | (do 48 | (swap! buf-a conj v) 49 | v)))))) 50 | 51 | (-take-value! [_] 52 | (let [[fv :as buf] @buf-a] 53 | (if (not-empty buf) 54 | 55 | (cond 56 | 57 | ;; terminal conditions 58 | (or (= ::stream/end fv) 59 | (types/stream-error? fv)) 60 | fv 61 | 62 | ;; take first val from buf 63 | :else 64 | (do 65 | (swap! buf-a rest) 66 | fv)) 67 | 68 | (pr/let [v (pt/-take! s ::stream/end)] 69 | (cond 70 | 71 | ;; terminal conditions 72 | (or (= ::stream/end v) 73 | (types/stream-error? v)) 74 | (do 75 | (swap! buf-a conj v) 76 | v) 77 | 78 | ;; append rest of chunk to buf, return first val 79 | (types/stream-chunk? v) 80 | (let [[v & rvs] (list* (pt/-chunk-values v))] 81 | (reset! buf-a rvs) 82 | v) 83 | 84 | ;; return plain value 85 | :else 86 | v)))))) 87 | 88 | (defn value-consumer 89 | [s] 90 | (->ValueConsumer s (atom '()))) 91 | 92 | (deftype ChunkConsumer [s buf-a] 93 | pt/IChunkConsumer 94 | (-peek-chunk [_] 95 | (let [buf @buf-a] 96 | (if (not-empty buf) 97 | (first buf) 98 | (pr/let [v (pt/-take! s ::stream/end)] 99 | (reset! buf-a '(v)) 100 | v)))) 101 | 102 | (-take-chunk! [_] 103 | (let [[fv :as buf] @buf-a] 104 | (if (not-empty buf) 105 | (cond 106 | 107 | ;; terminal conditions 108 | (or (= ::stream/end fv) 109 | (types/stream-error? fv)) 110 | fv 111 | 112 | ;; consume first val from buf 113 | :else 114 | (do 115 | (swap! buf-a rest) 116 | fv)) 117 | 118 | (pr/let [;; _ (info "about to -take!") 119 | v (pt/-take! s ::stream/end)] 120 | (cond 121 | 122 | ;; buffer and return terminal conditions 123 | (or (= ::stream/end v) 124 | (types/stream-error? v)) 125 | (do 126 | ;; (info "terminal" v) 127 | (reset! buf-a '(v)) 128 | v) 129 | 130 | ;; return chunk or plain value 131 | :else 132 | v))))) 133 | 134 | (-pushback-chunk! [_ chunk-or-val] 135 | (when (or (= ::stream/end chunk-or-val) 136 | (types/stream-error? chunk-or-val)) 137 | (throw 138 | (ex-info "can't pushback EOS or error" 139 | {:chunk-or-val chunk-or-val}))) 140 | 141 | (swap! buf-a #(cons chunk-or-val %)))) 142 | 143 | (defn chunk-consumer 144 | [s] 145 | (->ChunkConsumer s (atom '()))) 146 | 147 | (defn chunk-zip 148 | "zip values from input streams to vectors on the output stream in 149 | a chunk and error sensitive way 150 | 151 | (chunk-zip Stream Stream Stream ...) -> Stream<[a b c ...]> 152 | 153 | if the inputs are all chunked then the output will also be chunked. 154 | the size of the output chunks will be determined by the smallest 155 | chunk size of the inputs 156 | 157 | one of the more complex consumption patterns - not dissimilar to 158 | a join in that it consumes multiple streams, consumes partial chunks 159 | and pushes unconsumed values 'back' onto streams" 160 | [& srcs] 161 | 162 | (let [;; we feed the sources into intermediates so we can close 163 | ;; them without affecting any objects we don't own (the srcs), 164 | ;; which, in turn, will *maybe* cause the upstream streams 165 | ;; to close by default, but only if the intermediates were 166 | ;; their only downstream channels (manifold behaviour) 167 | intermediates (repeatedly 168 | (count srcs) 169 | transport/stream) 170 | 171 | out (transport/stream) 172 | consumers (->> intermediates 173 | (map chunk-consumer) 174 | (into [])) 175 | 176 | close-all (fn [] 177 | (->> (conj intermediates out) 178 | (map pt/-close!) 179 | (pr/all)))] 180 | 181 | (doseq [[src interm] (map vector srcs intermediates)] 182 | (pt/-connect-via 183 | src 184 | (fn [v] 185 | ;; (prn "connect-via-interm" v) 186 | (pt/-put! interm v)) 187 | interm)) 188 | 189 | ;; since this is a throwaway promise, put a final catch around it 190 | ;; so that it can't crash the VM 191 | (prpr/catch-always 192 | 193 | #_{:clj-kondo/ignore [:loop-without-recur]} 194 | (pr/loop [] 195 | 196 | (-> 197 | 198 | ;; get a vector of chunk-or-values from sources 199 | (->> consumers 200 | (map pt/-take-chunk!) 201 | (pr/all)) 202 | 203 | (prpr/handle-always 204 | ;; output the biggest possible chunk of zipped values 205 | (fn [chunk-or-vals err] 206 | ;; (info "chunk-or-vals" chunk-or-vals err) 207 | 208 | (if (some? err) 209 | 210 | (pr/chain 211 | (transport/error! out err) 212 | (fn [_] (close-all)) 213 | (fn [_] false)) 214 | 215 | (let [;; has any source ended ? 216 | end? (some #(= ::stream/end %) chunk-or-vals) 217 | 218 | ;; were there any errors ? 219 | errors? (some types/stream-error? chunk-or-vals) 220 | 221 | ;; did all the sources supply chunks ? 222 | all-chunks? (every? types/stream-chunk? chunk-or-vals) 223 | 224 | ;; the largest possible output chunk size is the 225 | ;; size of the smallest source chunk 226 | output-chunk-size (if all-chunks? 227 | (->> chunk-or-vals 228 | (filter types/stream-chunk?) 229 | (map pt/-chunk-values) 230 | (map count) 231 | (apply min)) 232 | 1)] 233 | 234 | ;; (prn "zip" {:end? end? 235 | ;; :errors? errors? 236 | ;; :all-chunks? all-chunks? 237 | ;; :output-chunk-size output-chunk-size}) 238 | 239 | (cond 240 | 241 | ;; one or more inputs has errored - error and close the output 242 | errors? 243 | (let [first-err (->> chunk-or-vals (filter types/stream-error?) first)] 244 | (pr/chain 245 | (transport/error! out first-err) 246 | (fn [_] (close-all)) 247 | (fn [_] false))) 248 | 249 | ;; one or more inputs has ended - close the output normally 250 | end? 251 | (pr/chain 252 | (close-all) 253 | (fn [_] false)) 254 | 255 | ;; all the inputs are chunks - so output a new chunk of 256 | ;; zipped values with size of the smallest input chunks, 257 | ;; and push the remainders of the chunks back on to the 258 | ;; consumers 259 | all-chunks? 260 | (let [vs-rems (for [corv chunk-or-vals] 261 | (let [vals (pt/-chunk-values corv)] 262 | [(subvec vals 0 output-chunk-size) 263 | (when (> (count vals) output-chunk-size) 264 | (types/stream-chunk 265 | (subvec vals output-chunk-size)))])) 266 | vs (map first vs-rems) 267 | rems (map second vs-rems) 268 | 269 | zipped-vs (apply map vector vs) 270 | zipped-vs-chunk (types/stream-chunk 271 | zipped-vs)] 272 | 273 | (doseq [[consumer rem] (map vector consumers rems)] 274 | (when (some? rem) 275 | (pt/-pushback-chunk! consumer rem))) 276 | 277 | (pt/-put! out zipped-vs-chunk)) 278 | 279 | ;; at least one plain val, so no chunks on 280 | ;; output - take one value from each input and 281 | ;; push any chunk remainders back onto the 282 | ;; consumers 283 | :else 284 | (let [v-rems (for [corv chunk-or-vals] 285 | (if (types/stream-chunk? corv) 286 | (let [cvs (pt/-chunk-values corv) 287 | ;; use subvec rather than 288 | ;; descructuring to get remaining 289 | ;; values, or we get a seq 290 | [fv rvs] [(first cvs) 291 | (subvec cvs 1)]] 292 | [fv (types/stream-chunk rvs)]) 293 | [corv nil])) 294 | vs (map first v-rems) 295 | rems (map second v-rems) 296 | zipped-vs (vec vs)] 297 | 298 | (doseq [[consumer rem] (map vector consumers rems)] 299 | (when (some? rem) 300 | (pt/-pushback-chunk! consumer rem))) 301 | 302 | (pt/-put! out zipped-vs))))))) 303 | 304 | (prpr/handle-always 305 | 306 | ;; recur if there is more to come 307 | (fn [result err] 308 | (if (some? err) 309 | 310 | (pr/chain 311 | (transport/error! out err) 312 | (fn [_] (close-all)) 313 | (fn [_] false)) 314 | 315 | (when result 316 | (pr/recur))))))) 317 | 318 | 319 | ;; catchall cleanup 320 | (fn [e] 321 | ;; (error e "zip error") 322 | (transport/error! out e) 323 | (close-all))) 324 | 325 | out)) 326 | -------------------------------------------------------------------------------- /test/promisespromises/stream/transport_test.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.transport-test 2 | (:require 3 | [promisespromises.test :refer [deftest testing is]] 4 | [promesa.core :as pr] 5 | [promisespromises.promise :as prpr] 6 | [promisespromises.stream.test :as st] 7 | [promisespromises.stream.protocols :as pt] 8 | [promisespromises.stream.types :as types] 9 | [promisespromises.stream.transport :as sut] 10 | 11 | #?(:clj [promisespromises.stream.manifold :as stream.manifold] 12 | :cljs [promisespromises.stream.core-async :as stream.async]) 13 | [promisespromises.stream.promesa-csp :as stream.promesa-csp])) 14 | 15 | (def stream-factories 16 | #?(:clj [stream.promesa-csp/stream-factory stream.manifold/stream-factory] 17 | :cljs [stream.promesa-csp/stream-factory stream.async/stream-factory])) 18 | 19 | (defmacro with-stream-factories 20 | [& forms] 21 | (let [ffs (for [form forms] `(fn [] ~form)) 22 | cf @promisespromises.stream.transport/stream-factory 23 | all-fs (apply 24 | concat 25 | (for [sf stream-factories] 26 | (concat 27 | [`(fn [] 28 | (println "with-stream-factory:" ~sf) 29 | (reset! promisespromises.stream.transport/stream-factory ~sf))] 30 | ffs 31 | [`(fn [] (reset! promisespromises.stream.transport/stream-factory ~cf))])))] 32 | 33 | `(promisespromises.test.reduce/reduce-pr-fns 34 | "with-stream-factories" 35 | [~@all-fs]))) 36 | 37 | (deftest stream-test 38 | (testing "returns an object which tests stream?" 39 | (let [s (sut/stream)] 40 | (is (sut/stream? s))))) 41 | 42 | (deftest close!-test 43 | (testing "close! returns nil, and after close! -put! returns false" 44 | (pr/let [s (sut/stream 1) 45 | r (sut/close! s) 46 | pr (pt/-put! s ::foo)] 47 | (is (nil? r)) 48 | (is (not pr))))) 49 | 50 | (deftest put!-test 51 | (testing "put! returns true and is take!able" 52 | (let [s (sut/stream) 53 | prp (pt/-put! s ::foo)] 54 | (pr/let [r (pt/-take! s) 55 | pr prp] 56 | (is (= ::foo r)) 57 | (is (identical? true pr))))) 58 | (testing "returns false when the stream is closed" 59 | (pr/let [s (sut/stream) 60 | _ (sut/close! s) 61 | r (pt/-put! s ::foo)] 62 | (is (identical? false r)))) 63 | (testing "implements a timeout with timeout-val" 64 | (pr/let [s (sut/stream 1) 65 | r (sut/put! s ::foo 1 ::timeout) 66 | tr (sut/take! s)] 67 | (is (identical? true r)) 68 | (is (= ::foo tr))) 69 | (pr/let [s (sut/stream) 70 | r (sut/put! s ::foo 1 ::timeout)] 71 | (is (= ::timeout r))) 72 | (pr/let [s (sut/stream) 73 | r (sut/put! s ::foo 1 nil)] 74 | (is (nil? r)))) 75 | #?(:cljs 76 | (testing "wraps nils on core.async" 77 | (let [s (sut/stream) 78 | _ (sut/put-all-and-close! s [::foo nil])] 79 | (pr/let [r1 (sut/take! s ::closed) 80 | r2 (sut/take! s ::closed) 81 | r3 (sut/take! s ::closed)] 82 | (is (= r1 ::foo)) 83 | (is (= r2 nil)) 84 | (is (= r3 ::closed))))))) 85 | 86 | (deftest error!-test 87 | (testing "put!s a StreamError and close!s the stream" 88 | (pr/let [s (sut/stream 1) 89 | er (sut/error! s ::foo) 90 | r (pt/-take! s) 91 | cv (pt/-take! s ::closed)] 92 | (is (identical? false er)) 93 | (is (types/stream-error? r)) 94 | (is (= ::foo (pt/-unwrap-error r))) 95 | (is (= ::closed cv))))) 96 | 97 | (deftest put-all!-test 98 | (testing "puts all the values in a collection and returns true" 99 | (let [s (sut/stream) 100 | par (sut/put-all! s [::foo ::bar ::baz])] 101 | (pr/let [r1 (sut/take! s) 102 | r2 (sut/take! s)] 103 | (is (= ::foo r1)) 104 | (is (= ::bar r2)) 105 | ;; (is (identical? false (pr/resolved? par))) 106 | (pr/let [r3 (sut/take! s) 107 | _ (is (= ::baz r3)) 108 | par par] 109 | (is (identical? true par))))))) 110 | 111 | (deftest take!-test 112 | (testing "retuns values from a stream" 113 | (pr/let [s (sut/stream 1) 114 | _ (sut/put! s ::foo) 115 | r (sut/take! s)] 116 | (is (= ::foo r)))) 117 | (testing "returns nil when a stream is closed" 118 | (pr/let [s (sut/stream 1) 119 | _ (sut/close! s) 120 | _ (sut/put! s ::foo) 121 | r (sut/take! s)] 122 | (is (nil? r)))) 123 | (testing "returns the default-val when a stream is closed" 124 | (pr/let [s (sut/stream 1) 125 | _ (sut/close! s) 126 | _ (sut/put! s ::foo) 127 | r (sut/take! s ::closed)] 128 | (is (= ::closed r)))) 129 | (testing "implements a timeout with timeout-val" 130 | (pr/let [s (sut/stream) 131 | r (sut/take! s ::closed 1 ::timeout)] 132 | (is (= ::timeout r)))) 133 | (testing "returns nil value on timeout with no timeout-val" 134 | (pr/let [s (sut/stream) 135 | [k r] (prpr/merge-always 136 | (sut/take! s ::closed 1 nil))] 137 | 138 | (is (= ::prpr/ok k)) 139 | (is (= nil r))))) 140 | 141 | (defn chain-and-close! 142 | "chain execution of the 0-args fns in fs, then close! s 143 | 144 | using this fn because promesa-csp doesn't appear to immediately 145 | queue puts - so puts followed by close! need to be sequenced" 146 | [s fs] 147 | (pr/loop [rs-fs [[] fs]] 148 | (let [[rs [ff & rfs]] rs-fs] 149 | ;; (prn "chain-and-close!" rs (count fs)) 150 | (if (nil? ff) 151 | (do 152 | (sut/close! s) 153 | rs) 154 | (pr/chain 155 | (ff) 156 | (fn [ffr] 157 | ;; (prn "chain-and-close!:CALLED" (conj rs ffr) (count rfs)) 158 | (pr/recur [(conj rs ffr) rfs]))))))) 159 | 160 | (deftest safe-connect-via-fn-test 161 | (testing "applies f, puts the result on the sink, returs true" 162 | (let [t (sut/stream 2) 163 | f (sut/safe-connect-via-fn 164 | #(sut/put! t (inc %)) 165 | t) 166 | 167 | rs-p (chain-and-close! 168 | t 169 | [(fn [] (f 0)) 170 | (fn [] (f 1))]) 171 | 172 | t1-p (sut/take! t ::closed) 173 | t2-p (sut/take! t ::closed) 174 | t3-p (sut/take! t ::closed)] 175 | 176 | (pr/let [rs rs-p 177 | 178 | t1 t1-p 179 | t2 t2-p 180 | t3 t3-p] 181 | (is (= [true true] rs)) 182 | (is (= 1 t1)) 183 | (is (= 2 t2)) 184 | (is (= ::closed t3))))) 185 | (testing "unwraps wrapped values before sending to f" 186 | (let [t (sut/stream) 187 | f (sut/safe-connect-via-fn 188 | #(sut/put! t (inc %)) 189 | t) 190 | frs-p (chain-and-close! 191 | t 192 | [(fn [] 193 | (f (reify pt/IStreamValue 194 | (-unwrap-value [_] 0))))]) 195 | 196 | t0-p (sut/take! t ::closed) 197 | t1-p (sut/take! t ::closed)] 198 | (pr/let [[fr0] frs-p 199 | 200 | t0 t0-p 201 | t1 t1-p] 202 | (is (identical? true fr0)) 203 | (is (= 1 t0 )) 204 | (is (= ::closed t1))))) 205 | (testing "wraps wrappable results of f" 206 | ;; this doesn't test anything on clj/manifold, but it 207 | ;; does on cljs/core.async 208 | (let [t (sut/stream) 209 | f (sut/safe-connect-via-fn 210 | (fn [_] (sut/put! t nil)) 211 | t) 212 | frs-p (chain-and-close! 213 | t 214 | [(fn [] (f 0))]) 215 | t0-p (sut/take! t ::closed) 216 | t1-p (sut/take! t ::closed)] 217 | (pr/let [[fr0] frs-p 218 | t0 t0-p 219 | t1 t1-p] 220 | (is (identical? true fr0)) 221 | (is (= nil t0 )) 222 | (is (= ::closed t1))))) 223 | (testing "catches errors in f, error!s the sink, returns false" 224 | (let [t (sut/stream) 225 | f (sut/safe-connect-via-fn 226 | (fn [_] (throw (ex-info "boo" {}))) 227 | t) 228 | frs-p (chain-and-close! 229 | t 230 | [(fn [] (f 0))]) 231 | kv-p (-> (sut/take! t ::closed) 232 | (pr/chain (fn [v] [::ok v])) 233 | (pr/catch (fn [err] [::error err]))) 234 | t1-p (sut/take! t ::closed)] 235 | 236 | (pr/let [[fr0] frs-p 237 | [k0 v0] kv-p 238 | t1 t1-p] 239 | (is (identical? false fr0)) 240 | (is (= ::error k0)) 241 | (is (= "boo" (ex-message v0))) 242 | (is (= ::closed t1))))) 243 | ) 244 | 245 | (defn capture-error 246 | [p] 247 | (pr/handle 248 | p 249 | (fn [succ err] 250 | (if (some? err) 251 | [::error err] 252 | [::ok succ])))) 253 | 254 | (deftest connect-via-test 255 | 256 | (testing "connects source to sink via f" 257 | (let [s (sut/stream 5) 258 | t (sut/stream 5) 259 | psrp (pr/chain 260 | (sut/put-all! s [1 2 3]) 261 | (fn [r] 262 | (sut/close! s) 263 | r)) 264 | _cvrp (sut/connect-via 265 | s 266 | #(sut/put! t (inc %)) 267 | t)] 268 | (pr/let [t0 (sut/take! t) 269 | t1 (sut/take! t) 270 | t2 (sut/take! t) 271 | t3 (sut/take! t ::closed) 272 | psr psrp 273 | ] 274 | 275 | (is (= 2 t0)) 276 | (is (= 3 t1)) 277 | (is (= 4 t2)) 278 | (is (= ::closed t3)) 279 | (is (true? psr))))) 280 | 281 | (testing "severs the connection when f returns false" 282 | (let [s (sut/stream) 283 | t (sut/stream) 284 | 285 | ;; put two values after the closing value, 286 | ;; if just one then we get a race condition with 287 | ;; close!ing stream s causing pst to be sometimes 288 | ;; true 289 | psrp (pr/chain 290 | (sut/put-all! s [1 3 6 7 9]) 291 | (fn [r] 292 | (sut/close! s) 293 | r)) 294 | 295 | _cvrp (sut/connect-via 296 | s 297 | (fn [v] 298 | (if (odd? v) 299 | (sut/put! t (inc v)) 300 | false)) 301 | t)] 302 | 303 | (pr/let [t0 (sut/take! t) 304 | t1 (sut/take! t) 305 | 306 | ;; downstream is not closed after the connection 307 | ;; is severed 308 | _ (sut/close! t) 309 | 310 | [k2 v2] (capture-error (sut/take! t ::closed)) 311 | psr psrp 312 | 313 | ;; manifold connect-via doesn't return sometimes. 314 | ;; i can't see it being a big issue, but it would 315 | ;; freeze this test if the following line was 316 | ;; uncommented 317 | ;; cvr cvrp 318 | ] 319 | 320 | (is (= 2 t0)) 321 | (is (= 4 t1)) 322 | 323 | (is (= ::ok k2)) 324 | (is (= ::closed v2)) 325 | 326 | (is (false? psr))))) 327 | 328 | (testing "error!s the sink when f throws" 329 | (let [s (sut/stream) 330 | t (sut/stream) 331 | 332 | ;; put two values after the error-causing value, 333 | ;; if just one then we get a race condition with 334 | ;; close!ing stream s causing pst to be sometimes 335 | ;; true 336 | psrp (pr/chain 337 | (sut/put-all! s [1 3 6 7 9]) 338 | (fn [r] 339 | (sut/close! s) 340 | r)) 341 | 342 | _cvrp (sut/connect-via 343 | s 344 | (fn [v] 345 | (if (odd? v) 346 | (sut/put! t (inc v)) 347 | (throw (ex-info "even!" {:v v})))) 348 | t)] 349 | 350 | (pr/let [t0 (sut/take! t) 351 | t1 (sut/take! t) 352 | [k2 e2] (capture-error (sut/take! t)) 353 | t3 (sut/take! t ::closed) 354 | psr psrp] 355 | 356 | 357 | (is (= 2 t0)) 358 | (is (= 4 t1)) 359 | 360 | (is (= ::error k2)) 361 | (is (= {:v 6} (-> e2 sut/unwrap-platform-error ex-data))) 362 | 363 | (is (= ::closed t3)) 364 | (is (false? psr))))) 365 | 366 | (testing "error!s the sink when f returns an errored promise" 367 | (let [s (sut/stream) 368 | t (sut/stream) 369 | 370 | ;; put two values after the error-causing value, 371 | ;; if just one then we get a race condition with 372 | ;; close!ing stream s causing pst to be sometimes 373 | ;; true 374 | psrp (pr/chain 375 | (sut/put-all! s [1 3 6 7 9]) 376 | (fn [r] 377 | (sut/close! s) 378 | r)) 379 | 380 | _cvrp (sut/connect-via 381 | s 382 | (fn [v] 383 | (if (odd? v) 384 | (sut/put! t (inc v)) 385 | (pr/rejected (ex-info "even!" {:v v})))) 386 | t)] 387 | 388 | (pr/let [t0 (sut/take! t) 389 | t1 (sut/take! t) 390 | [k2 e2] (capture-error (sut/take! t)) 391 | t3 (sut/take! t ::closed) 392 | psr psrp] 393 | 394 | 395 | (is (= 2 t0)) 396 | (is (= 4 t1)) 397 | 398 | (is (= ::error k2)) 399 | (is (= {:v 6} (-> e2 sut/unwrap-platform-error ex-data))) 400 | 401 | (is (= ::closed t3)) 402 | (is (false? psr))))) 403 | 404 | (testing "unwraps IStreamValues to feed to f" 405 | (let [s (sut/stream) 406 | t (sut/stream) 407 | psrp (pr/chain 408 | (sut/put-all! 409 | s 410 | [(reify 411 | pt/IStreamValue 412 | (-unwrap-value [_] 1))]) 413 | (fn [r] 414 | (sut/close! s) 415 | r)) 416 | _cvrp (sut/connect-via 417 | s 418 | #(sut/put! t (inc %)) 419 | t)] 420 | (pr/let [t0 (sut/take! t) 421 | t1 (sut/take! t ::closed) 422 | psr psrp] 423 | (is (= 2 t0)) 424 | (is (= ::closed t1)) 425 | (is (true? psr))))) 426 | 427 | (testing "does not silently unwrap promises on stream" 428 | (let [s (st/stream-of [0 (pr/resolved 1) 2]) 429 | t (sut/stream) 430 | _ (sut/connect-via s #(sut/put! t %) t)] 431 | 432 | (pr/let [[[k0 r0] 433 | [k1 r1] 434 | [k2 r2] 435 | [k3 r3]] (st/safe-low-consume t) 436 | 437 | r1' (pt/-unwrap-value r1)] 438 | (is (= ::st/ok k0 k1 k2 k3)) 439 | 440 | (is (= 0 r0)) 441 | 442 | ;; r1 should remain a promise 443 | (is (or 444 | (types/stream-promise? r1) 445 | (pr/promise? r1))) 446 | (is (= 1 r1')) 447 | 448 | (is (= 2 r2)) 449 | (is (= ::st/closed r3)))))) 450 | -------------------------------------------------------------------------------- /test/promisespromises/stream/cross_impl_test.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.cross-impl-test 2 | (:require 3 | [promisespromises.test :refer [deftest testing is with-log-level]] 4 | [clojure.math.combinatorics :as combo] 5 | [linked.core :as linked] 6 | #?(:cljs [linked.map :refer [LinkedMap]]) 7 | [taoensso.timbre :as log :refer [info warn error]] 8 | 9 | [promesa.core :as pr] 10 | [promisespromises.promise :as prpr] 11 | 12 | [promisespromises.stream.test :as stream.test] 13 | [promisespromises.stream.operations :as stream.ops] 14 | [promisespromises.stream.transport :as stream.transport] 15 | [promisespromises.stream.types :as stream.types] 16 | [promisespromises.stream.chunk :as stream.chunk] 17 | [promisespromises.stream.protocols :as stream.pt] 18 | [promisespromises.stream :as stream] 19 | 20 | [promisespromises.stream.cross-impl :as sut] 21 | 22 | [promisespromises.stream.cross :as-alias stream.cross] 23 | [promisespromises.stream.cross.op :as-alias stream.cross.op] 24 | 25 | ) 26 | #?(:clj (:import 27 | [linked.map LinkedMap]))) 28 | 29 | (deftest stream-finished?-test 30 | (testing "not finished when partition-buffer is empty" 31 | (is (not (sut/stream-finished? [])))) 32 | (testing "not finished when partition-buffer has some content" 33 | (is (not (sut/stream-finished? [["blah" '({:id "blah"})]])))) 34 | (testing "finished when partition-buffer is drained" 35 | (is (sut/stream-finished? [[::sut/drained]])) 36 | (is (sut/stream-finished? [["blah" '({:id "blah"})] 37 | [::sut/drained]]))) 38 | (testing "finished when partition-buffer is errored" 39 | (is (sut/stream-finished? [[::sut/errored]])) 40 | (is (sut/stream-finished? [["blah" '({:id "blah"})] 41 | [::sut/errored]])))) 42 | 43 | (deftest buffer-chunk!-test 44 | 45 | (testing "initialises, appends and terminates a partition buffer" 46 | (let [cfg (sut/configure-cross-op 47 | {::stream.cross/op ::stream.cross.op/sorted-merge 48 | ::stream.cross/keys [[:a identity]] 49 | ;; given the data, puts 2 partitions in each chunk 50 | ::stream.cross/target-chunk-size 6}) 51 | 52 | a (->> (stream.test/stream-of [0 0 0 1 1 1 2 2 2]) 53 | (sut/partition-stream cfg :a))] 54 | 55 | (pr/let [pb1 (sut/buffer-chunk! [] cfg :a a) 56 | pb2 (sut/buffer-chunk! pb1 cfg :a a) 57 | pb3 (sut/buffer-chunk! pb2 cfg :a a)] 58 | 59 | (is (= [[0 '(0 0 0)] [1 '(1 1 1)]] pb1)) 60 | 61 | (is (= [[0 '(0 0 0)] [1 '(1 1 1)] [2 '(2 2 2)]] pb2)) 62 | 63 | (is (= [[0 '(0 0 0)] [1 '(1 1 1)] [2 '(2 2 2)] 64 | [::sut/drained]] pb3))))) 65 | 66 | (testing "deals with stream error" 67 | 68 | (let [cfg (sut/configure-cross-op 69 | {::stream.cross/op ::stream.cross.op/sorted-merge 70 | ::stream.cross/keys [[:a identity]] 71 | ::stream.cross/target-chunk-size 6}) 72 | 73 | a (->> (stream.test/stream-of [1 1 1]) 74 | (stream/map (fn [v] (if (odd? v) 75 | (throw (ex-info "boo" {:v v})) 76 | v))) 77 | (sut/partition-stream cfg :a))] 78 | 79 | (pr/let [[[k1 v1]] (sut/buffer-chunk! [] cfg :a a) 80 | exd (ex-data v1)] 81 | 82 | (is (= ::sut/errored k1)) 83 | (is (= {:v 1} exd)))) 84 | 85 | (let [cfg (sut/configure-cross-op 86 | {::stream.cross/op ::stream.cross.op/sorted-merge 87 | ::stream.cross/keys [[:a identity]] 88 | ::stream.cross/target-chunk-size 6}) 89 | 90 | a (->> (stream.test/stream-of [0 0 0 2 2 2 4 4 4 5 5 5]) 91 | (stream/map (fn [v] (if (odd? v) 92 | (throw (ex-info "boo" {:v v})) 93 | v))) 94 | (sut/partition-stream cfg :a))] 95 | 96 | (pr/let [pb1 (sut/buffer-chunk! [] cfg :a a) 97 | [_ _ [k v]:as pb2] (sut/buffer-chunk! pb1 cfg :a a) 98 | [fk fv] (->> pb2 99 | (filter 100 | (fn [[k _v]] (sut/stream-finished-markers k))) 101 | first) 102 | exd (ex-data fv)] 103 | 104 | (is (= ::sut/errored fk)) 105 | (is (= {:v 5} (ex-data fv)))))) 106 | 107 | (testing "deals with empty stream" 108 | (let [cfg (sut/configure-cross-op 109 | {::stream.cross/op ::stream.cross.op/sorted-merge 110 | ::stream.cross/keys [[:a identity]] 111 | ::stream.cross/target-chunk-size 6}) 112 | a (->> (stream.test/stream-of []) 113 | (sut/partition-stream cfg :a))] 114 | 115 | (pr/let [pb1 (sut/buffer-chunk! [] cfg :a a)] 116 | (is (= [[::sut/drained]] pb1))))) 117 | 118 | (testing "throws an error if stream not sorted" 119 | (testing "throws if chunk is not sorted" 120 | (let [cfg (sut/configure-cross-op 121 | {::stream.cross/op ::stream.cross.op/sorted-merge 122 | ::stream.cross/keys [[:a identity]] 123 | ::stream.cross/target-chunk-size 6}) 124 | a (->> (stream.test/stream-of [1 1 1 0 0 0]) 125 | (sut/partition-stream cfg :a))] 126 | 127 | (-> (prpr/merge-always (sut/buffer-chunk! [] cfg :a a)) 128 | (pr/chain 129 | (fn [[k v]] (is (= ::prpr/error k))))))) 130 | 131 | (testing "throws if between chunks is not sorted" 132 | (let [cfg (sut/configure-cross-op 133 | {::stream.cross/op ::stream.cross.op/sorted-merge 134 | ::stream.cross/keys [[:a identity]] 135 | ::stream.cross/target-chunk-size 6}) 136 | a (->> (stream.test/stream-of [0 0 0]) 137 | (sut/partition-stream cfg :a))] 138 | 139 | (-> (prpr/merge-always (sut/buffer-chunk! [[1 '(1 1 1)]] cfg :a a)) 140 | (pr/chain 141 | (fn [[k v]] 142 | (is (= ::prpr/error k)) 143 | (let [{error-type :error/type 144 | 145 | chunk-starts-after-previous-end? 146 | ::stream.cross/chunk-starts-after-previous-end? 147 | :as exd} (ex-data v)] 148 | (is (= ::sut/stream-not-sorted error-type)) 149 | (is (false? chunk-starts-after-previous-end?))))))))) 150 | 151 | (testing "throws an error if key extraction returns nil" 152 | (let [cfg (sut/configure-cross-op 153 | {::stream.cross/op ::stream.cross.op/sorted-merge 154 | ::stream.cross/keys [[:a identity]] 155 | ::stream.cross/target-chunk-size 6}) 156 | a (->> (stream.test/stream-of [0 0 0]) 157 | (sut/partition-stream cfg :a))] 158 | 159 | (-> (prpr/merge-always (sut/buffer-chunk! [[1 '(1 1 1)]] cfg :a a)) 160 | (pr/chain 161 | (fn [[k v]] 162 | (is (= ::prpr/error k)) 163 | (let [{error-type :error/type 164 | 165 | chunk-starts-after-previous-end? 166 | ::stream.cross/chunk-starts-after-previous-end? 167 | :as exd} (ex-data v)] 168 | (is (= ::sut/stream-not-sorted error-type)) 169 | (is (false? chunk-starts-after-previous-end?)))))))) 170 | ) 171 | 172 | (deftest init-partition-buffers!-test 173 | (testing "initially fills partition-buffers and correctly orders the map" 174 | (let [cfg (sut/configure-cross-op 175 | {::stream.cross/op ::stream.cross.op/sorted-merge 176 | ::stream.cross/keys [[:a identity] [:b identity]] 177 | ::stream.cross/target-chunk-size 6}) 178 | id-streams (->> (linked/map 179 | :b (stream.test/stream-of [1 1 1]) 180 | :a (stream.test/stream-of [0 0 0])) 181 | (sut/partition-streams cfg))] 182 | 183 | (pr/let [pbs (sut/init-partition-buffers! cfg id-streams)] 184 | (is (= [:a :b] (keys pbs))) 185 | (is (= {:a [[0 [0 0 0]]] 186 | :b [[1 [1 1 1]]]} 187 | pbs)))))) 188 | 189 | (deftest partition-buffer-needs-filling?-test 190 | (testing "true if there is a single partition remaining and the stream is not finished" 191 | (is (true? (sut/partition-buffer-needs-filling? :foo [[0 '(0)]])))) 192 | (testing "false if there is a single partition remaining and the stream is finished" 193 | (is (false? (sut/partition-buffer-needs-filling? :foo [[::sut/drained]]))) 194 | (is (false? (sut/partition-buffer-needs-filling? :foo [[::sut/errored]])))) 195 | (testing "false if there is more than 1 partition remaining" 196 | (is (false? (sut/partition-buffer-needs-filling? :foo [[0 '(0)] [1 '(1)]])))) 197 | (testing "errors if there is fewer than 1 partition remaining" 198 | (pr/let [[k v] (prpr/merge-always (sut/partition-buffer-needs-filling? :foo [])) 199 | {error-type :error/type 200 | stream-id ::sut/stream-id} (ex-data v)] 201 | (is (= ::prpr/error k)) 202 | (is (= ::sut/partition-buffer-emptied error-type)) 203 | (is (= :foo stream-id))))) 204 | 205 | (deftest fill-partition-buffers!-test 206 | (testing "fills partition-buffers which need filling" 207 | (let [cfg (sut/configure-cross-op 208 | {::stream.cross/op ::stream.cross.op/sorted-merge 209 | ::stream.cross/keys [[:a identity] [:b identity] [:c identity]] 210 | ::stream.cross/target-chunk-size 6}) 211 | id-streams (->> (linked/map 212 | :d (stream.test/stream-of []) 213 | :c (stream.test/stream-of []) 214 | :b (stream.test/stream-of [12 12 12]) 215 | :a (stream.test/stream-of [1 1 1])) 216 | (sut/partition-streams cfg))] 217 | 218 | (pr/let [pbs (sut/fill-partition-buffers! 219 | (linked/map 220 | :a [[0 '(0)]] 221 | :b [[10 '(10)] [11 '(11)]] 222 | :c [[20 '(20)] [::sut/drained]] 223 | :d [[20 '(30)] [::sut/errored]]) 224 | cfg 225 | id-streams)] 226 | 227 | (is (= {:a [[0 '(0)] [1 '(1 1 1)]] 228 | :b [[10 '(10)] [11 '(11)]] 229 | :c [[20 '(20)] [::sut/drained]] 230 | :d [[20 '(30)] [::sut/errored]]} 231 | pbs)))))) 232 | 233 | (deftest min-key-val-test 234 | (is (= 0 (sut/min-key-val compare [1 3 7 0 9]))) 235 | (is (= 9 (sut/min-key-val (comp - compare) [1 3 7 9 5])))) 236 | 237 | (deftest partition-buffer-content-drained?-test 238 | (is (true? (sut/partition-buffer-content-drained? [[::sut/drained]]))) 239 | (is (false? (sut/partition-buffer-content-drained? [[0 '(0)][::sut/drained]])))) 240 | 241 | (deftest partition-buffer-content-errored?-test 242 | (is (true? (sut/partition-buffer-content-drained? [[::sut/errored]]))) 243 | (is (false? (sut/partition-buffer-content-drained? [[0 '(0)][::sut/errored]])))) 244 | 245 | (deftest next-selections-test 246 | 247 | (testing "selects just the first min-key partition for sorted-merge" 248 | (let [cfg (sut/configure-cross-op 249 | {::stream.cross/op ::stream.cross.op/sorted-merge 250 | ::stream.cross/keys [[:a identity] [:b identity] [:c identity]] 251 | ::stream.cross/target-chunk-size 6})] 252 | (is (= [[[:a '(0 0 0)]] 253 | 254 | {:a [[1 '(1 1 1)]] 255 | :b [[1 '(1 1 1)] [2 '(2 2 2)]] 256 | :c [[0 '(0 0)] [3 '(3 3)]]}] 257 | (sut/next-selections 258 | cfg 259 | (linked/map 260 | :a [[0 '(0 0 0)] [1 '(1 1 1)]] 261 | :b [[1 '(1 1 1)] [2 '(2 2 2)]] 262 | :c [[0 '(0 0)] [3 '(3 3)]])))))) 263 | 264 | (testing "selects all min-key partitions for inner-join" 265 | (let [cfg (sut/configure-cross-op 266 | {::stream.cross/op ::stream.cross.op/inner-join 267 | ::stream.cross/keys [[:a identity] [:b identity] [:c identity]] 268 | ::stream.cross/target-chunk-size 6})] 269 | (is (= [[[:a '(0 0 0)] [:c '(0 0)]] 270 | 271 | {:a [[1 '(1 1 1)]] 272 | :b [[1 '(1 1 1)] [2 '(2 2 2)]] 273 | :c [[3 '(3 3)]]}] 274 | (sut/next-selections 275 | cfg 276 | (linked/map 277 | :a [[0 '(0 0 0)] [1 '(1 1 1)]] 278 | :b [[1 '(1 1 1)] [2 '(2 2 2)]] 279 | :c [[0 '(0 0)] [3 '(3 3)]]))))))) 280 | 281 | (deftest generate-output-test 282 | (testing "cartesian products the selected partitions" 283 | (let [cfg (sut/configure-cross-op 284 | {::stream.cross/op ::stream.cross.op/inner-join 285 | ::stream.cross/keys [[:a :id] [:b :org_id]] 286 | ::stream.cross/target-chunk-size 6}) 287 | 288 | selected-id-partitions (linked/map 289 | :a [{:id 0 :a "a0_0"} {:id 0 :a "a0_1"}] 290 | :b [{:org_id 0 :b "b0_0"} {:org_id 0 :b "b0_1"}])] 291 | 292 | (is (= [{:a {:id 0, :a "a0_0"}, :b {:org_id 0, :b "b0_0"}} 293 | {:a {:id 0, :a "a0_0"}, :b {:org_id 0, :b "b0_1"}} 294 | {:a {:id 0, :a "a0_1"}, :b {:org_id 0, :b "b0_0"}} 295 | {:a {:id 0, :a "a0_1"}, :b {:org_id 0, :b "b0_1"}}] 296 | (sut/generate-output 297 | cfg 298 | selected-id-partitions))))) 299 | 300 | (testing "optionally finalizes and sorts the output" 301 | (let [cfg (sut/configure-cross-op 302 | {::stream.cross/op ::stream.cross.op/inner-join 303 | ::stream.cross/keys [[:a :id] [:b :org_id]] 304 | ::stream.cross/target-chunk-size 6 305 | ::stream.cross/finalizer (fn [m] (->> m (vals) (apply merge))) 306 | ::stream.cross/product-sort (fn [ms] 307 | (sort-by 308 | (fn [{n :n m :m}] (+ n m)) 309 | ms))}) 310 | 311 | selected-id-partitions (linked/map 312 | :a [{:id 0 :a "a0_0" :n 20} {:id 0 :a "a0_1" :n 10}] 313 | :b [{:org_id 0 :b "b0_0" :m 0} {:org_id 0 :b "b0_1" :m 100}])] 314 | 315 | (is (= [{:id 0, :a "a0_1", :n 10, :org_id 0, :b "b0_0", :m 0} 316 | {:id 0, :a "a0_0", :n 20, :org_id 0, :b "b0_0", :m 0} 317 | {:id 0, :a "a0_1", :n 10, :org_id 0, :b "b0_1", :m 100} 318 | {:id 0, :a "a0_0", :n 20, :org_id 0, :b "b0_1", :m 100}] 319 | (sut/generate-output 320 | cfg 321 | selected-id-partitions)))))) 322 | 323 | (deftest chunk-full?-test 324 | (let [cb (stream.chunk/stream-chunk-builder) 325 | _ (stream.pt/-start-chunk cb) 326 | _ (stream.pt/-add-all-to-chunk cb (vec (repeat 10 :foo)))] 327 | 328 | (let [cfg (sut/configure-cross-op 329 | {::stream.cross/op ::stream.cross.op/inner-join 330 | ::stream.cross/keys [[:a :id] [:b :org_id]] 331 | ::stream.cross/target-chunk-size 9})] 332 | (is (true? (sut/chunk-full? cb cfg)))) 333 | 334 | (let [cfg (sut/configure-cross-op 335 | {::stream.cross/op ::stream.cross.op/inner-join 336 | ::stream.cross/keys [[:a :id] [:b :org_id]] 337 | ::stream.cross/target-chunk-size 10})] 338 | (is (true? (sut/chunk-full? cb cfg)))) 339 | 340 | (let [cfg (sut/configure-cross-op 341 | {::stream.cross/op ::stream.cross.op/inner-join 342 | ::stream.cross/keys [[:a :id] [:b :org_id]] 343 | ::stream.cross/target-chunk-size 11})] 344 | (is (false? (sut/chunk-full? cb cfg)))))) 345 | 346 | (deftest chunk-not-empty?-test 347 | (let [cb (stream.chunk/stream-chunk-builder) 348 | _ (stream.pt/-start-chunk cb) 349 | _ (stream.pt/-add-all-to-chunk cb (vec (repeat 10 :foo)))] 350 | (is (true? (sut/chunk-not-empty? cb)))) 351 | 352 | (let [cb (stream.chunk/stream-chunk-builder) 353 | _ (stream.pt/-start-chunk cb)] 354 | (is (false? (sut/chunk-not-empty? cb)))) 355 | 356 | (let [cb (stream.chunk/stream-chunk-builder)] 357 | (is (false? (sut/chunk-not-empty? cb))))) 358 | 359 | (deftest cross-finished?-test 360 | ) 361 | 362 | (deftest cross-input-errored?-test) 363 | 364 | (deftest first-cross-input-error-test) 365 | 366 | (deftest cross*-test) 367 | 368 | (deftest select-first-test) 369 | 370 | (deftest select-all-test) 371 | 372 | (deftest set-select-all-test) 373 | 374 | (deftest ->select-fn-test) 375 | 376 | (deftest ->merge-fn-test) 377 | 378 | (deftest ->product-sort-fn-test) 379 | 380 | (deftest ->finaliser-fn-test) 381 | 382 | (deftest ->key-comparator-fn-test) 383 | 384 | (deftest ->key-extractor-fn-test) 385 | 386 | (deftest ->key-extractor-fns) 387 | 388 | (defn linked-map? 389 | [v] 390 | (instance? LinkedMap v)) 391 | 392 | (deftest partition-streams-test 393 | (testing "partitions and chunks streams and correctly orders the id-streams map" 394 | (let [s (stream.test/stream-of [0 1 2 3]) 395 | t (stream.test/stream-of [100 101 102 103 104]) 396 | {r-s :s 397 | r-t :t 398 | :as psts} (sut/partition-streams 399 | (sut/configure-cross-op 400 | {::stream.cross/target-chunk-size 2 401 | ::stream.cross/keys [[:s identity] [:t identity]] 402 | ::stream.cross/op ::stream.cross.op/sorted-merge}) 403 | ;; input map is ordered wrongly 404 | (linked/map :t t :s s))] 405 | 406 | ;; check output map is ordered correctly 407 | (is (linked-map? psts)) 408 | (is (= [:s :t] (keys psts))) 409 | 410 | (pr/let [s-vs (stream.test/consume r-s) 411 | t-vs (stream.test/consume r-t)] 412 | 413 | (is (= [(stream.types/stream-chunk [[0] [1]]) 414 | (stream.types/stream-chunk [[2] [3]])] 415 | s-vs)) 416 | (is (= [(stream.types/stream-chunk [[100] [101]]) 417 | (stream.types/stream-chunk [[102] [103]]) 418 | (stream.types/stream-chunk [[104]])] 419 | t-vs)))))) 420 | 421 | (deftest configure-cross-op-test 422 | (let [cfg {::stream.cross/target-chunk-size 2 423 | ::stream.cross/keys [[:s identity] [:t :other_id]] 424 | ::stream.cross/op ::stream.cross.op/sorted-merge} 425 | 426 | opcfg (sut/configure-cross-op cfg)] 427 | 428 | (is (= (merge 429 | cfg 430 | {::stream.cross/key-extractor-fns {:s identity :t :other_id} 431 | ::stream.cross/key-comparator-fn compare 432 | ::stream.cross/select-fn sut/select-first 433 | ::stream.cross/merge-fn sut/merge-sorted-merge 434 | ::stream.cross/product-sort-fn identity 435 | ::stream.cross/finalizer-fn identity}) 436 | opcfg)))) 437 | 438 | (deftest cross-test 439 | (testing "inner-join" 440 | (let [a (stream.test/stream-of 441 | [{:id 0 :a "a00"} {:id 0 :a "a01"} {:id 2 :a "a20"}]) 442 | b (stream.test/stream-of 443 | [{:id 0 :b "b00"} {:id 1 :b "b10"} {:id 3 :b "b30"}]) 444 | 445 | o-s (sut/cross 446 | {::stream.cross/keys [[:a :id] [:b :id]] 447 | ::stream.cross/op ::stream.cross.op/inner-join} 448 | {:a a :b b})] 449 | 450 | (pr/let [ovs (stream.ops/reduce 451 | ::cross-test-inner-join 452 | conj 453 | [] 454 | o-s)] 455 | 456 | (is (= [{:a {:id 0, :a "a00"}, :b {:id 0, :b "b00"}} 457 | {:a {:id 0, :a "a01"}, :b {:id 0, :b "b00"}}] 458 | ovs))))) 459 | 460 | (testing "difference" 461 | (let [a (stream.test/stream-of [0 1 2 3 4 5 6]) 462 | b (stream.test/stream-of [1 3 5]) 463 | 464 | o-s (sut/cross 465 | {::stream.cross/keys [[:a identity] [:b identity]] 466 | ::stream.cross/op ::stream.cross.op/difference} 467 | {:a a :b b})] 468 | 469 | (pr/let [ovs (stream.ops/reduce 470 | ::cross-test-inner-join 471 | conj 472 | [] 473 | o-s)] 474 | 475 | (is (= [{:a 0} {:a 2} {:a 4} {:a 6}] 476 | ovs))))) 477 | ) 478 | -------------------------------------------------------------------------------- /src/promisespromises/stream/operations.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.operations 2 | (:refer-clojure :exclude [concat count filter map mapcat reduce reductions]) 3 | (:require 4 | [clojure.core :as clj] 5 | [promesa.core :as pr] 6 | [promisespromises.promise :as prpr] 7 | [promisespromises.stream.protocols :as pt] 8 | [promisespromises.stream.transport :as transport] 9 | [promisespromises.stream.types :as types] 10 | [promisespromises.stream.chunk :as chunk] 11 | [promisespromises.stream.zip-impl :as zip-impl])) 12 | 13 | ;; a clj+cljs cross-platform streams lib, in the style of manifold 14 | ;; 15 | ;; the idea is to use manifold streams (on clj) and core.async channels 16 | ;; (on cljs) as low-level errorless message transports with backpressure, 17 | ;; and then to add on top of that: 18 | ;; 19 | ;; 1. error capture and propagation 20 | ;; any errors in applying transform/map/filter/reduce fns to stream values 21 | ;; are wrapped in a marker and propagated downstream, 22 | ;; thereafter immediately closing the downstream. take! and reduce 23 | ;; turn any error marker into an errored promise and thus error 24 | ;; propagation happens 25 | ;; 2. (mostly) transparent chunking 26 | ;; chunks on a stream are transparently processed as if 27 | ;; the values in the chunk were values in the stream 28 | ;; 3. a consistent API across clj + cljs 29 | ;; the API is a manifold-like streams and promises API, but it uses 30 | ;; promesa for the promises, (instead of manifold's deferreds) - so 31 | ;; we get the same API across clj+cljs 32 | 33 | (defn put-all! 34 | "puts all values onto a stream - first flattens any chunks from 35 | the vals, and creates a new chunk, then puts the chunk on the 36 | stream" 37 | [sink vals] 38 | (let [flat-vals (clojure.core/reduce 39 | (fn [a v] 40 | (if (types/stream-chunk? v) 41 | (into a (pt/-chunk-values v)) 42 | (conj a v))) 43 | [] 44 | vals) 45 | chk (when (not-empty flat-vals) 46 | (types/stream-chunk flat-vals))] 47 | (if (some? chk) 48 | (transport/put! sink chk) 49 | (pr/resolved true)))) 50 | 51 | (defn put-all-and-close! 52 | [sink vals] 53 | (pr/handle 54 | (put-all! sink vals) 55 | (fn [s e] 56 | (transport/close! sink) 57 | (if (some? e) 58 | (pr/rejected e) 59 | s)))) 60 | 61 | (defn ->source 62 | "turns a collection into a stream 63 | (with the collection as a chunk on the stream), otherwise does nothing 64 | to a stream" 65 | [stream-or-coll] 66 | (if (transport/stream? stream-or-coll) 67 | stream-or-coll 68 | (let [s (transport/stream 1)] 69 | 70 | (pr/let [_ (put-all! s stream-or-coll)] 71 | (transport/close! s)) 72 | 73 | s))) 74 | 75 | (defn realize-each 76 | "convert a Stream|val> into Stream" 77 | [s] 78 | (let [s' (transport/stream)] 79 | (transport/connect-via 80 | s 81 | (fn [v] 82 | ;; (prn "realize-each" v) 83 | (cond 84 | (types/stream-error? v) 85 | (transport/error! s' v) 86 | 87 | (pr/promise? v) 88 | (pr/chain 89 | v 90 | #(transport/put! s' %)) 91 | 92 | (types/stream-chunk? v) 93 | (pr/chain 94 | (pt/-chunk-flatten v) 95 | #(transport/put! s' %)) 96 | 97 | :else 98 | (transport/put! s' v))) 99 | s') 100 | 101 | s')) 102 | 103 | (declare zip) 104 | 105 | (defn map 106 | "(map f Stream) -> Stream<(f val)>" 107 | ([f s] 108 | (let [s' (transport/stream)] 109 | 110 | (transport/connect-via 111 | s 112 | (fn [v] 113 | (cond 114 | (types/stream-error? v) 115 | (transport/error! s' v) 116 | 117 | (types/stream-chunk? v) 118 | (transport/put! 119 | s' 120 | (types/stream-chunk 121 | (mapv f (pt/-chunk-values v)))) 122 | 123 | :else 124 | (transport/put! s' (f v)))) 125 | s') 126 | s')) 127 | 128 | ([f s & rest] 129 | (->> (apply zip-impl/chunk-zip s rest) 130 | (map #(apply f %))))) 131 | 132 | (defn safe-chunk-xform 133 | "- xform : a transducer 134 | - out : the eventual output stream 135 | 136 | returns a transducer which, in normal operation, unrolls chunks and 137 | composes with xform. if any exception is thrown it immediately 138 | errors the eventual output stream with the error, and then rethrows 139 | the error (since there is no sensible value to return)" 140 | [xform out] 141 | (fn [out-rf] 142 | (let [rf (xform out-rf)] 143 | (fn 144 | ([] (try 145 | (prn "safe-chunk-xform []") 146 | (rf) 147 | (catch #?(:clj Throwable :cljs :default) e 148 | (transport/error! out e) 149 | (throw e)))) 150 | 151 | ([rs] 152 | (try 153 | (prn "safe-chunk-xform [rs]" rs) 154 | (rf rs) 155 | (catch #?(:clj Throwable :cljs :default) e 156 | (prn "safe-chunk-xform [rs] ERROR" (ex-message e)) 157 | (transport/error! out e) 158 | (throw e)))) 159 | 160 | ([rs v] 161 | (prn "->safe-chunk-xform [rs v]" rs v) 162 | (cond 163 | (types/stream-error? v) 164 | (out-rf rs v) 165 | 166 | (types/stream-chunk? v) 167 | (try 168 | (let [chunk-vals (pt/-chunk-values v) 169 | 170 | ;; chunks cannot be empty! 171 | chunk-vals-count (clj/count chunk-vals) 172 | 173 | chunk-vals-but-last (->> chunk-vals 174 | (take (dec chunk-vals-count))) 175 | chunk-vals-last (->> chunk-vals 176 | (drop (dec chunk-vals-count)) 177 | first) 178 | 179 | _ (prn "safe-chunk-xform [rs v]:but-last" chunk-vals-but-last) 180 | rs' (clojure.core/reduce rf rs chunk-vals-but-last)] 181 | 182 | (prn "safe-chunk-xform [rs' v]->" rs' chunk-vals-last) 183 | (rf rs' chunk-vals-last)) 184 | 185 | (catch #?(:clj Throwable :cljs :default) e 186 | (prn "safe-chunk-xform [rs chunk] ERROR" (ex-message e)) 187 | (transport/error! out e) 188 | (throw e))) 189 | 190 | :else 191 | (try 192 | (prn "safe-chunk-xform [rs v]->" rs v) 193 | (rf rs v) 194 | (catch #?(:clj Throwable :cljs :default) e 195 | (prn "safe-chunk-xform [rs v] ERROR" (ex-message e)) 196 | (transport/error! out e) 197 | (throw e))))))))) 198 | 199 | (defn transform 200 | "apply transform to a stream, returning a transformed stream 201 | 202 | uses the underlying manifold or core.async feature to transform 203 | a stream, but wraps the xform in a safe-chunk-xform which 204 | 205 | - unrolls chunks for the xform 206 | - if the xform throws an exception then immediately errors the returned 207 | stream with the exception 208 | 209 | NOTE connect-via error-handling doesn't work with xform errors, because 210 | the error doesn't happen in the connect-via fn, but rather in the 211 | manifold/core.async impl, and manifold's (at least) put! impl swallows the 212 | error, so connect-via sees no error. sidestepping this problem with 213 | the safe-chunk-xform and erroring the returned stream directly propagates the 214 | error, but also leads to some transformed values before the error going 215 | missing from the downstream, or arriving after the error, because of implicit 216 | buffering. an alternative might be to not use the core.async/manifold native 217 | transforms, but i've also never used exceptions for control flow, so i can't 218 | see this being a problem atm, so i'm sticking with the native transforms for 219 | now 220 | 221 | NOTE2 - maybe errors can be flowed downstream by immediately wrapping them 222 | and sending them downstream, with the 2-arity, followed by calling the 223 | transducer finalizer 1-arity to close the downstream 224 | " 225 | ([xform s] 226 | (transform xform 1 s)) 227 | ([xform buffer-size s] 228 | (let [out (transport/stream) 229 | s' (transport/stream buffer-size (safe-chunk-xform xform out))] 230 | 231 | (transport/connect-via s #(transport/put! s' %) s') 232 | 233 | (transport/connect-via 234 | s' 235 | (fn [v] 236 | (if (types/stream-error? v) 237 | (transport/error! out v) 238 | (transport/put! out v))) 239 | out) 240 | 241 | out))) 242 | 243 | 244 | 245 | (defn mapcon 246 | "like map, but limits the number of concurrent unresolved 247 | promises from application of f 248 | 249 | - f is a promise-returning async fn. the result promise 250 | of f will be resolved and the resolved result placed on 251 | the output. 252 | - n is the maximum number of simultaneous unresolved 253 | promises 254 | 255 | this works to control concurrency even when chunks are 256 | used - because using buffering to control concurrency 257 | no longer works when each buffered value can be a chunk 258 | or arbitrary size 259 | 260 | note that using this fn may have performance 261 | implications - it dechunks and rechunks" 262 | ([f n s] 263 | (let [dechunked-f (fn [[chunk-k v]] 264 | [chunk-k (f v)])] 265 | (->> s 266 | (chunk/dechunk) 267 | (map dechunked-f) 268 | (pt/-buffer (dec n)) 269 | (chunk/rechunk)))) 270 | ([f n s & rest] 271 | (let [dechunked-f (fn [[chunk-k v]] 272 | [chunk-k (f v)])] 273 | (->> s 274 | (chunk/dechunk) 275 | (apply map dechunked-f s rest) 276 | (pt/-buffer (dec n)) 277 | (chunk/rechunk))))) 278 | 279 | (defn zip 280 | "zip streams 281 | S S ... -> S<[a b ...]> 282 | 283 | the output stream will terminate with the first input stream 284 | which terminates" 285 | ([a] (map vector a)) 286 | ([a & rest] 287 | (apply zip-impl/chunk-zip a rest))) 288 | 289 | (defn mapcat 290 | ([f s] 291 | (let [s' (transport/stream)] 292 | (transport/connect-via 293 | s 294 | (fn [v] 295 | (cond 296 | (types/stream-error? v) 297 | (transport/error! s' v) 298 | 299 | (types/stream-chunk? v) 300 | (put-all! 301 | s' 302 | (types/stream-chunk 303 | (mapcat f (pt/-chunk-values v)))) 304 | 305 | :else 306 | (put-all! s' (f v)))) 307 | s') 308 | 309 | s')) 310 | 311 | ([f s & rest] 312 | (->> (apply zip-impl/chunk-zip s rest) 313 | (mapcat #(apply f %))))) 314 | 315 | (defn filter 316 | [pred s] 317 | (let [s' (transport/stream)] 318 | (transport/connect-via 319 | s 320 | (fn [v] 321 | (cond 322 | (types/stream-error? v) 323 | (transport/error! s' v) 324 | 325 | (types/stream-chunk? v) 326 | (let [fchunk (clj/filter pred (pt/-chunk-values v))] 327 | (if (not-empty fchunk) 328 | (transport/put! s' (types/stream-chunk fchunk)) 329 | true)) 330 | 331 | :else 332 | (if (pred v) 333 | (transport/put! s' v) 334 | true))) 335 | s') 336 | 337 | s')) 338 | 339 | (defn reduce-ex-info 340 | "extend cause ex-data with a reduce-id, or wrap cause in an ex-info" 341 | [id cause] 342 | (let [xd (ex-data cause) 343 | xm (ex-message cause)] 344 | 345 | (if (nil? xd) 346 | 347 | (ex-info "reduce error" {::reduce-id id} cause) 348 | 349 | (ex-info 350 | (or xm "reduce error") 351 | (assoc xd ::reduce-id id) 352 | cause)))) 353 | 354 | (defn reductions 355 | "like clojure.core/reductions, but for streams 356 | 357 | NOTE like manifold's own reductions, and unlike clojure.core/reductions, 358 | this returns an empty stream if the input stream is empty. this is because 359 | a connect-via implementation does not offer any ability to output 360 | anything if the input stream is empty 361 | 362 | NOTE if the input contains chunks, the output will contain matching chunks 363 | 364 | TODO add StreamError value handling" 365 | ([id f s] 366 | (reductions id f ::none s)) 367 | ([id f initial-val s] 368 | (let [s' (transport/stream) 369 | 370 | ;; run clojure.core/reductions on chunks 371 | ;; returning a pair of 372 | ;; [intermediate-values last-value] 373 | chunk-reductions 374 | (fn ([f chk] 375 | (let [rs (clj/reductions 376 | (@#'clj/preserving-reduced f) 377 | (pt/-chunk-values chk)) 378 | cnt (clj/count rs)] 379 | 380 | [(take (dec cnt) rs) 381 | (last rs)])) 382 | 383 | ([f init chk] 384 | (let [rs (clj/reductions 385 | (@#'clj/preserving-reduced f) 386 | init 387 | (pt/-chunk-values chk)) 388 | cnt (clj/count rs)] 389 | 390 | ;; NOTE we remove the init value from 391 | ;; the front of the intermediates... 392 | ;; it will already have been output 393 | [(take (max 0 (- cnt 2)) (rest rs)) 394 | (last rs)]))) 395 | 396 | acc (atom initial-val)] 397 | 398 | (pr/chain 399 | (if (= ::none initial-val) 400 | true 401 | (transport/put! s' initial-val)) 402 | 403 | (fn [_] 404 | (transport/connect-via 405 | s 406 | 407 | (fn [v] 408 | 409 | (-> 410 | v ;; chain to simplify error-handling (only pr exceptions) 411 | 412 | (pr/chain 413 | (fn [v] 414 | (let [[t ivs v] (if (= ::none @acc) 415 | (if (types/stream-chunk? v) 416 | (into [::chunk] (chunk-reductions f v)) 417 | [::plain nil v]) 418 | 419 | (if (types/stream-chunk? v) 420 | (into [::chunk] (chunk-reductions f @acc v)) 421 | [::plain nil (f @acc v)]))] 422 | 423 | ;; (prn "connect-via" @acc [t ivs v]) 424 | 425 | (if (reduced? v) 426 | (pr/chain 427 | (transport/put! 428 | s' 429 | (if (= ::plain t) 430 | @v 431 | (types/stream-chunk (clj/concat ivs [@v])))) 432 | (fn [_] 433 | ;; explicitly close the output stream, since 434 | ;; ending the connection doesn't do it 435 | (transport/close! s')) 436 | (fn [_] 437 | ;; end the connection 438 | false)) 439 | 440 | (do 441 | (reset! acc v) 442 | (transport/put! 443 | s' 444 | (if (= ::plain t) 445 | v 446 | (types/stream-chunk (clj/concat ivs [v]))))))))) 447 | 448 | (pr/catch 449 | (fn [e] 450 | (throw 451 | (reduce-ex-info id e)))))) 452 | 453 | s'))) 454 | 455 | s'))) 456 | 457 | (defn reduce-loop* 458 | "the inner reduce loop 459 | 460 | there were problems using a catch at the top level of the reduce - 461 | there were crashes on cljs, perhaps an uncaught promise left lying around 462 | somewhere, so instead errors are caught and returned from reduce-loop* 463 | as StreamError values" 464 | [_id f initial-val s] 465 | 466 | #_{:clj-kondo/ignore [:loop-without-recur]} 467 | (pr/loop [acc initial-val] 468 | 469 | ;; (prn "reduce-loop*" acc) 470 | 471 | (if (reduced? acc) 472 | (deref acc) 473 | 474 | (prpr/handle-always 475 | 476 | ;; do a low-level take, so StreamErrors do not get unwrapped/thrown 477 | (pt/-take! s ::none) 478 | 479 | (fn [v e] 480 | 481 | ;; (prn "take!" acc v) 482 | (cond 483 | (some? e) (types/stream-error e) 484 | 485 | (= ::none v) acc 486 | 487 | (types/stream-error? v) v 488 | 489 | (types/stream-chunk? v) 490 | (let [r (try 491 | (clj/reduce 492 | (@#'clj/preserving-reduced f) 493 | acc 494 | (pt/-chunk-values v)) 495 | (catch #?(:clj Exception :cljs :default) e 496 | (reduced (types/stream-error e))))] 497 | (if (reduced? r) 498 | (deref r) 499 | (pr/recur r))) 500 | 501 | :else 502 | (let [;; we didn't want the errors to be unwrapped, but 503 | ;; we do want other types of value to be unwrapped 504 | v (pt/-unwrap-value v) 505 | r (try 506 | (f acc v) 507 | (catch #?(:clj Exception :cljs :default) e 508 | (reduced (types/stream-error e))))] 509 | (if (reduced? r) 510 | (deref r) 511 | (pr/recur r))))))))) 512 | 513 | (defn reduce 514 | "reduce, but for streams. returns a Promise of the reduced value 515 | 516 | an id is required for the reduction - this will be used to 517 | decorate any exception data, and helps to identify 518 | where an error happened, because exception stack-traces are 519 | generally not useful. a namespaced keyword identifying the function 520 | or block where a reduce is happening makes a good id e.g. ::reduce 521 | 522 | NOTE the reducing function is not expected to be async - if it 523 | returns a promise then the promise will *not* be unwrapped, and 524 | unexpected things will probably happen 525 | 526 | TODO add StreamError value handling" 527 | ([id f s] 528 | (reduce id f ::none s)) 529 | 530 | ([id f initial-val s] 531 | 532 | (-> (if (= ::none initial-val) 533 | (transport/take! s ::none) 534 | (pr/resolved initial-val)) 535 | 536 | (pr/then 537 | (fn [initial-val] 538 | ;; (prn "reduce: initial-val" initial-val) 539 | 540 | (cond 541 | 542 | (= ::none initial-val) 543 | (f) 544 | 545 | (types/stream-error? initial-val) 546 | (throw 547 | (pt/-unwrap-error initial-val)) 548 | 549 | :else 550 | (let [;; errors in the loop binding get swallowed, so 551 | ;; reduce any initial-val chunk before binding 552 | initial-val (if (types/stream-chunk? initial-val) 553 | 554 | (clj/reduce 555 | (@#'clj/preserving-reduced f) 556 | (pt/-chunk-values initial-val)) 557 | 558 | initial-val)] 559 | initial-val)))) 560 | 561 | (pr/then #(reduce-loop* id f % s)) 562 | 563 | (pr/then 564 | (fn [v] 565 | 566 | (if (types/stream-error? v) 567 | 568 | (throw 569 | (reduce-ex-info id (pt/-unwrap-error v))) 570 | 571 | v))) 572 | 573 | (prpr/catch-always 574 | (fn [e] 575 | ;; (prn "reduce: caught" (ex-message e) (ex-data e)) 576 | (throw 577 | (reduce-ex-info id e))))))) 578 | 579 | (defn count 580 | "count the items on a stream 581 | 582 | returns: Promise" 583 | [id s] 584 | (reduce 585 | id 586 | (fn [n _v] (inc n)) 587 | 0 588 | s)) 589 | 590 | (defn chunkify 591 | "chunkify a stream - chunk a stream with a target chunk size, and optionally 592 | also partition-by, ensuring partitions never span chunk boundaries 593 | 594 | - buffer-size - output-stream buffer size 595 | - target-chunk-size - in the absence of partition-by-fn, output chunks 596 | will be this size or smaller 597 | - partition-by-fn - also partition-by the stream - ensuring that partitions 598 | never span chunk boundaries" 599 | ([target-chunk-size s] 600 | (chunkify 1 target-chunk-size nil s)) 601 | 602 | ([target-chunk-size partition-by-fn s] 603 | (chunkify 1 target-chunk-size partition-by-fn s)) 604 | 605 | ([buffer-size target-chunk-size partition-by-fn s] 606 | (let [xform (chunk/make-chunker-xform target-chunk-size partition-by-fn)] 607 | (transform xform (or buffer-size 1) s)))) 608 | -------------------------------------------------------------------------------- /src/promisespromises/stream/cross_impl.cljc: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.cross-impl 2 | (:require 3 | [clojure.math.combinatorics :as combo] 4 | [clojure.set :as set] 5 | [linked.core :as linked] 6 | [malli.experimental :as mx] 7 | [malli.util :as mu] 8 | [promesa.core :as pr] 9 | [taoensso.timbre :refer [trace debug info warn error]] 10 | 11 | [promisespromises.promise :as prpr] 12 | [promisespromises.error :as err] 13 | [promisespromises.stream.operations :as stream.ops] 14 | [promisespromises.stream.protocols :as stream.pt] 15 | [promisespromises.stream.transport :as stream.transport] 16 | [promisespromises.stream.types :as stream.types] 17 | [promisespromises.stream.chunk :as stream.chunk] 18 | 19 | [promisespromises.stream.cross :as-alias stream.cross] 20 | [promisespromises.stream.cross.op :as-alias stream.cross.op] 21 | [promisespromises.stream.cross.op.n-left-join :as-alias stream.cross.op.n-left-join])) 22 | 23 | ;;; cross mkII 24 | ;;; 25 | ;;; crossing sorted streams, with 26 | ;;; chunking. allows merge, joins and set operations 27 | ;;; on streams sorted in a key - perfect if you 28 | ;;; have a database like cassandra and need some in-memory 29 | ;;; join operations with constant-space characteristics 30 | ;;; 31 | ;;; - re-chunk based on key + target-size 32 | ;;; - consume chunks 33 | ;;; - sync cross-join matching keys in chunks 34 | ;;; - output everything possible without further take! using 35 | ;;; specified chunk target-size constraints 36 | ;;; - rinse / repeat 37 | 38 | (def stream-finished-drained-marker ::drained) 39 | (def stream-finished-errored-marker ::errored) 40 | 41 | (def stream-finished-markers 42 | "the partition buffer marker values indicating that 43 | a stream is finished" 44 | #{stream-finished-drained-marker 45 | stream-finished-errored-marker}) 46 | 47 | (defn stream-finished? 48 | "takes a partition-buffer and returns true 49 | if there are no more values to consumer from the 50 | corresponding stream" 51 | [partition-buffer] 52 | (-> partition-buffer 53 | (last) 54 | (first) 55 | (stream-finished-markers))) 56 | 57 | (defn values-sorted? 58 | "returns true if vs are sorted according to comparator-fn" 59 | [comparator-fn vs] 60 | (let [[r _] (reduce 61 | (fn [[r pv] nv] 62 | (if (nil? r) 63 | [true nv] 64 | (if (<= (comparator-fn pv nv) 0) 65 | [true nv] 66 | (reduced [false nv]))) 67 | ) 68 | [nil nil] 69 | vs)] 70 | r)) 71 | 72 | (defn buffer-chunk! 73 | "given a stream of chunks of partitions, and a 74 | partition-buffer of [key partition] tuples, retrieve another 75 | chunk of partitions and add them to the partition-buffer 76 | (or add the keyword ::drained if the end of the 77 | stream is reached, or ::errored if the stream errored) 78 | 79 | returns Promise<[ [ ]* ::drained?]" 80 | [partition-buffer 81 | {key-comparator-fn ::stream.cross/key-comparator-fn 82 | key-extractor-fns ::stream.cross/key-extractor-fns 83 | :as cross-spec} 84 | stream-id 85 | stream] 86 | 87 | (pr/handle 88 | (stream.transport/take! stream stream-finished-drained-marker) 89 | 90 | (fn [v err] 91 | ;; (prn "BUFFER-CHUNK!" v err) 92 | (cond 93 | 94 | (some? err) 95 | (if (stream-finished? partition-buffer) 96 | partition-buffer 97 | (conj partition-buffer [stream-finished-errored-marker err])) 98 | 99 | (= stream-finished-drained-marker v) 100 | (if (stream-finished? partition-buffer) 101 | partition-buffer 102 | (conj partition-buffer [stream-finished-drained-marker])) 103 | 104 | (stream.types/stream-chunk? v) 105 | (let [kxfn (get key-extractor-fns stream-id) 106 | 107 | chunk-data (stream.pt/-chunk-values v) 108 | ;; _ (prn "buffer-chunk!" chunk-data) 109 | 110 | new-key-partitions (->> chunk-data 111 | ;; chunk is already partitioned 112 | ;; (partition-by kxfn) 113 | (map (fn [p] 114 | (let [pk (some-> p first kxfn)] 115 | (when (nil? pk) 116 | (throw 117 | (err/ex-info 118 | ::nil-partition-key 119 | {::stream.cross-spec cross-spec 120 | ::stream-id stream-id 121 | ::chunk-data chunk-data}))) 122 | [pk p])))) 123 | 124 | last-current-partition-key (->> partition-buffer 125 | last 126 | first) 127 | 128 | first-new-partition-key (->> new-key-partitions 129 | first 130 | first) 131 | 132 | ;; check the partitions in the new chunk are sorted in the key 133 | chunk-data-sorted? (values-sorted? 134 | key-comparator-fn 135 | (map first new-key-partitions)) 136 | 137 | ;; check that the first partition in the new chunk is sorted 138 | ;; in the key with respect to the final partition in the previous 139 | ;; chunk 140 | chunk-starts-after-previous-end? 141 | (or (nil? last-current-partition-key) 142 | ;; thank to transform impl we can randomly get content 143 | ;; after an error on a stream 144 | (stream-finished-markers last-current-partition-key) 145 | (<= (key-comparator-fn last-current-partition-key 146 | first-new-partition-key) 147 | 0))] 148 | 149 | ;; (prn "buffer-chunk!" chunk-data new-key-partitions) 150 | 151 | ;; double-check that the stream is sorted 152 | (when (or (not chunk-data-sorted?) 153 | (not chunk-starts-after-previous-end?)) 154 | 155 | (throw (err/ex-info 156 | ::stream-not-sorted 157 | {::stream.cross/spec cross-spec 158 | ::stream.cross/id stream-id 159 | ::stream.cross/chunk-data chunk-data 160 | ::stream.cross/last-prev-partition-key last-current-partition-key 161 | ::stream.cross/first-new-partition-key first-new-partition-key 162 | ::stream.cross/chunk-data-sorted? chunk-data-sorted? 163 | ::stream.cross/chunk-starts-after-previous-end? chunk-starts-after-previous-end?}))) 164 | 165 | ;; if we've already got a finished marker, then never add anything 166 | ;; to the buffer 167 | (if (stream-finished-markers last-current-partition-key) 168 | partition-buffer 169 | (into partition-buffer new-key-partitions))) 170 | 171 | :else 172 | (throw 173 | (err/ex-info 174 | ::not-a-chunk 175 | {::stream.cross/spec cross-spec 176 | ::stream.cross/id stream-id 177 | ::stream.cross/partition-buffer partition-buffer 178 | ::stream.cross/value v})))))) 179 | 180 | (defn init-partition-buffers! 181 | "returns partition buffers for each stream with 182 | partitions from the first chunk" 183 | [cross-spec id-streams] 184 | 185 | (-> (for [[sid _] id-streams] 186 | (pr/chain 187 | (buffer-chunk! 188 | [] 189 | cross-spec 190 | sid 191 | (get id-streams sid)) 192 | (fn [pb] 193 | [sid pb]))) 194 | (pr/all) 195 | (pr/chain (fn [sid-pbs] (into (linked/map) sid-pbs))))) 196 | 197 | (defn partition-buffer-needs-filling? 198 | "don't wait until empty " 199 | [stream-id partition-buffer] 200 | (let [n (count partition-buffer)] 201 | 202 | ;; the count should never be less than 1 - even 203 | ;; when the stream is drained there should be the 204 | ;; [[stream-finished-drained-marker]] or 205 | ;; [[stream-finished-errored-marker ]] remaining 206 | (when (< n 1) 207 | (throw 208 | (err/ex-info 209 | ::partition-buffer-emptied 210 | {::stream-id stream-id}))) 211 | 212 | ;; fill when there is a single partition left and 213 | ;; the stream is not drained - we don't wait until 214 | ;; the buffer is empty so that we can validate the 215 | ;; stream ordering in buffer-chunk! 216 | (and 217 | (<= (count partition-buffer) 1) 218 | (not (stream-finished? partition-buffer))))) 219 | 220 | (defn fill-partition-buffers! 221 | "buffer another chunk from any streams which are down to a single 222 | partition and have not yet been stream-finished-drained-marker" 223 | [id-partition-buffers cross-spec id-streams] 224 | (-> (for [[sid partition-buffer] id-partition-buffers] 225 | 226 | (if (partition-buffer-needs-filling? sid partition-buffer) 227 | 228 | (pr/chain 229 | (buffer-chunk! 230 | partition-buffer 231 | cross-spec 232 | sid 233 | (get id-streams sid)) 234 | (fn [partition-buffer] 235 | [sid partition-buffer])) 236 | 237 | [sid partition-buffer])) 238 | 239 | (pr/all) 240 | (pr/chain (fn [sid-pbs] (into (linked/map) sid-pbs))))) 241 | 242 | (def default-target-chunk-size 1000) 243 | 244 | (defn min-key-val 245 | "uses the comparator to find the minimum key value from ks" 246 | [key-comparator-fn ks] 247 | ;; (info "keys" (vec ks)) 248 | (reduce (fn [mk k] 249 | (cond 250 | (nil? mk) k 251 | 252 | (<= (key-comparator-fn mk k) 0) mk 253 | 254 | :else k)) 255 | nil 256 | ks)) 257 | 258 | (defn partition-buffer-content-drained? 259 | "returns true when a partition-buffer has no more content 260 | and the associated stream is finished (drained or errored)" 261 | [partition-buffer] 262 | (and (= 1 (count partition-buffer)) 263 | (some? 264 | (stream-finished-markers 265 | (-> partition-buffer first first))))) 266 | 267 | (defn partition-buffer-errored? 268 | "returns true when a partition-buffer has no more content 269 | and the associated stream errored" 270 | [partition-buffer] 271 | (and (= 1 (count partition-buffer)) 272 | (= stream-finished-errored-marker 273 | (-> partition-buffer first first)))) 274 | 275 | (defn next-selections 276 | "select partitions for the operation 277 | return [[[ ]+] updated-id-partition-buffers]" 278 | [{select-fn ::stream.cross/select-fn 279 | key-comparator-fn ::stream.cross/key-comparator-fn 280 | :as _cross-spec} 281 | id-partition-buffers] 282 | 283 | (let [mkv (->> id-partition-buffers 284 | (filter (fn [[_stream_id pb]] (not (partition-buffer-content-drained? pb)))) 285 | (map (fn [[_stream-id key-partitions]] 286 | (->> key-partitions 287 | first ;; first partition 288 | first ;; key 289 | ))) 290 | (min-key-val key-comparator-fn)) 291 | 292 | min-key-id-partitions 293 | (->> id-partition-buffers 294 | (filter (fn [[_stream_id pb]] 295 | (not (partition-buffer-content-drained? pb)))) 296 | (filter (fn [[_stream-id [[partition-key _partition]]]] 297 | (= mkv partition-key))) 298 | (map (fn [[stream-id [[_partition-key partition]]]] 299 | [stream-id partition]))) 300 | 301 | ;; _ (prn "next-selections.min-key-id-partitions" min-key-id-partitions) 302 | 303 | selected-id-partitions (select-fn min-key-id-partitions) 304 | 305 | ;; _ (prn "next-selections.selected-id-partitions" selected-id-partitions) 306 | 307 | selected-stream-ids (->> selected-id-partitions 308 | (map first) 309 | (set)) 310 | 311 | updated-id-partition-buffers 312 | (->> (for [[sid partition-buffer] id-partition-buffers] 313 | (if (selected-stream-ids sid) 314 | [sid (subvec partition-buffer 1)] 315 | [sid partition-buffer])) 316 | (into (linked/map)))] 317 | 318 | [selected-id-partitions 319 | updated-id-partition-buffers])) 320 | 321 | (defn generate-output 322 | "given partition-selections, cartesion-product the selected partitions, 323 | merging each row into a { } map, and applying the 324 | merge-fn and any finalizer" 325 | [{merge-fn ::stream.cross/merge-fn 326 | product-sort-fn ::stream.cross/product-sort-fn 327 | finalizer-fn ::stream.cross/finalizer-fn 328 | :as _cross-spec} 329 | selected-id-partitions] 330 | 331 | (let [id-val-seqs (->> selected-id-partitions 332 | (map (fn [[sid partition]] 333 | (map (fn [v] [sid v]) partition))))] 334 | 335 | (->> id-val-seqs 336 | (apply combo/cartesian-product) 337 | (map (fn [id-vals] (into (linked/map) id-vals))) 338 | (map merge-fn) 339 | (filter #(not= % ::stream.cross/none)) 340 | (map finalizer-fn) 341 | (product-sort-fn)))) 342 | 343 | (defn chunk-full? 344 | "should the current chunk be wrapped?" 345 | [chunk-builder 346 | {target-chunk-size ::stream.cross/target-chunk-size 347 | :as _cross-spec}] 348 | (prn "chunk-full?" target-chunk-size (count (stream.pt/-chunk-state chunk-builder))) 349 | (and (stream.pt/-building-chunk? chunk-builder) 350 | (>= (count (stream.pt/-chunk-state chunk-builder)) 351 | (or target-chunk-size default-target-chunk-size)))) 352 | 353 | (defn chunk-not-empty? 354 | [chunk-builder] 355 | (and (stream.pt/-building-chunk? chunk-builder) 356 | (> (count (stream.pt/-chunk-state chunk-builder)) 357 | 0))) 358 | 359 | (defn cross-finished? 360 | [id-partition-buffers] 361 | (every? partition-buffer-content-drained? (vals id-partition-buffers))) 362 | 363 | (defn cross-input-errored? 364 | [id-partition-buffers] 365 | (some partition-buffer-errored? (vals id-partition-buffers))) 366 | 367 | (defn first-cross-input-error 368 | "use the first input error for an output error" 369 | [id-partition-buffers] 370 | (->> (vals id-partition-buffers) 371 | (filter (fn [[_id pb]] (partition-buffer-errored? pb))) 372 | (map second) ;; partition-buffers 373 | (first) ;; [::errored ] 374 | (second))) 375 | 376 | (defn cross* 377 | "the implementation, which relies on the support functions: 378 | 379 | - select-fn - select from partitions with matching keys 380 | - merge-fn - merge records from multiple streams with matching keys, 381 | - product-sort-fn - sort a merged cartesian product of records with 382 | matching keys from multiple streams 383 | - key-comparator-fn - compare keys, like `compare` 384 | - key-extractor-fns - extract a key from a value on a stream 385 | 386 | and proceeds iteratively like so: 387 | 388 | - fill any partition buffers requiring it 389 | - find the minimum key-value from all the lead partitions 390 | - use the select-fn to select from the lead partitions with the 391 | minimum-key-value: [[ ]+], taking only the 392 | selected partitions from their respective buffers 393 | - generate a cartesian product from the selected [[ ]+] 394 | partitions 395 | - merge the records from each row of the cartesian product - i.e. one record 396 | from each stream 397 | - sort the resulting list of merged records with the product-sort-fn 398 | - add the sorted list of merged records to the current chunk 399 | - output the chunk if it's full 400 | " 401 | [cross-spec 402 | id-streams] 403 | 404 | (let [cb (stream.chunk/stream-chunk-builder) 405 | out (stream.transport/stream)] 406 | 407 | (-> 408 | 409 | (init-partition-buffers! cross-spec id-streams) 410 | 411 | (prpr/handle-always 412 | (fn [id-partition-buffers err] 413 | 414 | (if (some? err) 415 | (err/wrap-uncaught err) 416 | 417 | #_{:clj-kondo/ignore [:loop-without-recur]} 418 | (pr/loop [id-partition-buffers id-partition-buffers] 419 | 420 | (cond 421 | 422 | (cross-input-errored? id-partition-buffers) 423 | (err/wrap-uncaught 424 | (first-cross-input-error id-partition-buffers)) 425 | 426 | ;; finish up - output any in-progress chunk, and close the output 427 | (cross-finished? id-partition-buffers) 428 | (if (chunk-not-empty? cb) 429 | (pr/chain 430 | (stream.transport/put! out (stream.pt/-finish-chunk cb)) 431 | (fn [_] (stream.transport/close! out))) 432 | (stream.transport/close! out)) 433 | 434 | ;; fetch more input, generate more output, and send a chunk 435 | ;; to the output stream when filled 436 | :else 437 | (prpr/handle-always 438 | (fill-partition-buffers! 439 | id-partition-buffers 440 | cross-spec 441 | id-streams) 442 | (fn [id-partition-buffers err] 443 | 444 | (if (some? err) 445 | (err/wrap-uncaught err) 446 | 447 | (let [;;_ (prn "id-partition-buffers" id-partition-buffers) 448 | 449 | [selected-id-partitions 450 | id-partition-buffers] (next-selections 451 | cross-spec 452 | id-partition-buffers) 453 | 454 | ;;_ (prn "selected-id-partitions" selected-id-partitions) 455 | ;;_ (prn "next-id-partition-buffers" id-partition-buffers) 456 | 457 | output-records (generate-output 458 | cross-spec 459 | selected-id-partitions) 460 | 461 | ;;_ (prn "output-records" output-records) 462 | 463 | _ (do 464 | (when-not (stream.pt/-building-chunk? cb) 465 | (stream.pt/-start-chunk cb)) 466 | (stream.pt/-add-all-to-chunk cb output-records)) 467 | 468 | output-chunk (when (chunk-full? cb cross-spec) 469 | (stream.pt/-finish-chunk cb))] 470 | 471 | (pr/let [put-ok? (when (some? output-chunk) 472 | (stream.transport/put! 473 | out 474 | output-chunk))] 475 | 476 | ;; TODO something awry here - dealing with the 477 | ;; put=false case causes test failures 478 | (if true ; put-ok? 479 | (pr/recur id-partition-buffers) 480 | 481 | (err/wrap-uncaught 482 | (err/ex-info 483 | ::cross*-downstream-closed 484 | {:cross-spec cross-spec 485 | :output-chunk output-chunk})) 486 | ))))))))))) 487 | 488 | (prpr/handle-always 489 | 490 | (fn [r err] 491 | 492 | (when-let [err (or err 493 | (and (err/uncaught-wrapper? r) 494 | (err/unwrap-value r)))] 495 | 496 | (doseq [[_id stream] id-streams] 497 | (stream.transport/close! stream)) 498 | 499 | (stream.transport/error! out err))))) 500 | 501 | out)) 502 | 503 | (defn select-first 504 | "select-fn which takes the first id-partition from the offered 505 | list of id-partitions" 506 | [id-partitions] 507 | ;; (info "select-first" skey-head-values) 508 | (take 1 id-partitions)) 509 | 510 | (defn select-all 511 | "select-fn which takes all offered id-partitions" 512 | [id-partitions] 513 | id-partitions) 514 | 515 | (defn set-select-all 516 | "select-fn which takes all offered id-partitions and additionlly checks 517 | that no partition has more than a single element (as required of a set)" 518 | [id-partitions] 519 | (let [set? (->> (for [[_id partition] id-partitions] 520 | (count partition)) 521 | (every? #(= % 1)))] 522 | (when-not set? 523 | (throw 524 | (err/ex-info ::not-a-set 525 | {:id-partitions id-partitions}))) 526 | id-partitions)) 527 | 528 | (defn ->select-fn 529 | [{op ::stream.cross/op 530 | :as _cross-spec}] 531 | (case op 532 | ::stream.cross.op/sorted-merge select-first 533 | ::stream.cross.op/inner-join select-all 534 | ::stream.cross.op/outer-join select-all 535 | ::stream.cross.op/n-left-join select-all 536 | ::stream.cross.op/intersect set-select-all 537 | ::stream.cross.op/union set-select-all 538 | ::stream.cross.op/difference set-select-all)) 539 | 540 | (defn merge-sorted-merge 541 | [m] 542 | (-> m vals first)) 543 | 544 | (defn make-merge-inner-join 545 | [{kxfns ::stream.cross/key-extractor-fns 546 | :as _cross-spec}] 547 | (fn [m] 548 | (if (= (count m) (count kxfns)) 549 | m 550 | ::stream.cross/none))) 551 | 552 | (defn make-merge-n-left-join 553 | [{kxfns ::stream.cross/key-extractor-fns 554 | n ::stream.cross.op.n-left-join/n 555 | :as _cross-spec}] 556 | (let [n-left-ids (->> kxfns (take n) (map first) set)] 557 | (fn [m] 558 | (if (= n-left-ids 559 | (set/intersection 560 | (-> m keys set) 561 | n-left-ids)) 562 | m 563 | ::stream.cross/none)))) 564 | 565 | (defn make-merge-intersect 566 | [{kxfns ::stream.cross/key-extractor-fns 567 | :as _cross-spec}] 568 | (fn [m] 569 | (if (= (count m) (count kxfns)) 570 | m 571 | ::stream.cross/none))) 572 | 573 | (defn make-merge-difference 574 | [{kxfns ::stream.cross/key-extractor-fns 575 | :as _cross-spec}] 576 | (fn [m] 577 | (if (and 578 | (= (count m) 1) 579 | (contains? m (-> kxfns first first))) 580 | m 581 | ::stream.cross/none))) 582 | 583 | (defn ->merge-fn 584 | [{op ::stream.cross/op 585 | :as cross-spec}] 586 | 587 | (case op 588 | ::stream.cross.op/sorted-merge merge-sorted-merge 589 | 590 | ::stream.cross.op/inner-join (make-merge-inner-join cross-spec) 591 | 592 | ::stream.cross.op/outer-join identity 593 | 594 | ::stream.cross.op/n-left-join (make-merge-n-left-join cross-spec) 595 | 596 | ::stream.cross.op/intersect (make-merge-intersect cross-spec) 597 | 598 | ::stream.cross.op/union identity 599 | 600 | ::stream.cross.op/difference (make-merge-difference cross-spec))) 601 | 602 | (defn ->product-sort-fn 603 | [{product-sort ::stream.cross/product-sort 604 | :as _cross-spec}] 605 | 606 | (or product-sort identity)) 607 | 608 | (defn ->finalizer-fn 609 | [{finalizer ::stream.cross/finalizer 610 | :as _cross-spec}] 611 | 612 | (or finalizer identity)) 613 | 614 | (defn ->key-comparator-fn 615 | [{key-comparator ::stream.cross/key-comparator 616 | :as _cross-spec}] 617 | 618 | (cond 619 | (nil? key-comparator) compare 620 | (fn? key-comparator) key-comparator 621 | (= :compare key-comparator) compare 622 | (= :negcompare key-comparator) (comp - compare))) 623 | 624 | (defn ->key-extractor-fn 625 | "given a key-spec, return a key-extractor fn" 626 | [key-spec] 627 | (cond 628 | (keyword? key-spec) key-spec 629 | (fn? key-spec) key-spec 630 | (sequential? key-spec) #(get-in % key-spec) 631 | :else (throw (err/ex-info ::unknown-key-spec {:key-spec key-spec})))) 632 | 633 | (defn ->key-extractor-fns 634 | [{keyspecs ::stream.cross/keys 635 | :as _cross-spec}] 636 | (->> (for [[id keyspec] keyspecs] 637 | [id (->key-extractor-fn keyspec)]) 638 | (into (linked/map)))) 639 | 640 | (defn partition-stream 641 | [{target-chunk-size ::stream.cross/target-chunk-size 642 | kxfns ::stream.cross/key-extractor-fns 643 | :as _cross-spec} 644 | stream-id 645 | stream] 646 | (let [partition-by-fn (get kxfns stream-id)] 647 | (stream.ops/chunkify target-chunk-size partition-by-fn stream))) 648 | 649 | (defn partition-streams 650 | "returns a linked/map with { }, and 651 | in the same order as specifed in the ::stream.cross/keys config" 652 | [{kxfns ::stream.cross/key-extractor-fns 653 | :as cross-spec} 654 | id-streams] 655 | (let [sids (keys kxfns)] 656 | (->> (for [sid sids] 657 | [sid (partition-stream cross-spec sid (get id-streams sid))]) 658 | (into (linked/map))))) 659 | 660 | (defn configure-cross-op 661 | "assemble helper functions to allow the core cross-stream* impl 662 | to perform the specified operation" 663 | [cross-spec] 664 | 665 | (let [;; merge-fn is dependent on key-extractor-fns 666 | cross-spec (assoc cross-spec 667 | ::stream.cross/key-extractor-fns 668 | (->key-extractor-fns cross-spec))] 669 | (merge 670 | {::stream.cross/target-chunk-size 1000} 671 | 672 | cross-spec 673 | 674 | {::stream.cross/select-fn (->select-fn cross-spec) 675 | ::stream.cross/merge-fn (->merge-fn cross-spec) 676 | ::stream.cross/product-sort-fn (->product-sort-fn cross-spec) 677 | ::stream.cross/finalizer-fn (->finalizer-fn cross-spec) 678 | ::stream.cross/key-comparator-fn (->key-comparator-fn cross-spec)}))) 679 | 680 | (def KeySpec 681 | [:or 682 | ;; keyword for a call to get 683 | :keyword 684 | 685 | fn? 686 | 687 | ;; list of args for a call to get-in 688 | [:+ [:or :keyword :int :string]]]) 689 | 690 | ;; a variety of merge, join, and set operations are possible 691 | ;; when crossing streams 692 | ;; 693 | ;; all operations require that every input stream is sorted in the 694 | ;; same key 695 | (def CrossStreamsOp 696 | [:enum 697 | ;; the merge phase of a sort-merge join. 698 | ;; output is merged but input values are unchanged 699 | ::stream.cross.op/sorted-merge 700 | 701 | ;; inner join 702 | ;; output is maps with { ...} 703 | ::stream.cross.op/inner-join 704 | 705 | ;; full outer join 706 | ;; output is maps with { ...} 707 | ::stream.cross.op/outer-join 708 | 709 | ;; left join requiring at least n leftmost values (default 1) 710 | ;; output is maps with { ...} 711 | ::stream.cross.op/n-left-join 712 | 713 | ;; set intersection 714 | ;; output is sorted, but remaining input values are unchanged 715 | ::stream.cross.op/intersect 716 | 717 | ;; set union 718 | ;; output is sorted, but input values are unchanged 719 | ::stream.cross.op/union 720 | 721 | ;; set difference 722 | ;; output is sorted, but input values are unchanged 723 | ::stream.cross.op/difference]) 724 | 725 | ;; an order must be given for keyspecs in the CrossSpec 726 | (def OrderedKeySpecs 727 | [:+ [:tuple :keyword KeySpec]]) 728 | 729 | (def CrossSpec 730 | [:map 731 | 732 | ;; there must be 1 entry per stream, specifying how to 733 | ;; extract the key from a value on that stream 734 | [::stream.cross/keys OrderedKeySpecs] 735 | 736 | ;; the cross-streams operation 737 | [::stream.cross/op CrossStreamsOp] 738 | 739 | ;; optional comparator fn for keys - defaults to `compare` 740 | [::stream.cross/key-comparator {:optional true} fn?] 741 | 742 | ;; optional product-sort fn to sort cartesian product output 743 | ;; defaults to `identity` 744 | [::stream.cross/product-sort {:optional true} fn?] 745 | 746 | ;; optional number of leftmost values required for 747 | ;; a non-nil n-left-join result 748 | [::stream.cross.op.n-left-join/n {:optional true} :int] 749 | 750 | ;; optional function to finalize an output value 751 | [::stream.cross/finalizer {:optional true} fn?] 752 | 753 | ;; target-chunk-size for crosssed output 754 | [::stream.cross/target-chunk-size {:optional true} :int]]) 755 | 756 | (def CrossSupportFns 757 | "the fns which implement cross operation behaviours, all derived from the 758 | config in CrossSpec and defaults" 759 | [:map 760 | ;; the operation-determined select-fn chooses which partitions are taken from the 761 | ;; leading partitions which match the minimum key value 762 | [::stream.cross/select-fn fn?] 763 | 764 | ;; given a { } map of selected partitions, the 765 | ;; op-determined merge-fn decides what, if anything, moves to output 766 | [::stream.cross/merge-fn fn?] 767 | 768 | ;; given merged output, the optional caller-specified finalizer-fn 769 | ;; applies a transformation to the merged output 770 | [::stream.cross/finalizer-fn fn?] 771 | 772 | ;; given finalized output, the optional caller-specified product-sort-fn 773 | ;; applies a sort to the crossed partition output 774 | [::stream.cross/product-sort-fn fn?] 775 | 776 | ;; the key-comparator-fn is used to compare key values - default to `compare` 777 | [::stream.cross/key-comparator-fn fn?] 778 | 779 | ;; the key-extractor-fns extract keys from the values on each stream 780 | [::stream.cross/key-extractor-fns 781 | [:map-of :keyword fn?]]]) 782 | 783 | (def ConfiguredCrossOperation 784 | (-> CrossSpec 785 | (mu/merge CrossSupportFns))) 786 | 787 | (def IdStreams 788 | "id->stream mappings, either in a map, or a 789 | list of pairs - the latter providing order for 790 | operations like n-left-join which require it" 791 | [:or 792 | [:map-of :keyword [:fn stream.transport/stream?]] 793 | [:+ [:tuple :keyword [:fn stream.transport/stream?]]]]) 794 | 795 | (mx/defn cross 796 | "cross some sorted streams, returning a stream according to the cross-spec 797 | 798 | each input stream must be sorted ascending in the key specified in cross-spec 799 | at 800 | [::stream.cross/keys ] 801 | with the comparator fn from ::stream.cross/comparator 802 | 803 | - cross-spec : a description of the operation to cross the streams 804 | - id-streams : { } 805 | 806 | e.g. this invocations inner-joins a stream of users, sorted by :org-id, to a 807 | stream of orgs, sorted by :id 808 | 809 | (cross 810 | {::stream.cross/keys {:users :org-id :orgs :id} 811 | ::stream.cross/op ::stream.cross/inner-join} 812 | {:users 813 | :orgs })" 814 | [cross-spec :- CrossSpec 815 | id-streams :- IdStreams] 816 | 817 | (let [;; configure the specific support fns for the operation 818 | cross-spec (configure-cross-op cross-spec) 819 | 820 | ;; chunk+partition the streams 821 | id-streams (partition-streams cross-spec id-streams)] 822 | 823 | ;; cross those streams! 824 | (cross* cross-spec id-streams))) 825 | -------------------------------------------------------------------------------- /test/promisespromises/stream/old_cross_test.cljz: -------------------------------------------------------------------------------- 1 | (ns promisespromises.stream.old-cross-test 2 | (:require 3 | [promisespromises.test :refer [deftest testing is with-log-level]])) 4 | 5 | (defn random-sorted-vec 6 | "returns a sorted vector of random integers" 7 | [{min-vec-sz :min-vec-sz 8 | max-vec-sz :max-vec-sz 9 | min-el-val :min-el-val 10 | el-val-range :el-val-range 11 | :or {min-vec-sz 0 12 | el-val-range Integer/MAX_VALUE}}] 13 | (assert max-vec-sz) 14 | (let [sz (rand-int (- (inc max-vec-sz) min-vec-sz)) 15 | sz (+ min-vec-sz sz) 16 | 17 | min-el-val (or min-el-val 18 | (rand-int (- Integer/MAX_VALUE el-val-range)))] 19 | (->> (range 0 sz) 20 | (map (fn [_] (+ min-el-val (rand-int el-val-range)))) 21 | (sort) 22 | (vec)))) 23 | 24 | (defn random-sorted-vecs 25 | [{vec-cnt :vec-cnt 26 | min-el-val :min-el-val 27 | el-val-range :el-val-range 28 | :or {el-val-range Integer/MAX_VALUE} 29 | :as args}] 30 | (assert vec-cnt) 31 | (let [min-el-val (or min-el-val 32 | (rand-int (- Integer/MAX_VALUE el-val-range)))] 33 | (vec 34 | (repeatedly vec-cnt #(random-sorted-vec 35 | (-> args 36 | (dissoc :vec-cnt) 37 | (assoc :min-el-val min-el-val))))))) 38 | 39 | (defn random-keyed-vecs 40 | "returns a linked/map of random vectors keyed by 41 | keywords formed from a 0-based index" 42 | [{min-vec-cnt :min-vec-cnt 43 | max-vec-cnt :max-vec-cnt 44 | :or {min-vec-cnt 1} 45 | :as args}] 46 | (assert max-vec-cnt) 47 | (let [cnt (rand-int (- (inc max-vec-cnt) min-vec-cnt)) 48 | cnt (+ min-vec-cnt cnt) 49 | vs (random-sorted-vecs (-> args 50 | (dissoc :min-vec-cnt :max-vec-cnt) 51 | (assoc :vec-cnt cnt)))] 52 | (->> 53 | vs 54 | (map-indexed 55 | (fn [i v] 56 | [(keyword (str i)) v])) 57 | (into (linked/map))))) 58 | 59 | (defn random-keyed-vecs-seq 60 | [{seq-cnt :seq-cnt 61 | :as args}] 62 | (assert seq-cnt) 63 | (repeatedly seq-cnt #(random-keyed-vecs (-> args 64 | (dissoc :seq-cnt))))) 65 | 66 | (defn random-keys 67 | "return a non-empty set containing a random selection of keys from a 68 | non-empty map of stream buffers with 69 | sequential 0-based int-keyword stream keys" 70 | [kvs] 71 | (let [cnt (count kvs)] 72 | (assert (> cnt 0)) 73 | (->> (rand-int cnt) 74 | inc 75 | (range 0) 76 | (map (fn [_] (rand-int cnt))) 77 | (distinct) 78 | (map (comp keyword str)) 79 | (set)))) 80 | 81 | (defn vecs->streams 82 | [vs] 83 | (mapv s/->source vs)) 84 | 85 | (defn keyed-vecs->streams 86 | [kvs] 87 | (->> kvs 88 | (map (fn [[k v]] [k (s/->source v)])) 89 | (into (linked/map)))) 90 | 91 | (defn keyed-vecs->sorted-streams 92 | ([key-fn kvs] 93 | (->> kvs 94 | (map (fn [[k v]] [k (sut/sorted-stream 95 | key-fn 96 | (s/->source v))])) 97 | (into (linked/map))))) 98 | 99 | (deftest min-key-val-test 100 | (is (= 1 (sut/min-key-val compare [3 2 1]))) 101 | (is (= 3 (sut/min-key-val (comp - compare) [3 2 1])))) 102 | 103 | (deftest buffer-values-test 104 | (testing "empty stream" 105 | (let [[h n :as r] @(sut/buffer-values 106 | compare 107 | :foo 108 | (s/->source []) 109 | nil)] 110 | (is (= h ::sut/drained)))) 111 | 112 | (testing "initial values" 113 | (let [[h n :as r] @(sut/buffer-values 114 | compare 115 | :foo 116 | (s/->source [0 0 0 1]) 117 | nil)] 118 | (is (= h [0 [0 0 0]])))) 119 | 120 | (testing "end of stream" 121 | (let [[h n :as r] @(sut/buffer-values 122 | compare 123 | :foo 124 | (s/->source []) 125 | [0 [0 0 0]])] 126 | (is (= r [[0 [0 0 0]] 127 | ::sut/drained])))) 128 | 129 | (testing "another value with the key then end-of-stream" 130 | (let [[h n :as r] @(sut/buffer-values 131 | compare 132 | :foo 133 | (s/->source [0]) 134 | [0 [0 0]])] 135 | (is (= r [[0 [0 0 0]] 136 | ::sut/drained])))) 137 | 138 | (testing "another value with the key then a different key" 139 | (let [[h n :as r] @(sut/buffer-values 140 | compare 141 | :foo 142 | (s/->source [0 1]) 143 | [0 [0 0]])] 144 | (is (= r [[0 [0 0 0]] 145 | [1 [1]]])))) 146 | 147 | (testing "values out of order throw error" 148 | (let [[ek err] @(pr/catch-error 149 | (sut/buffer-values 150 | compare 151 | :foo 152 | (s/->source [0]) 153 | [1 [1]]))] 154 | (is (= ek ::sut/stream-not-sorted)) 155 | (is (= err {:stream-key :foo 156 | :this [1 [1]] 157 | :next [0 [0]]})))) 158 | 159 | (testing "exception during key-compare reports buffers" 160 | (let [[ek err] @(pr/catch-error 161 | (sut/buffer-values 162 | (fn [a b] (throw (ex-info "boo" {}))) 163 | :foo 164 | (s/->source [0]) 165 | [1 [1]]))] 166 | (is (= ek ::sut/key-compare-error)) 167 | (is (= err {:stream-key :foo 168 | :this [1 [1]] 169 | :next [0 [0]]}))))) 170 | 171 | (deftest init-stream-buffers-test 172 | ;; max-value smaller than max-sz leads to repeated sequences 173 | ;; of the same int 174 | (doseq [kvs (random-keyed-vecs-seq {:seq-cnt 1000 175 | :max-vec-cnt 20 176 | :max-vec-sz 10 177 | :el-val-range 3})] 178 | (let [ss (keyed-vecs->streams kvs) 179 | hvs @(sut/init-stream-buffers compare ss)] 180 | (is (= (->> kvs (map 181 | (fn [[k vs]] 182 | (let [pvs (->> vs 183 | (partition-by identity) 184 | (map vec))] 185 | (if (not-empty pvs) 186 | [k [[(-> pvs first first) (first pvs)] 187 | (if (second pvs) 188 | ;; note only a *single* element of the 189 | ;; next-value items is retrieved 190 | [(-> pvs second first) 191 | [(-> pvs second first)]] 192 | ::sut/drained)]] 193 | [k [::sut/drained]])))) 194 | (into (linked/map))) 195 | hvs))))) 196 | 197 | (deftest min-key-skey-values-test 198 | (doseq [kvs (random-keyed-vecs-seq {:seq-cnt 1000 199 | :max-vec-cnt 20 200 | :max-vec-sz 10 201 | :el-val-range 3})] 202 | (let [kss (keyed-vecs->streams kvs) 203 | hvs @(sut/init-stream-buffers compare kss) 204 | 205 | mkskvs (sut/min-key-skey-values 206 | compare 207 | kss 208 | hvs)] 209 | (is (= (->> kvs 210 | (map (fn [[k vs]] 211 | (let [pvs (partition-by identity vs)] 212 | (when (not-empty pvs) 213 | [k (-> pvs first first) (first pvs)])))) 214 | (filter some?) 215 | (sort-by second) 216 | (partition-by second) 217 | first 218 | (map (fn [[sk vk vs]] 219 | [sk vs])) 220 | (into (linked/map))) 221 | mkskvs))))) 222 | 223 | (deftest select-skey-values-test 224 | (doseq [kvs (random-keyed-vecs-seq {:seq-cnt 1000 225 | :max-vec-cnt 20 226 | :max-vec-sz 10 227 | :el-val-range 3})] 228 | (let [kss (keyed-vecs->streams kvs) 229 | hvs @(sut/init-stream-buffers compare kss) 230 | 231 | mkskvs (sut/min-key-skey-values 232 | compare 233 | kss 234 | hvs)] 235 | 236 | ;; (info "mkskvs" mkskvs) 237 | 238 | (testing "select-first" 239 | (let [sel-skvs (sut/select-skey-values 240 | sut/select-first 241 | mkskvs)] 242 | (is (= (->> mkskvs 243 | (take 1) 244 | (into (linked/map))) 245 | sel-skvs)))) 246 | 247 | (testing "select-all" 248 | (let [sel-skvs (sut/select-skey-values 249 | sut/select-all 250 | mkskvs)] 251 | (is (= mkskvs 252 | sel-skvs))))))) 253 | 254 | (deftest merge-stream-objects-test 255 | ;; limit the max-vec-sz to 1 so there are no repeated 256 | ;; skeys in skey-vals 257 | (doseq [kvs (random-keyed-vecs-seq {:seq-cnt 1000 258 | :max-vec-cnt 20 259 | :max-vec-sz 1 260 | :el-val-range 3})] 261 | (let [kss (keyed-vecs->sorted-streams 262 | identity 263 | kvs) 264 | hvs @(sut/init-stream-buffers compare kss) 265 | 266 | mkskvs (sut/min-key-skey-values 267 | compare 268 | kss 269 | hvs) 270 | 271 | sel-skvs (sut/select-skey-values 272 | sut/select-all 273 | mkskvs) 274 | 275 | skey-vals (->> sel-skvs 276 | (map (fn [[sk vs]] 277 | (for [v vs] 278 | [sk v]))) 279 | (apply concat)) 280 | 281 | mos (sut/merge-stream-objects 282 | 0 283 | (fn [o sk v] (+ o v)) 284 | kss 285 | skey-vals)] 286 | (is (= (->> skey-vals 287 | (map second) 288 | (reduce + 0)) 289 | mos))))) 290 | 291 | (deftest head-values-cartesian-product-merge-test 292 | (testing "trivial cartesian product" 293 | (is (= @(sut/head-values-cartesian-product-merge 294 | [] 295 | conj 296 | identity 297 | identity 298 | {} 299 | {}) 300 | []))) 301 | (testing "non-trivial cartesian products" 302 | (doseq [;; ensure no empty streams with :min-vec-sz 303 | ;; also be careful - it will generate 304 | ;; ~ :max-vec-sz ^ max-vec-cnt 305 | ;; records 306 | kvs (random-keyed-vecs-seq {:seq-cnt 1000 307 | :max-vec-cnt 5 308 | :min-vec-sz 1 309 | :max-vec-sz 10 310 | :el-val-range 3})] 311 | (let [kss (keyed-vecs->streams kvs) 312 | hvs @(sut/init-stream-buffers compare kss) 313 | 314 | mkskvs (sut/min-key-skey-values 315 | compare 316 | kss 317 | hvs) 318 | 319 | kvcp @(sut/head-values-cartesian-product-merge 320 | [] 321 | conj 322 | identity 323 | identity 324 | kss 325 | mkskvs)] 326 | ;; (info "mkskvs" mkskvs) 327 | ;; (info "kvcp" (vec kvcp)) 328 | 329 | (is (= (->> mkskvs 330 | (map (fn [[sk hvals]] 331 | (for [v hvals] 332 | [sk v]))) 333 | (apply combo/cartesian-product) 334 | (map #(sut/merge-stream-objects [] conj kss %))) 335 | kvcp))))) 336 | 337 | (testing "finish-merge finishes merges and product-sort-fn sorts the cartesian product output" 338 | (let [s1 [{:foo 1 :bar 1} {:foo 1 :bar 2}] 339 | s2 [{:foo 1 :baz 2} {:foo 1 :baz 1}] 340 | kvs {:s1 s1 :s2 s2} 341 | kss (keyed-vecs->sorted-streams 342 | :foo 343 | kvs) 344 | hvs @(sut/init-stream-buffers compare kss) 345 | mkskvs (sut/min-key-skey-values 346 | compare 347 | kss 348 | hvs) 349 | kvcp @(sut/head-values-cartesian-product-merge 350 | {} 351 | assoc 352 | (fn [o] (->> o vals (apply merge))) 353 | (partial sort-by (juxt :bar :baz)) 354 | kss 355 | mkskvs)] 356 | (is (= 357 | [{:foo 1, :bar 1, :baz 1} 358 | {:foo 1, :bar 1, :baz 2} 359 | {:foo 1, :bar 2, :baz 1} 360 | {:foo 1, :bar 2, :baz 2}] 361 | kvcp)))) 362 | 363 | (testing "finish-merge returning a Deferred result" 364 | (let [s1 [{:foo 1 :bar 1} {:foo 1 :bar 2}] 365 | s2 [{:foo 1 :baz 2} {:foo 1 :baz 1}] 366 | kvs {:s1 s1 :s2 s2} 367 | kss (keyed-vecs->sorted-streams 368 | :foo 369 | kvs) 370 | hvs @(sut/init-stream-buffers compare kss) 371 | mkskvs (sut/min-key-skey-values 372 | compare 373 | kss 374 | hvs) 375 | kvcp @(sut/head-values-cartesian-product-merge 376 | {} 377 | assoc 378 | (fn [o] (->> o vals (apply merge) d/success-deferred)) 379 | (partial sort-by (juxt :bar :baz)) 380 | kss 381 | mkskvs)] 382 | (is (= 383 | [{:foo 1, :bar 1, :baz 1} 384 | {:foo 1, :bar 1, :baz 2} 385 | {:foo 1, :bar 2, :baz 1} 386 | {:foo 1, :bar 2, :baz 2}] 387 | kvcp)))) 388 | 389 | (testing "finish-merge-fn can remove values" 390 | (let [s1 [{:foo 1 :bar 1} {:foo 1 :bar 2}] 391 | s2 [{:foo 1 :baz 2} {:foo 1 :baz 1}] 392 | kvs {:s1 s1 :s2 s2} 393 | kss (keyed-vecs->sorted-streams 394 | :foo 395 | kvs) 396 | hvs @(sut/init-stream-buffers compare kss) 397 | mkskvs (sut/min-key-skey-values 398 | compare 399 | kss 400 | hvs) 401 | kvcp @(sut/head-values-cartesian-product-merge 402 | {} 403 | assoc 404 | (fn [o] (->> o 405 | vals 406 | (apply merge) 407 | ((fn [m] 408 | (when (even? (:bar m)) 409 | m))))) 410 | (partial sort-by (juxt :bar :baz)) 411 | kss 412 | mkskvs)] 413 | (is (= 414 | [{:foo 1, :bar 2, :baz 1} 415 | {:foo 1, :bar 2, :baz 2}] 416 | kvcp))))) 417 | 418 | (deftest next-output-values-test 419 | (testing "next-output-values" 420 | (doseq [kvs (concat 421 | ;; always try degenerate all-empty-streams cases 422 | [{:0 []}] 423 | [{:0 [] :1 []}] 424 | (random-keyed-vecs-seq {:seq-cnt 1000 425 | :max-vec-cnt 20 426 | :max-vec-sz 100 427 | :el-val-range 5}) 428 | )] 429 | (let [kss (keyed-vecs->sorted-streams 430 | identity 431 | ;; (fn [o [sk v]] (conj o [sk v])) 432 | kvs) 433 | 434 | skey-streambufs @(sut/init-stream-buffers compare kss) 435 | 436 | all-drained? (->> skey-streambufs 437 | (filter (fn [[sk [hv]]] 438 | (not= ::sut/drained hv))) 439 | (count) 440 | (= 0)) 441 | 442 | ;; _ (warn "skey-streambufs" skey-streambufs) 443 | 444 | [output-values 445 | next-skey-head-values] @(sut/next-output-values 446 | {:key-compare-fn compare 447 | :selector-fn sut/select-first 448 | :finish-merge-fn nil 449 | :product-sort-fn nil 450 | :init-output-value {} 451 | :skey-streams kss 452 | :skey-streambufs skey-streambufs})] 453 | ;; (warn "kvs" kvs) 454 | (if all-drained? 455 | (do 456 | (is (= ::sut/drained output-values)) 457 | (is (= nil next-skey-head-values))) 458 | (do 459 | (let [expected-result (->> kvs 460 | (filter #(not-empty (second %))) 461 | (sort-by (comp first second)) 462 | (take 1) 463 | (map (fn [[k vs]] (->> vs 464 | (partition-by identity) 465 | first 466 | (map (fn [v] {k v}))))) 467 | (apply concat))] 468 | (when (not= expected-result output-values) 469 | (warn "bad-kvs" kvs) 470 | (warn "bad-skey-streambufs" skey-streambufs) 471 | (warn "bad-expected-result" expected-result) 472 | (warn "bad-output-values" (vec output-values))) 473 | (is (= expected-result 474 | output-values)))))))) 475 | 476 | (testing "throws if selector-fn doesn't select at least one value" 477 | (let [s0 (s/->source [1 2 3]) 478 | s1 (s/->source [1 2 3]) 479 | kss {:0 s0 :1 s1} 480 | [ek err] @(pr/catch-error 481 | (sut/next-output-values 482 | {:key-compare-fn compare 483 | :selector-fn (fn [& args] nil) 484 | :finish-merge-fn nil 485 | :product-sort-fn nil 486 | :init-output-value {} 487 | :skey-streams kss 488 | :skey-streambufs {:0 [[1 [1]] ::sut/drained] :1 [[1 [1]] ::sut/drained]}}))] 489 | (is (= ::sut/selector-fn-failed ek)))) 490 | 491 | (testing "throws if selector-fn chooses a wrong value" 492 | (let [s0 (s/->source [1 2 3]) 493 | s1 (s/->source [1 2 3]) 494 | kss {:0 s0 :1 s1} 495 | [ek error] @(pr/catch-error 496 | (sut/next-output-values 497 | {:key-compare-fn compare 498 | :selector-fn (fn [& args] [::blah]) 499 | :finish-merge-fn nil 500 | :product-sort-fn nil 501 | :init-output-value {} 502 | :skey-streams kss 503 | :skey-streambufs {:0 [[1 [1]] ::sut/drained] :1 [[1 [1]] ::sut/drained]}}))] 504 | (is (= ::sut/selector-fn-failed ek)))) 505 | ) 506 | 507 | (deftest cross-streams-test 508 | (testing "streams get crossed" 509 | (doseq [kvs (concat 510 | ;; always try degenerate all-empty-streams cases 511 | [{:0 []}] 512 | [{:0 [] :1 []}] 513 | ;; combinatorics can generate massive data 514 | ;; :max-vec-size ^ :max-vec-cnt 515 | (random-keyed-vecs-seq {:seq-cnt 1000 516 | :max-vec-cnt 3 517 | :max-vec-sz 100 518 | :el-val-range 10}))] 519 | ;; (warn "vs" kvs) 520 | (let [kss (keyed-vecs->streams kvs) 521 | os @(sut/cross-streams 522 | {:id ::cross-streams-test-streams-get-crossed 523 | :key-compare-fn compare 524 | :selector-fn sut/select-first 525 | :init-output-value {} 526 | :skey-streams kss}) 527 | ovs @(s/reduce conj [] os)] 528 | (is (= (->> kvs 529 | (mapcat (fn [[k vs]] (for [v vs] [k v]))) 530 | (sort-by second) 531 | (map (fn [[k v]] {k v}))) 532 | ovs)))) 533 | ) 534 | 535 | (with-log-level :error 536 | (testing "errors during setup close the sources and propagate" 537 | (let [s0 (s/stream) 538 | s1 (s/stream) 539 | _ (doseq [v [1 2 3]] (s/put! s0 v)) 540 | _ (doseq [v [1 2 3]] (s/put! s1 v)) 541 | kss {:0 s0 :1 s1} 542 | os-d (sut/cross-streams 543 | {:id ::cross-streams-test-errors-during-setup 544 | :key-compare-fn (fn [& args] (throw (ex-info "boo" {}))) 545 | :selector-fn sut/select-first 546 | :init-output-value nil 547 | :skey-streams kss}) 548 | 549 | _ (is (not (s/drained? @os-d))) 550 | v @(s/take! @os-d)] 551 | (is (pr.st/stream-error? v)) 552 | (let [[k v] (some-> v :error ex-data pr/decode-error-value)] 553 | (is (= ::sut/cross-streams-error k))) 554 | (is (s/closed? s0)) 555 | (is (s/closed? s0))))) 556 | 557 | (with-log-level :error 558 | (testing "errors after setup close the sources and the output and propagate" 559 | (let [s0 (s/stream) 560 | s1 (s/stream) 561 | _ (doseq [vs [1 2 3]] (s/put! s0 vs)) 562 | _ (doseq [vs [1 2 3]] (s/put! s1 vs)) 563 | kss {:0 s0 :1 s1} 564 | os @(sut/cross-streams 565 | {:id ::cross-streams-test-errors-after-setup 566 | :key-compare-fn (let [n (atom 0)] 567 | (fn [& args] 568 | ;; 4 is slightly flakey... the key-comparator 569 | ;; now gets called during buffering... 570 | (if (> (swap! n inc) 4) 571 | (throw (ex-info "hoo" {})) 572 | (apply compare args)))) 573 | :selector-fn sut/select-first 574 | :init-output-value {} 575 | :skey-streams kss}) 576 | [v1 v2 :as ovs] @(s/reduce conj [] os)] 577 | 578 | (is (s/closed? s0)) 579 | (is (s/closed? s1)) 580 | (is (s/drained? os)) 581 | (is (= 2 (count ovs))) 582 | (is (= {:0 1} v1)) 583 | (is (pr.st/stream-error? v2)) 584 | (let [[k v] (some-> v2 :error ex-data pr/decode-error-value)] 585 | (is (= ::sut/cross-streams-error k)))))) 586 | 587 | (log/with-config {} ;; disable logging completely to prevent exception being printed 588 | (testing "errors on derived streams don't cause hangs" 589 | ;; like they used to during participant-stream processing 590 | (let [s0 (s/stream) 591 | s1 (s/stream) 592 | kss {:0 s0 :1 s1} 593 | _ (doseq [[k s] kss] 594 | (doseq [v [1 2 3]] 595 | (s/put! s v)) 596 | (s/close! s)) 597 | 598 | cs @(sut/cross-streams 599 | {:id ::cross-streams-test-errors-on-derived-streams 600 | :key-compare-fn clojure.core/compare 601 | :selector-fn sut/select-first 602 | :init-output-value {} 603 | :skey-streams kss}) 604 | 605 | ms (s/map (fn [k-v] 606 | (let [[k v] (first k-v)] 607 | (if (< v 2) 608 | (inc v) 609 | (throw (ex-info "woo" {}))))) 610 | cs) 611 | ovs @(s/reduce conj [] ms)] 612 | 613 | (is (s/closed? s0)) 614 | (is (s/closed? s1)) 615 | (is (s/drained? ms)) 616 | (is (s/drained? cs)) ;; this is reasonable 617 | 618 | (is (= [2 2] ovs))))) 619 | 620 | ) 621 | 622 | (deftest sort-merge-streams-test 623 | (doseq [kvs (random-keyed-vecs-seq {:seq-cnt 1 624 | :max-vec-cnt 20 625 | :max-vec-sz 100 626 | :el-val-range 5})] 627 | (let [kss (keyed-vecs->streams kvs) 628 | os @(sut/sort-merge-streams 629 | {:id ::sort-merge-streams-test 630 | :skey-streams kss}) 631 | ovs @(s/reduce conj [] os)] 632 | (is (= (->> kvs 633 | vals 634 | (apply concat) 635 | sort) 636 | ovs))))) 637 | 638 | (deftest full-outer-join-records-test 639 | (testing "with a single key-fn" 640 | (let [s0 (s/->source [{:foo 1 :bar 10} {:foo 3 :bar 30} {:foo 4 :bar 40}]) 641 | s1 (s/->source [{:foo 1 :baz 100} {:foo 2 :baz 200} {:foo 3 :baz 300}]) 642 | kss {:0 s0 :1 s1} 643 | 644 | os @(sut/full-outer-join-streams 645 | {:id ::full-outer-join-records-test-single-key-fn 646 | :default-key-fn :foo 647 | :skey-streams kss}) 648 | ovs @(s/reduce conj [] os)] 649 | 650 | (is (= [{:0 {:foo 1 :bar 10} :1 {:foo 1 :baz 100}} 651 | {:1 {:foo 2 :baz 200}} 652 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 300}} 653 | {:0 {:foo 4 :bar 40}}] 654 | ovs)))) 655 | 656 | (testing "1-many joins" 657 | (let [s0 (s/->source [{:foo 1 :bar 10} 658 | {:foo 3 :bar 30} 659 | {:foo 3 :bar 40} 660 | {:foo 4 :bar 40}]) 661 | s1 (s/->source [{:foo 1 :baz 100} 662 | {:foo 1 :baz 200} 663 | {:foo 2 :baz 200} 664 | {:foo 3 :baz 300}]) 665 | kss {:0 s0 :1 s1} 666 | 667 | os @(sut/full-outer-join-streams 668 | {:id ::full-outer-join-records-test-1-many-joins 669 | :default-key-fn :foo 670 | :skey-streams kss}) 671 | ovs @(s/reduce conj [] os)] 672 | 673 | (is (= [{:0 {:foo 1 :bar 10} :1 {:foo 1 :baz 100}} 674 | {:0 {:foo 1 :bar 10} :1 {:foo 1 :baz 200}} 675 | {:1 {:foo 2 :baz 200}} 676 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 300}} 677 | {:0 {:foo 3 :bar 40} :1 {:foo 3 :baz 300}} 678 | {:0 {:foo 4 :bar 40}}] 679 | ovs)))) 680 | 681 | (testing "many-many joins" 682 | (with-log-level :error 683 | (let [s0 (s/->source [{:foo 1 :bar 10} 684 | {:foo 3 :bar 30} 685 | {:foo 3 :bar 40} 686 | {:foo 4 :bar 40}]) 687 | s1 (s/->source [{:foo 1 :baz 100} 688 | {:foo 3 :baz 300} 689 | {:foo 3 :baz 400}]) 690 | kss {:0 s0 :1 s1} 691 | 692 | os @(sut/full-outer-join-streams 693 | {:id ::full-outer-join-records-test-many-many-joins 694 | :default-key-fn :foo 695 | :skey-streams kss}) 696 | ovs @(s/reduce conj [] os)] 697 | 698 | (is (= [{:0 {:foo 1 :bar 10} :1 {:foo 1 :baz 100}} 699 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 300}} 700 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 400}} 701 | {:0 {:foo 3 :bar 40} :1 {:foo 3 :baz 300}} 702 | {:0 {:foo 3 :bar 40} :1 {:foo 3 :baz 400}} 703 | {:0 {:foo 4 :bar 40}}] 704 | ovs))))) 705 | 706 | (testing "with passed ISortedStreams with custom key-fns" 707 | (let [s0 (s/->source [{:foo 1 :bar 10} {:foo 3 :bar 30} {:foo 4 :bar 40}]) 708 | s1 (s/->source [{:foofoo 1 :baz 100} 709 | {:foofoo 2 :baz 200} 710 | {:foofoo 3 :baz 300}]) 711 | ss1 (sut/sorted-stream :foofoo s1) 712 | kss {:0 s0 :1 ss1} 713 | 714 | os @(sut/full-outer-join-streams 715 | {:id ::full-outer-join-records-test-custom-key-fns 716 | :default-key-fn :foo 717 | :skey-streams kss}) 718 | ovs @(s/reduce conj [] os)] 719 | 720 | (is (= [{:0 {:foo 1 :bar 10} :1 {:foofoo 1 :baz 100}} 721 | {:1 {:foofoo 2 :baz 200}} 722 | {:0 {:foo 3 :bar 30} :1 {:foofoo 3 :baz 300}} 723 | {:0 {:foo 4 :bar 40}}] 724 | ovs))))) 725 | 726 | (deftest n-left-join-test 727 | (testing "1-1 1-left join" 728 | (let [s0 (s/->source [{:foo 1 :bar 10} 729 | {:foo 3 :bar 30} 730 | {:foo 4 :bar 40}]) 731 | s1 (s/->source [{:foo 1 :baz 100} 732 | {:foo 2 :baz 200} 733 | {:foo 3 :baz 300}]) 734 | 735 | kss [[:0 s0][:1 s1]] 736 | 737 | os @(sut/n-left-join-streams 738 | {:id ::n-left-join-test-1-1-1-left-join 739 | :default-key-fn :foo 740 | :skey-streams kss 741 | :n 1}) 742 | ovs @(s/reduce conj [] os)] 743 | 744 | (is (= [{:0 {:foo 1 :bar 10} :1 {:foo 1 :baz 100}} 745 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 300}} 746 | {:0 {:foo 4 :bar 40}}] 747 | ovs)))) 748 | 749 | (testing "1-1 2-left join" 750 | (let [s0 (s/->source [{:foo 1 :bar 10} 751 | {:foo 3 :bar 30} 752 | {:foo 4 :bar 40}]) 753 | s1 (s/->source [{:foo 1 :baz 100} 754 | {:foo 2 :baz 200} 755 | {:foo 3 :baz 300}]) 756 | s2 (s/->source [{:foo 1 :baz 1000} 757 | {:foo 2 :baz 2000} 758 | {:foo 4 :bar 40} 759 | {:foo 5 :baz 5000}]) 760 | 761 | kss [[:0 s0][:1 s1][:2 s2]] 762 | 763 | os @(sut/n-left-join-streams 764 | {:id ::n-left-join-test-1-1-2-left-join 765 | :default-key-fn :foo 766 | :skey-streams kss 767 | :n 2}) 768 | ovs @(s/reduce conj [] os)] 769 | 770 | (is (= [{:0 {:foo 1 :bar 10} :1 {:foo 1 :baz 100} :2 {:foo 1 :baz 1000}} 771 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 300}}] 772 | ovs)))) 773 | 774 | (testing "many-many joins" 775 | (with-log-level :warn 776 | (let [s0 (s/->source [{:foo 1 :bar 10} 777 | {:foo 3 :bar 30} 778 | {:foo 3 :bar 40} 779 | {:foo 4 :bar 40}]) 780 | s1 (s/->source [{:foo 1 :baz 100} 781 | {:foo 3 :baz 300} 782 | {:foo 3 :baz 400} 783 | {:foo 5 :baz 500}]) 784 | kss [[:0 s0][:1 s1]] 785 | 786 | os @(sut/n-left-join-streams 787 | {:id ::n-left-join-test-many-many-joins 788 | :default-key-fn :foo 789 | :skey-streams kss 790 | :n 1}) 791 | ovs @(s/reduce conj [] os)] 792 | 793 | (is (= [{:0 {:foo 1 :bar 10} :1 {:foo 1 :baz 100}} 794 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 300}} 795 | {:0 {:foo 3 :bar 30} :1 {:foo 3 :baz 400}} 796 | {:0 {:foo 3 :bar 40} :1 {:foo 3 :baz 300}} 797 | {:0 {:foo 3 :bar 40} :1 {:foo 3 :baz 400}} 798 | {:0 {:foo 4 :bar 40}}] 799 | ovs))))) 800 | ) 801 | --------------------------------------------------------------------------------