├── test └── manifold_cljs │ ├── test_util.clj │ ├── test_util.cljs │ ├── stream │ └── seq_test.cljs │ ├── executor_test.cljs │ ├── bus_test.cljs │ ├── deferred_test.cljs │ └── stream_test.cljs ├── vendor ├── deps.cljs └── _weakmap │ ├── externs.js │ └── weakmap.js ├── .gitignore ├── examples └── src │ ├── index.html │ └── manifold_test │ ├── main.cljs │ ├── daisy.cljs │ ├── utils.cljs │ └── robpike.cljs ├── src └── manifold_cljs │ ├── impl │ ├── logging.cljs │ ├── queue.cljs │ └── list.cljs │ ├── executor.clj │ ├── utils.clj │ ├── utils.cljs │ ├── deferred │ ├── core.cljs │ ├── default_impl.clj │ └── default_impl.cljs │ ├── stream │ ├── core.cljs │ ├── seq.cljs │ ├── core.clj │ ├── graph.cljs │ └── default_impl.cljs │ ├── executor.cljs │ ├── time.cljs │ ├── deferred.clj │ ├── bus.cljs │ ├── deferred.cljs │ └── stream.cljs ├── CHANGELOG.md ├── .travis.yml ├── LICENSE └── README.md /test/manifold_cljs/test_util.clj: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.test-util) 2 | 3 | (defmacro later [& body] 4 | `(later* (fn [] ~@body))) 5 | -------------------------------------------------------------------------------- /vendor/deps.cljs: -------------------------------------------------------------------------------- 1 | {:foreign-libs 2 | [{:file "_weakmap/weakmap.js" 3 | :provides ["org.weakmap"]}] 4 | :externs ["_weakmap/externs.js"]} 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-history 10 | /.nrepl-port 11 | .hgignore 12 | .hg/ 13 | -------------------------------------------------------------------------------- /examples/src/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 |

Manifold-cljs examples

6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /vendor/_weakmap/externs.js: -------------------------------------------------------------------------------- 1 | /** 2 | * @constructor 3 | */ 4 | var WeakMap = function() {}; 5 | 6 | WeakMap.prototype.get = function() {}; 7 | WeakMap.prototype.set = function() {}; 8 | WeakMap.prototype.delete = function() {}; 9 | -------------------------------------------------------------------------------- /src/manifold_cljs/impl/logging.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.impl.logging) 2 | 3 | ;; TODO: pretty console logging? 4 | 5 | (defn error 6 | ([msg] (println "ERROR:" msg)) 7 | ([err msg] (println "ERROR:" err msg))) 8 | 9 | (defn warn 10 | ([msg] (println "WARN:" msg))) 11 | -------------------------------------------------------------------------------- /src/manifold_cljs/executor.clj: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.executor) 2 | 3 | (defmacro with-executor [executor & body] 4 | `(let [executor# (executor)] 5 | (set! current-executor ~executor) 6 | (try 7 | ~@body 8 | (finally 9 | (set! current-executor executor#))))) 10 | -------------------------------------------------------------------------------- /src/manifold_cljs/impl/queue.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.impl.queue 2 | (:refer-clojure :exclude [empty? pop])) 3 | 4 | (defn queue [] 5 | (array)) 6 | 7 | (defn offer [q e] 8 | (.push q e)) 9 | 10 | (defn poll [q] 11 | (.shift q)) 12 | 13 | (defn pop [q] 14 | (.pop q)) 15 | 16 | (defn size [q] 17 | (count q)) 18 | 19 | (defn empty? [q] 20 | (zero? (count q))) 21 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | All notable changes to this project will be documented in this file. This 3 | change log follows the conventions of 4 | [keepachangelog.com](http://keepachangelog.com/). 5 | 6 | ## [Unreleased] 7 | 8 | ## 0.1.6-0 - 2016-12-07 9 | ### Added 10 | - Initial implementation, tracking Manifold 0.1.6 11 | 12 | [Unreleased]: https://github.com/dm3/manifold-cljs/compare/0.1.0...HEAD 13 | -------------------------------------------------------------------------------- /src/manifold_cljs/impl/list.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.impl.list 2 | (:refer-clojure :exclude [remove list])) 3 | 4 | (defn list [] 5 | (array)) 6 | 7 | (defn remove [l item] 8 | (let [s (.-length l)] 9 | (loop [idx 0] 10 | (when (< idx s) 11 | (if (identical? item (aget l idx)) 12 | (.splice l idx 1)) 13 | (recur (inc idx)))))) 14 | 15 | (defn size [l] 16 | (.-length l)) 17 | 18 | (defn add [l item] 19 | (.push l item)) 20 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | language: java 3 | script: boot test -j phantom && boot test -j node 4 | install: 5 | - mkdir -p ~/bin 6 | - export PATH=~/bin:$PATH 7 | - curl -L https://github.com/boot-clj/boot-bin/releases/download/latest/boot.sh -o ~/bin/boot 8 | - chmod +x ~/bin/boot 9 | env: 10 | - BOOT_VERSION=2.7.1 BOOT_CLOJURE_VERSION=1.8.0 11 | jdk: 12 | - oraclejdk8 13 | cache: 14 | directories: 15 | - $HOME/.m2 16 | - $HOME/.boot/cache/bin 17 | - $HOME/.boot/cache/lib 18 | - $HOME/bin 19 | -------------------------------------------------------------------------------- /src/manifold_cljs/utils.clj: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.utils 2 | (:require [manifold-cljs.executor :as ex])) 3 | 4 | (defn- if-cljs [env then else] 5 | (if (:ns env) then else)) 6 | 7 | (defmacro kw-identical? [a b] 8 | (if-cljs &env 9 | `(cljs.core/keyword-identical? ~a ~b) 10 | `(identical? ~a ~b))) 11 | 12 | (defmacro future-with [executor & body] 13 | ;; TODO: simulate var bindings using 14 | ;; https://github.com/hoplon/hoplon/blob/master/src/hoplon/binding.cljs 15 | ;; ? 16 | `(ex/execute ~executor (fn [] ~@body))) 17 | -------------------------------------------------------------------------------- /src/manifold_cljs/utils.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.utils 2 | (:require [manifold-cljs.impl.queue :as q] 3 | [manifold-cljs.executor :as ex] 4 | [manifold-cljs.impl.logging :as log]) 5 | (:require-macros [manifold-cljs.utils :as u])) 6 | 7 | (def ^:private integer-max-value 8 | ;; equal to Number.MAX_SAFE_INTEGER 9 | ;; copied here for better compatibility 10 | 9007199254740991) 11 | 12 | ;; - remove type annotation 13 | ;; - .queue methods -> queue ns 14 | ;; - Throwable -> js/Error 15 | ;; - runs on next tick 16 | (defn invoke-callbacks [callbacks] 17 | (ex/execute-on-next-tick 18 | (fn [] 19 | (loop [] 20 | (when-let [c (q/poll callbacks)] 21 | (try 22 | (c) 23 | (catch js/Error e 24 | (log/error e "error in invoke-callbacks"))) 25 | (recur)))))) 26 | -------------------------------------------------------------------------------- /test/manifold_cljs/test_util.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.test-util 2 | (:require [manifold-cljs.deferred :as d]) 3 | (:require-macros [manifold-cljs.test-util])) 4 | 5 | (defn unrealized? [d] 6 | (not (d/realized? d))) 7 | 8 | (defn later* [f] 9 | (js/setTimeout f 0)) 10 | 11 | (defn capture-success [d] 12 | (let [a (atom nil)] 13 | (d/on-realized d 14 | #(do (reset! a %) true) 15 | #(println "Expected success, got error:" % "!")) 16 | a)) 17 | 18 | (defn capture-error 19 | ([result] 20 | (capture-error result true)) 21 | ([result expected-return-value] 22 | (let [a (atom nil)] 23 | (d/on-realized result 24 | #(println "Expected error, got success:" % "!") 25 | #(do (reset! a %) expected-return-value)) 26 | a))) 27 | 28 | (defn no-success? [d] 29 | (= ::none (d/success-value d ::none))) 30 | -------------------------------------------------------------------------------- /test/manifold_cljs/stream/seq_test.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream.seq-test 2 | (:require [manifold-cljs.stream :as s] 3 | [manifold-cljs.stream.core :as core] 4 | [manifold-cljs.deferred :as d] 5 | [manifold-cljs.test-util :refer [later]] 6 | [cljs.test :refer [deftest testing is async]] 7 | 8 | [manifold-cljs.stream.seq :as sq])) 9 | 10 | (deftest seq-stream 11 | (testing "lazy ok" 12 | (let [c (range 2) 13 | src (sq/to-source c)] 14 | (is (= 0 @(s/take! src))) 15 | (is (= 1 @(s/take! src))) 16 | (is (nil? @(s/take! src))) 17 | (is (s/drained? src)))) 18 | 19 | (testing "lazy failing" 20 | (let [c (filter #(throw (js/Error.)) (range 100)) 21 | src (sq/to-source c)] 22 | (is (= ::fail @(s/take! src ::fail))) 23 | (is (s/drained? src)))) 24 | 25 | (testing "eager" 26 | (let [c [0 1] 27 | src (sq/to-source c)] 28 | (is (= 0 @(s/take! src))) 29 | (is (= 1 @(s/take! src))) 30 | (is (nil? @(s/take! src))) 31 | (is (s/drained? src))))) 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | Copyright (c) 2016 Vadim Platonov, Zach Tellman 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy of 5 | this software and associated documentation files (the "Software"), to deal in 6 | the Software without restriction, including without limitation the rights to 7 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies 8 | of the Software, and to permit persons to whom the Software is furnished to do 9 | so, subject to the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be included in all 12 | copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 19 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 20 | SOFTWARE. 21 | -------------------------------------------------------------------------------- /src/manifold_cljs/deferred/core.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.deferred.core) 2 | 3 | ;; moved from manifold.deferred 4 | 5 | ;; - definterface -> defprotocol 6 | (defprotocol IDeferred 7 | (executor [this]) 8 | (^boolean realized [this]) 9 | (onRealized [this on-success on-error]) 10 | (successValue [this default]) 11 | (errorValue [this default])) 12 | 13 | ;; - interface -> protocol 14 | (defprotocol IMutableDeferred 15 | (success 16 | [this x] 17 | [this x claim-token]) 18 | (error 19 | [this x] 20 | [this x claim-token]) 21 | (claim [this]) 22 | (addListener [this listener]) 23 | (cancelListener [this listener])) 24 | 25 | ;; - interface -> protocol 26 | (defprotocol IDeferredListener 27 | (onSuccess [this x]) 28 | (onError [this err])) 29 | 30 | ;; - no equals/hashCode 31 | (deftype Listener [on-success on-error] 32 | IDeferredListener 33 | (onSuccess [_ x] (on-success x)) 34 | (onError [_ err] (on-error err))) 35 | 36 | ;; - definiline -> defn 37 | (defn listener 38 | "Creates a listener which can be registered or cancelled via `add-listener!` and `cancel-listener!`." 39 | ([on-success] 40 | (listener on-success (fn [_]))) 41 | ([on-success on-error] 42 | (Listener. on-success on-error))) 43 | -------------------------------------------------------------------------------- /examples/src/manifold_test/main.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-test.main 2 | (:require [manifold-cljs.deferred :as d] 3 | [manifold-test.daisy :as daisy] 4 | [manifold-test.robpike :as robpike] 5 | [manifold-test.utils :as utils] 6 | 7 | [manifold-cljs.stream :as s] 8 | [manifold-cljs.deferred :as d] 9 | [manifold-cljs.time :as t])) 10 | 11 | (enable-console-print!) 12 | 13 | (defn robpike [] 14 | (println "[MANIFOLD] Running robpike...") 15 | (robpike/run-manifold) 16 | (println "[CORE.ASY] Running robpike...") 17 | (robpike/run-async)) 18 | 19 | (defn daisy [] 20 | (println "[MANIFOLD] Running daisy...") 21 | (daisy/run-manifold) 22 | (println "[CORE.ASY] Running daisy...") 23 | (daisy/run-async)) 24 | 25 | (defn clicks [stop-in-ms debounce-ms] 26 | (println "Starting click stream...") 27 | (let [click-stream (-> (utils/event-stream js/window "click" 0) 28 | (utils/debounce debounce-ms))] 29 | (t/in stop-in-ms #(do (println "Stopping click stream...") 30 | (s/close! click-stream))) 31 | (s/consume #(println "Clicked: " %) click-stream) 32 | (s/on-drained click-stream 33 | #(println "Click stream stopped!")) 34 | click-stream)) 35 | -------------------------------------------------------------------------------- /examples/src/manifold_test/daisy.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-test.daisy 2 | (:require [cljs.core.async :refer [chan !]] 3 | [manifold-cljs.stream :as s] 4 | [manifold-cljs.deferred :as d]) 5 | (:require-macros [cljs.core.async.macros :refer [go]])) 6 | 7 | (defn run-async [] 8 | (let [f #(go (>! %1 (inc (! rightmost 1) 18 | (.log js/console ( (s/put! rightmost 1) 30 | (d/chain 31 | (fn [_] (s/take! leftmost)) 32 | (fn [result] 33 | (.log js/console result))))))) 34 | -------------------------------------------------------------------------------- /test/manifold_cljs/executor_test.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.executor-test 2 | (:require [manifold-cljs.executor :as ex] 3 | [manifold-cljs.test-util :refer [later]] 4 | [cljs.test :refer [deftest testing is async]])) 5 | 6 | (deftest test-executor-timeout 7 | (async done 8 | (let [a (atom nil) 9 | e (ex/timeout-executor 50)] 10 | (ex/execute e #(reset! a ::done)) 11 | (is (not @a)) 12 | (later 13 | (is (not @a)) 14 | (js/setTimeout 15 | (fn [] 16 | (is (= ::done @a)) 17 | (done)) 18 | 80))))) 19 | 20 | (deftest test-executor-next-tick 21 | (async done 22 | (let [a (atom nil) 23 | e (ex/next-tick-executor)] 24 | (ex/execute e #(reset! a ::done)) 25 | (is (not @a)) 26 | (later 27 | (is (= ::done @a)) 28 | (done))))) 29 | 30 | (deftest test-executor-sync 31 | (let [a (atom nil) 32 | e (ex/sync-executor)] 33 | (ex/execute e #(reset! a ::done)) 34 | (is (= ::done @a)))) 35 | 36 | (deftest with-executor-test 37 | (let [e (ex/sync-executor)] 38 | (is (not= (ex/executor) e)) 39 | (ex/with-executor e 40 | (is (= (ex/executor) e))) 41 | (is (not= (ex/executor) e)))) 42 | -------------------------------------------------------------------------------- /vendor/_weakmap/weakmap.js: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 2012 The Polymer Authors. All rights reserved. 3 | * Use of this source code is governed by a BSD-style 4 | * license that can be found in the LICENSE file. 5 | */ 6 | 7 | if (typeof WeakMap === 'undefined') { 8 | (function() { 9 | var defineProperty = Object.defineProperty; 10 | var counter = Date.now() % 1e9; 11 | 12 | var WeakMap = function() { 13 | this.name = '__st' + (Math.random() * 1e9 >>> 0) + (counter++ + '__'); 14 | }; 15 | 16 | WeakMap.prototype = { 17 | set: function(key, value) { 18 | var entry = key[this.name]; 19 | if (entry && entry[0] === key) 20 | entry[1] = value; 21 | else 22 | defineProperty(key, this.name, {value: [key, value], writable: true}); 23 | return this; 24 | }, 25 | get: function(key) { 26 | var entry; 27 | return (entry = key[this.name]) && entry[0] === key ? 28 | entry[1] : undefined; 29 | }, 30 | delete: function(key) { 31 | var entry = key[this.name]; 32 | if (!entry) return false; 33 | var hasValue = entry[0] === key; 34 | entry[0] = entry[1] = undefined; 35 | return hasValue; 36 | }, 37 | has: function(key) { 38 | var entry = key[this.name]; 39 | if (!entry) return false; 40 | return entry[0] === key; 41 | } 42 | }; 43 | 44 | window.WeakMap = WeakMap; 45 | })(); 46 | } 47 | -------------------------------------------------------------------------------- /examples/src/manifold_test/utils.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-test.utils 2 | (:require [manifold-cljs.stream :as s] 3 | [manifold-cljs.deferred :as d] 4 | [manifold-cljs.time :as t])) 5 | 6 | (defn event-stream [el event-type buffer-size] 7 | (let [s (s/stream buffer-size) 8 | skip? (atom false) 9 | cb (fn [e] 10 | (when-not @skip? 11 | (-> (s/put! s e) 12 | (d/chain (fn [_] (reset! skip? false))))))] 13 | (.addEventListener el event-type cb) 14 | (s/on-closed s #(.removeEventListener el event-type cb)) 15 | s)) 16 | 17 | (defn debounce [src period-ms] 18 | (let [dst (s/stream)] 19 | 20 | (d/loop [state ::ready, wait-ms 0] 21 | (let [start (t/current-millis)] 22 | (-> (s/take! src ::done) 23 | (d/chain 24 | (fn [v] 25 | (if (= ::done v) 26 | (do (s/close! dst) false) 27 | (if (= ::ready state) 28 | (s/put! dst v) 29 | true))) 30 | (fn [result] 31 | (if result 32 | (let [passed (- (t/current-millis) start) 33 | [next-state next-wait] 34 | (if (= ::ready state) 35 | [::waiting period-ms] 36 | (if (>= passed wait-ms) 37 | [::ready 0]))] 38 | (d/recur next-state next-wait)))))))) 39 | 40 | (s/source-only dst))) 41 | -------------------------------------------------------------------------------- /src/manifold_cljs/stream/core.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream.core 2 | (:refer-clojure :exclude [take]) 3 | (:require-macros [manifold-cljs.stream.core])) 4 | 5 | (defprotocol Sinkable 6 | (to-sink [_] "Provides a conversion mechanism to Manifold sinks.")) 7 | 8 | (defprotocol Sourceable 9 | (to-source [_] "Provides a conversion mechanism to Manifold source.")) 10 | 11 | ;; same as clj except 12 | ;; - definterface -> defprotocol 13 | (defprotocol IEventStream 14 | (description [_]) 15 | (isSynchronous [_]) 16 | (downstream [_]) 17 | (weakHandle [_ reference-queue]) 18 | (close [_])) 19 | 20 | ;; same as clj except 21 | ;; - definterface -> defprotocol 22 | (defprotocol IEventSink 23 | (put [_ x blocking?] 24 | [_ x blocking? timeout timeout-val]) 25 | (markClosed [_]) 26 | (isClosed [_]) 27 | (onClosed [_ callback])) 28 | 29 | ;; - definterface -> defprotocol 30 | (defprotocol IEventSource 31 | (take [_ default-val blocking?] 32 | [_ default-val blocking? timeout timeout-val]) 33 | (markDrained [_]) 34 | (isDrained [_]) 35 | (onDrained [_ callback]) 36 | (connector [_ sink])) 37 | 38 | ;; - definline -> defn 39 | (defn close! 40 | "Closes an event sink, so that it can't accept any more messages." 41 | [sink] (close sink)) 42 | 43 | ;; - definline -> defn 44 | (defn closed? 45 | "Returns true if the event sink is closed." 46 | [sink] (isClosed sink)) 47 | 48 | ;; - definline -> defn 49 | (defn drained? 50 | "Returns true if the event source is drained." 51 | [source] (isDrained source)) 52 | 53 | ;; - definline -> defn 54 | (defn weak-handle 55 | "Returns a weak reference that can be used to construct topologies of streams." 56 | [x] (weakHandle x nil)) 57 | 58 | ;; - definline -> defn 59 | ;; TODO: change docstring? Will this always be false in Cljs? 60 | (defn synchronous? 61 | "Returns true if the underlying abstraction behaves synchronously, using thread blocking 62 | to provide backpressure." 63 | [x] (isSynchronous x)) 64 | -------------------------------------------------------------------------------- /src/manifold_cljs/deferred/default_impl.clj: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.deferred.default-impl 2 | (:require [manifold-cljs.utils :refer [kw-identical?]])) 3 | 4 | ;; Throwable -> js/Error 5 | ;; identical? -> keyword-identical? 6 | ;; .poll -> q/poll 7 | ;; .onSuccess/.onError -> core/onSuccess core/onError 8 | ;; removed lock 9 | ;; IllegalStateException -> ex-info 10 | (defmacro set-deferred [val token success? claimed? executor] 11 | `(if (when (and 12 | (kw-identical? ~(if claimed? ::claimed ::unset) ~'state) 13 | ~@(when claimed? 14 | `((identical? ~'claim-token ~token)))) 15 | (set! ~'val ~val) 16 | (set! ~'state ~(if success? ::success ::error)) 17 | true) 18 | (do 19 | (clojure.core/loop [] 20 | (when-let [l# (q/poll ~'listeners)] 21 | (try 22 | (if (nil? ~executor) 23 | (~(if success? `core/onSuccess `core/onError) l# ~val) 24 | (ex/execute ~executor 25 | (fn [] 26 | (try 27 | (~(if success? `core/onSuccess `core/onError) l# ~val) 28 | (catch js/Error e# 29 | (log/error e# "error in deferred handler")))))) 30 | (catch js/Error e# 31 | (log/error e# "error in deferred handler"))) 32 | (recur))) 33 | true) 34 | ~(if claimed? 35 | `(throw (ex-info 36 | (if (identical? ~'claim-token ~token) 37 | "deferred isn't claimed" 38 | "invalid claim-token") 39 | {:claim-token ~'claim-token, :token ~token})) 40 | false))) 41 | 42 | ;; removed timeout version 43 | ;; Throwable -> jsError 44 | (defmacro deref-deferred [] 45 | `(if (kw-identical? ~'state ::success) 46 | ~'val 47 | (if (kw-identical? ~'state ::error) 48 | (if (instance? js/Error ~'val) 49 | (throw ~'val) 50 | (throw (ex-info "" {:error ~'val}))) 51 | (throw (ex-info "invalid state" {:state ~'state}))))) 52 | -------------------------------------------------------------------------------- /src/manifold_cljs/stream/seq.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream.seq 2 | (:require [manifold-cljs.impl.logging :as log] 3 | [manifold-cljs.deferred :as d] 4 | [manifold-cljs.utils :as utils] 5 | [manifold-cljs.stream.core :as s] 6 | [manifold-cljs.stream.graph :as g] 7 | [manifold-cljs.time :as time])) 8 | 9 | ;; - AtomicReference -> atom 10 | ;; - isSynchronous - always false 11 | ;; - close - there is no java.io.Closeable analog in Clojurescript 12 | ;; - removed Pending checks 13 | ;; - removed blocking? branch 14 | (s/def-source SeqSource 15 | [s-ref] 16 | 17 | :stream 18 | [(isSynchronous [_] false) 19 | 20 | (close [_]) 21 | 22 | (description [this] 23 | (merge 24 | {:type "seq" 25 | :drained? (s/drained? this)} 26 | (let [s @s-ref] 27 | (when (counted? s) 28 | {:count (count s)}))))] 29 | 30 | :source 31 | [(take [this default-val blocking?] 32 | (let [s @s-ref 33 | v (try 34 | (if (empty? s) 35 | (do 36 | (s/markDrained this) 37 | default-val) 38 | (let [x (first s)] 39 | (swap! s-ref rest) 40 | x)) 41 | (catch js/Error e 42 | (log/error e "error in seq stream") 43 | (s/markDrained this) 44 | default-val))] 45 | (d/success-deferred v))) 46 | 47 | (take [this default-val blocking? timeout timeout-val] 48 | (if (nil? timeout) 49 | (s/take this blocking? default-val) 50 | (-> (s/take this false default-val) 51 | (d/timeout! timeout timeout-val))))]) 52 | 53 | ;; ISeq and ISeqable are protocols in Cljs, so no way to extend them to ISourceable 54 | (defn seq-source? [s] 55 | (or (seq? s) (seqable? s))) 56 | 57 | (defn to-source [s] 58 | (let [s' (cond (seq? s) s 59 | (seqable? s) (seq s) 60 | :else (throw (ex-info (str "Can't create a SeqSource from " (type s)) 61 | {:s s})))] 62 | (->SeqSource (atom s')))) 63 | -------------------------------------------------------------------------------- /test/manifold_cljs/bus_test.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.bus-test 2 | (:require [manifold-cljs.stream :as s] 3 | [manifold-cljs.stream.core :as core] 4 | [manifold-cljs.deferred :as d] 5 | [manifold-cljs.bus :as b] 6 | [manifold-cljs.test-util :refer [later unrealized?]] 7 | [cljs.test :refer [deftest testing is async]])) 8 | 9 | (deftest test-bus-default 10 | (async done 11 | (testing "doesn't put without subscribers" 12 | (let [b (b/event-bus) 13 | p1 (b/publish! b :test "hi 1")] 14 | (is (not (b/active? b :test))) 15 | (is (nil? (b/downstream b :test))) 16 | (is (false? @p1)) 17 | 18 | (testing "puts with a single subscriber" 19 | (let [s1 (b/subscribe b :test) 20 | p2 (b/publish! b :test "hi 2")] 21 | (is (b/active? b :test)) 22 | (is (= 1 (count (b/downstream b :test)))) 23 | (is (unrealized? p2)) 24 | (is (= "hi 2" @(s/take! s1))) 25 | (later 26 | (is (true? @p2)) 27 | 28 | (testing "two subscribers on same topic" 29 | (let [s2 (b/subscribe b :test) 30 | p3 (b/publish! b :test "hi 3")] 31 | (is (= 2 (count (b/downstream b :test)))) 32 | (is (= "hi 3" @(s/take! s1))) 33 | (is (= "hi 3" @(s/take! s2))) 34 | (is (unrealized? p3)) 35 | (later 36 | (is (true? @p3)) 37 | 38 | (testing "another subscription isn't active" 39 | (is (not (b/active? b :another)))) 40 | 41 | (testing "removes subscriptions on stream close" 42 | (s/close! s1) 43 | (s/close! s2) 44 | ;; still active as on-closed will run in a later task 45 | (is (b/active? b :test)) 46 | (later 47 | (is (not (b/active? b :test))) 48 | (done))))))))))))) 49 | -------------------------------------------------------------------------------- /src/manifold_cljs/executor.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.executor 2 | (:require [goog.async.nextTick]) 3 | (:require-macros [manifold-cljs.executor])) 4 | 5 | (defprotocol Executor 6 | (execute [_ f])) 7 | 8 | (def ^:private sync-executor-instance 9 | (reify Executor 10 | (execute [_ f] 11 | (f)))) 12 | 13 | (defn sync-executor [] sync-executor-instance) 14 | 15 | (defn timeout-executor [timeout-ms] 16 | (reify Executor 17 | (execute [_ f] 18 | (js/setTimeout f timeout-ms)))) 19 | 20 | (defn- node? [] (= cljs.core/*target* "nodejs")) 21 | 22 | (def ^:private next-tick-executor-instance 23 | (if (node?) 24 | (reify Executor 25 | (execute [_ f] 26 | (.nextTick js/process f))) 27 | (reify Executor 28 | (execute [_ f] 29 | (goog.async.nextTick f))))) 30 | 31 | (declare ^:private process-batched) 32 | 33 | (defn batched-executor [underlying-executor batch-size] 34 | ;; straightforward adaptation of core.async default dispatcher 35 | (let [buffer (array) , running? (volatile! false), queued? (volatile! false)] 36 | (letfn [(enqueue [] 37 | (when-not (and @queued? @running?) 38 | (vreset! queued? true) 39 | (execute underlying-executor process))) 40 | (process [] 41 | (vreset! running? true) 42 | (vreset! queued? false) 43 | (loop [i 0] 44 | (when-let [f (.pop buffer)] 45 | (f) 46 | (when (< i batch-size) 47 | (recur (inc i))))) 48 | (vreset! running? false) 49 | (when (> (.-length buffer) 0) 50 | (enqueue)))] 51 | (reify Executor 52 | (execute [_ f] 53 | (.unshift buffer f) 54 | (enqueue)))))) 55 | 56 | (defn execute-on-next-tick [f] 57 | (execute next-tick-executor-instance f)) 58 | 59 | (defn next-tick-executor [] next-tick-executor-instance) 60 | 61 | ;; different to Clj - use batched next-tick by default 62 | ;; there's no default executor in Clj - field is nil 63 | (def default-executor 64 | ;; buffer size same as core.async 65 | (batched-executor next-tick-executor-instance 1024)) 66 | 67 | ;; for with-executor binding 68 | (def ^:private ^:mutable current-executor 69 | default-executor) 70 | 71 | (defn executor [] 72 | current-executor) 73 | -------------------------------------------------------------------------------- /examples/src/manifold_test/robpike.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-test.robpike 2 | (:require [cljs.core.async :as async :refer [! chan close! timeout]] 3 | [manifold-cljs.stream :as s] 4 | [manifold-cljs.deferred :as d]) 5 | (:require-macros [cljs.core.async.macros :as m :refer [go alt!]])) 6 | 7 | (defn run-async [] 8 | (let [fake-search (fn [kind] 9 | (fn [c query] 10 | (go 11 | (! c [kind query])))) 13 | web1 (fake-search :web1) 14 | web2 (fake-search :web2) 15 | image1 (fake-search :image1) 16 | image2 (fake-search :image2) 17 | video1 (fake-search :video1) 18 | video2 (fake-search :video2) 19 | 20 | fastest (fn [query & replicas] 21 | (let [c (chan)] 22 | (doseq [replica replicas] 23 | (replica c query)) 24 | c)) 25 | 26 | google (fn [query] 27 | (let [c (chan) 28 | t (timeout 80)] 29 | (go (>! c (! c (! c ( (d/deferred) 43 | (d/timeout! (rand-int 100) [kind query])))) 44 | 45 | web1 (fake-search :web1) 46 | web2 (fake-search :web2) 47 | image1 (fake-search :image1) 48 | image2 (fake-search :image2) 49 | video1 (fake-search :video1) 50 | video2 (fake-search :video2) 51 | 52 | fastest (fn [query & replicas] 53 | (->> (map #(% query) replicas) 54 | (apply d/alt))) 55 | 56 | google (fn [query] 57 | (let [timeout #(d/timeout! % 80 nil) 58 | web (fastest query web1 web2) 59 | image (fastest query image1 image2) 60 | video (fastest query video1 video2)] 61 | (->> (map timeout [web image video]) 62 | (apply d/zip))))] 63 | 64 | (d/chain (google "clojure") println))) 65 | -------------------------------------------------------------------------------- /src/manifold_cljs/time.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.time 2 | (:require [manifold-cljs.deferred.default-impl :as d] 3 | [manifold-cljs.executor :as ex] 4 | [manifold-cljs.deferred.core :as core])) 5 | 6 | ;; Differences from Clojure impl: 7 | ;; - no Clock abstraction 8 | ;; - no `format-duration` 9 | ;; - no `add` 10 | 11 | ;; cljs specific 12 | (defn current-millis [] 13 | (.getTime (js/Date.))) 14 | 15 | ;; same as clj 16 | (defn nanoseconds 17 | "Converts nanoseconds -> milliseconds" 18 | [n] 19 | (/ n 1e6)) 20 | 21 | ;; same as clj 22 | (defn microseconds 23 | "Converts microseconds -> milliseconds" 24 | [n] 25 | (/ n 1e3)) 26 | 27 | ;; same as clj 28 | (defn milliseconds 29 | "Converts milliseconds -> milliseconds" 30 | [n] 31 | n) 32 | 33 | ;; same as clj 34 | (defn seconds 35 | "Converts seconds -> milliseconds" 36 | [n] 37 | (* n 1e3)) 38 | 39 | ;; same as clj 40 | (defn minutes 41 | "Converts minutes -> milliseconds" 42 | [n] 43 | (* n 6e4)) 44 | 45 | ;; same as clj 46 | (defn hours 47 | "Converts hours -> milliseconds" 48 | [n] 49 | (* n 36e5)) 50 | 51 | ;; same as clj 52 | (defn days 53 | "Converts days -> milliseconds" 54 | [n] 55 | (* n 864e5)) 56 | 57 | ;; same as clj 58 | (defn hz 59 | "Converts frequency -> period in milliseconds" 60 | [n] 61 | (/ 1e3 n)) 62 | 63 | ;; - Throwable -> js/Error 64 | (defn in 65 | "Schedules no-arg function `f` to be invoked in `interval` milliseconds. Returns a deferred 66 | representing the returned value of the function." 67 | [^double interval f] 68 | (let [d (d/deferred (ex/executor)) 69 | f (fn [] 70 | (try 71 | (core/success d (f)) 72 | (catch js/Error e 73 | (core/error d e))))] 74 | (js/setTimeout f interval) 75 | d)) 76 | 77 | (defn every 78 | "Schedules no-arg function `f` to be invoked every `period` milliseconds, after `initial-delay` 79 | milliseconds, which defaults to `0`. Returns a zero-argument function which, when invoked, 80 | cancels the repeated invocation. 81 | 82 | If the invocation of `f` ever throws an exception, repeated invocation is automatically 83 | cancelled." 84 | ([period-ms f] 85 | (every period-ms 0 f)) 86 | ([period-ms initial-delay-ms f] 87 | (let [continue? (atom true) 88 | stop-f #(reset! continue? false)] 89 | (js/setTimeout 90 | (fn this [] 91 | (when @continue? 92 | (f) 93 | (js/setTimeout this period-ms))) 94 | initial-delay-ms) 95 | stop-f))) 96 | 97 | (defn at 98 | "Schedules no-arg function `f` to be invoked at `timestamp`, which is the milliseconds 99 | since the epoch. Returns a deferred representing the returned value of the function." 100 | [timestamp f] 101 | (in (max 0 (- timestamp (current-millis))) f)) 102 | -------------------------------------------------------------------------------- /src/manifold_cljs/deferred.clj: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.deferred 2 | (:refer-clojure :exclude [loop future time]) 3 | (:require [manifold-cljs.utils :as u] 4 | [manifold-cljs.executor :as ex] 5 | [clojure.set :as sets])) 6 | 7 | ;; completely different from clj 8 | (defmacro future-with [executor & body] 9 | `(let [d# (deferred)] 10 | (manifold-cljs.utils/future-with ~executor 11 | (when-not (realized? d#) 12 | (try 13 | (success! d# (do ~@body)) 14 | (catch js/Error e# 15 | (error! d# e#))))) 16 | d#)) 17 | 18 | ;; completely different from clj 19 | (defmacro future [& body] 20 | `(future-with (ex/next-tick-executor) ~@body)) 21 | 22 | ;; - identical? -> keyword-identical? 23 | (defmacro ^:no-doc success-error-unrealized 24 | [deferred 25 | success-value 26 | success-clause 27 | error-value 28 | error-clause 29 | unrealized-clause] 30 | `(let [d# ~deferred 31 | ~success-value (success-value d# ::none)] 32 | (if (cljs.core/keyword-identical? ::none ~success-value) 33 | (let [~error-value (error-value d# ::none)] 34 | (if (cljs.core/keyword-identical? ::none ~error-value) 35 | ~unrealized-clause 36 | ~error-clause)) 37 | ~success-clause))) 38 | 39 | ;; - Throwable -> js/Error 40 | (defmacro loop 41 | "A version of Clojure's loop which allows for asynchronous loops, via `manifold.deferred/recur`. 42 | `loop` will always return a deferred value, even if the body is synchronous. Note that `loop` does **not** coerce values to deferreds, actual Manifold deferreds must be used. 43 | 44 | (loop [i 1e6] 45 | (chain (future i) 46 | #(if (zero? %) 47 | % 48 | (recur (dec %)))))" 49 | [bindings & body] 50 | (let [vars (->> bindings (partition 2) (map first)) 51 | vals (->> bindings (partition 2) (map second)) 52 | x-sym (gensym "x") 53 | val-sym (gensym "val") 54 | var-syms (map (fn [_] (gensym "var")) vars)] 55 | `(let [result# (deferred)] 56 | ((fn this# [result# ~@var-syms] 57 | (clojure.core/loop 58 | [~@(interleave vars var-syms)] 59 | (let [~x-sym (try 60 | ~@body 61 | (catch js/Error e# 62 | (error! result# e#) 63 | nil))] 64 | (cond 65 | 66 | (deferred? ~x-sym) 67 | (success-error-unrealized ~x-sym 68 | ~val-sym (if (instance? Recur ~val-sym) 69 | (let [~val-sym @~val-sym] 70 | (~'recur 71 | ~@(map 72 | (fn [n] `(nth ~val-sym ~n)) 73 | (range (count vars))))) 74 | (success! result# ~val-sym)) 75 | 76 | err# (error! result# err#) 77 | 78 | (on-realized (chain' ~x-sym) 79 | (fn [x#] 80 | (if (instance? Recur x#) 81 | (apply this# result# @x#) 82 | (success! result# x#))) 83 | (fn [err#] 84 | (error! result# err#)))) 85 | 86 | (instance? Recur ~x-sym) 87 | (~'recur 88 | ~@(map 89 | (fn [n] `(nth @~x-sym ~n)) 90 | (range (count vars)))) 91 | 92 | :else 93 | (success! result# ~x-sym))))) 94 | result# 95 | ~@vals) 96 | result#))) 97 | 98 | ;; cljs specific 99 | (defmacro time [& body] 100 | `(time* (fn [] ~@body))) 101 | 102 | ;; TODO: let-flow 103 | -------------------------------------------------------------------------------- /src/manifold_cljs/bus.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.bus 2 | "An implementation of an event bus, where publishers and subscribers can interact via topics." 3 | (:require [manifold-cljs.stream :as s] 4 | [manifold-cljs.deferred :as d])) 5 | 6 | ;; - interface -> protocol 7 | (defprotocol IEventBus 8 | (snapshot [this]) 9 | ;; - removed definline under the same name 10 | (subscribe [this topic] 11 | "Returns a stream which consumes all messages from `topic`.") 12 | ;; - removed definline under the same name 13 | (downstream [this topic] 14 | "Returns a list of all streams subscribed to `topic`.") 15 | (publish [this topic message]) 16 | (isActive [this topic])) 17 | 18 | ;; - definline -> defn 19 | (defn publish! 20 | "Publishes a message on the bus, returning a deferred result representing the message 21 | being accepted by all subscribers. To prevent one slow consumer from blocking all 22 | the others, use `manifold.stream/buffer`, or `manifold.stream/connect` with a timeout 23 | specified." 24 | [bus topic message] 25 | (publish bus topic message)) 26 | 27 | ;; - definline -> defn 28 | (defn active? 29 | "Returns `true` if there are any subscribers to `topic`." 30 | [bus topic] 31 | (isActive bus topic)) 32 | 33 | ;; - definline -> defn 34 | (defn topic->subscribers 35 | [bus] 36 | (snapshot bus)) 37 | 38 | ;; instead of System/arraycopy 39 | (defn- arraycopy [from a to b len] 40 | (loop [a a b b len len] 41 | (if (zero? len) 42 | to 43 | (do (aset to b (aget from a)) 44 | (recur (inc a) (inc b) (dec len)))))) 45 | 46 | ;; - Array/getLength -> alength 47 | ;; - System/arraycopy -> arraycopy 48 | (defn- conj' [ary x] 49 | (if (nil? ary) 50 | (object-array [x]) 51 | (let [len (alength ary) 52 | ary' (object-array (inc len))] 53 | (arraycopy ary 0 ary' 0 len) 54 | (aset ^objects ary' len x) 55 | ary'))) 56 | 57 | ;; - Array/getLength -> alength 58 | ;; - System/arraycopy -> arraycopy 59 | (defn- disj' [^objects ary x] 60 | (let [len (alength ary)] 61 | (if-let [idx (loop [i 0] 62 | (if (<= len i) 63 | nil 64 | (if (identical? x (aget ary i)) 65 | i 66 | (recur (inc i)))))] 67 | (let [idx (long idx)] 68 | (if (== 1 len) 69 | nil 70 | (let [ary' (object-array (dec len))] 71 | (arraycopy ary 0 ary' 0 idx) 72 | (arraycopy ary (inc idx) ary' idx (- len idx 1)) 73 | ary'))) 74 | ary))) 75 | 76 | ;; - ConcurrentHashMap -> atom 77 | ;; - removed CAS loops 78 | (defn event-bus 79 | "Returns an event bus that can be used with `publish!` and `subscribe`." 80 | ([] 81 | (event-bus s/stream)) 82 | ([stream-generator] 83 | (let [topic->subscribers (atom {})] 84 | (reify IEventBus 85 | 86 | (snapshot [_] 87 | (->> @topic->subscribers 88 | (map 89 | (fn [[topic subscribers]] 90 | [topic (into [] subscribers)])) 91 | (into {}))) 92 | 93 | (subscribe [_ topic] 94 | (let [s (stream-generator)] 95 | 96 | (let [subscribers (get @topic->subscribers topic) 97 | subscribers' (conj' subscribers s)] 98 | (swap! topic->subscribers assoc topic subscribers')) 99 | 100 | (s/on-closed s 101 | (fn [] 102 | (let [subscribers (get @topic->subscribers topic) 103 | subscribers' (disj' subscribers s)] 104 | (swap! topic->subscribers assoc topic subscribers')))) 105 | 106 | (s/source-only s))) 107 | 108 | (publish [_ topic message] 109 | (let [subscribers (get @topic->subscribers topic)] 110 | (if (nil? subscribers) 111 | (d/success-deferred false) 112 | (-> (apply d/zip' (map #(s/put! % message) subscribers)) 113 | (d/chain' (fn [_] true)))))) 114 | 115 | (downstream [_ topic] 116 | (seq (get @topic->subscribers topic))) 117 | 118 | (isActive [_ topic] 119 | (boolean (get @topic->subscribers topic))))))) 120 | -------------------------------------------------------------------------------- /src/manifold_cljs/stream/core.clj: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream.core) 2 | 3 | ;; This ns got changed somewhat as the protocol functions must follow the 4 | ;; protocol that they were defined in. It's not possible to append all the 5 | ;; functions to the `deftype` like: 6 | ;; 7 | ;; (deftype Test 8 | ;; X Y Z 9 | ;; (x [_]) 10 | ;; (y [_]) 11 | ;; (z [_])) 12 | ;; 13 | ;; has to be; 14 | ;; 15 | ;; (deftype Test 16 | ;; X (x [_]) 17 | ;; Y (y [_]) 18 | ;; Z (z [_])) 19 | 20 | 21 | ;; - removed metadata as mutable metadata not possible in Cljs 22 | (def ^:private default-stream-impls 23 | `((~'downstream [this#] (manifold-cljs.stream.graph/downstream this#)) 24 | (~'weakHandle [this# ref-queue#] 25 | ;; weak handle is used as a key in a WeakMap 26 | this#) 27 | (~'close [this#]))) 28 | 29 | (def ^:private sink-params 30 | '[^:mutable __isClosed 31 | __closedCallbacks]) 32 | 33 | ;; TODO: removed `close` impl as `close` is actually defined in IEventStream (why?) 34 | ;; this makes it mandatory to merge default-stream and default-sink bodies. 35 | ;; All sink impls which relied on autogenerated `close` will have to define the following: 36 | ;; 37 | ;; (~'close [this#] (.markClosed this#))) 38 | (def ^:private default-sink-impls 39 | `[(~'isClosed [this#] ~'__isClosed) 40 | (~'onClosed [this# callback#] 41 | (if ~'__isClosed 42 | (callback#) 43 | (.push ~'__closedCallbacks callback#))) 44 | (~'markClosed [this#] 45 | (set! ~'__isClosed true) 46 | (manifold-cljs.utils/invoke-callbacks ~'__closedCallbacks))]) 47 | 48 | (def ^:private source-params 49 | '[^:mutable __isDrained 50 | __drainedCallbacks]) 51 | 52 | (def ^:private default-source-impls 53 | `[(~'isDrained [this#] ~'__isDrained) 54 | (~'onDrained [this# callback#] 55 | (if ~'__isDrained 56 | (callback#) 57 | (.push ~'__drainedCallbacks callback#))) 58 | (~'markDrained [this#] 59 | (set! ~'__isDrained true) 60 | (manifold-cljs.utils/invoke-callbacks ~'__drainedCallbacks)) 61 | (~'connector [this# _#] nil)]) 62 | 63 | (defn- merged-body [& bodies] 64 | (let [bs (apply concat bodies)] 65 | (->> bs 66 | (map #(vector [(first %) (count (second %))] %)) 67 | (into {}) 68 | vals))) 69 | 70 | (defmacro def-source [name params & body] 71 | (let [body (->> (partition 2 body) (map vec) (into {}))] 72 | `(do 73 | (deftype ~name 74 | ~(vec (distinct (concat params source-params))) 75 | manifold-cljs.stream.core/IEventStream 76 | ~@(merged-body default-stream-impls (get body :stream)) 77 | manifold-cljs.stream.core/IEventSource 78 | ~@(merged-body default-source-impls (get body :source))) 79 | 80 | (defn ~(with-meta (symbol (str "->" name)) {:private true}) 81 | [~@(map #(with-meta % nil) params)] 82 | (new ~name ~@params false (manifold-cljs.impl.queue/queue)))))) 83 | 84 | (defmacro def-sink [name params & body] 85 | (let [body (->> (partition 2 body) (map vec) (into {}))] 86 | `(do 87 | (deftype ~name 88 | ~(vec (distinct (concat params sink-params))) 89 | manifold-cljs.stream.core/IEventStream 90 | ~@(merged-body default-stream-impls (get body :stream)) 91 | manifold-cljs.stream.core/IEventSink 92 | ~@(merged-body default-sink-impls (get body :sink))) 93 | 94 | (defn ~(with-meta (symbol (str "->" name)) {:private true}) 95 | [~@(map #(with-meta % nil) params)] 96 | (new ~name ~@params false (manifold-cljs.impl.queue/queue)))))) 97 | 98 | (defmacro def-sink+source [name params & body] 99 | (let [body (->> (partition 2 body) (map vec) (into {}))] 100 | `(do 101 | (deftype ~name 102 | ~(vec (distinct (concat params source-params sink-params))) 103 | manifold-cljs.stream.core/IEventStream 104 | ~@(merged-body default-stream-impls (get body :stream)) 105 | manifold-cljs.stream.core/IEventSink 106 | ~@(merged-body default-sink-impls (get body :sink)) 107 | manifold-cljs.stream.core/IEventSource 108 | ~@(merged-body default-source-impls (get body :source))) 109 | 110 | (defn ~(with-meta (symbol (str "->" name)) {:private true}) 111 | [~@(map #(with-meta % nil) params)] 112 | (new ~name ~@params false (manifold-cljs.impl.queue/queue) false (manifold-cljs.impl.queue/queue)))))) 113 | -------------------------------------------------------------------------------- /src/manifold_cljs/deferred/default_impl.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.deferred.default-impl 2 | (:require [manifold-cljs.executor :as ex] 3 | [manifold-cljs.impl.list :as l] 4 | [manifold-cljs.impl.queue :as q] 5 | [manifold-cljs.impl.logging :as log] 6 | [manifold-cljs.deferred.core :as core]) 7 | (:require-macros [manifold-cljs.deferred.default-impl :refer [set-deferred deref-deferred]])) 8 | 9 | (deftype Deferred 10 | [^:mutable val 11 | ^:mutable state 12 | ^:mutable claim-token 13 | listeners 14 | ^:mutable consumed? 15 | executor] 16 | 17 | core/IMutableDeferred 18 | (claim [_] 19 | (when (keyword-identical? state ::unset) 20 | (set! state ::claimed) 21 | (set! claim-token #js {})) 22 | claim-token) 23 | 24 | (addListener [_ listener] 25 | (set! consumed? true) 26 | (when-let [f (condp keyword-identical? state 27 | ::success #(core/onSuccess listener val) 28 | ::error #(core/onError listener val) 29 | (do 30 | (l/add listeners listener) 31 | nil))] 32 | (if executor 33 | (ex/execute executor f) 34 | (f))) 35 | true) 36 | 37 | (cancelListener [_ listener] 38 | (let [state state] 39 | (if (or (keyword-identical? ::unset state) 40 | (keyword-identical? ::set state)) 41 | (l/remove listeners listener) 42 | false))) 43 | 44 | (success [_ x] 45 | (set-deferred x nil true false executor)) 46 | (success [_ x token] 47 | (set-deferred x token true true executor)) 48 | (error [_ x] 49 | (set-deferred x nil false false executor)) 50 | (error [_ x token] 51 | (set-deferred x token false true executor)) 52 | 53 | IFn 54 | (-invoke [this x] 55 | (if (core/success this x) 56 | this 57 | nil)) 58 | 59 | core/IDeferred 60 | (executor [_] executor) 61 | (realized [_] 62 | (let [state state] 63 | (or (keyword-identical? ::success state) 64 | (keyword-identical? ::error state)))) 65 | (onRealized [this on-success on-error] 66 | (core/addListener this (core/listener on-success on-error))) 67 | (successValue [this default-value] 68 | (if (keyword-identical? ::success state) 69 | (do 70 | (set! consumed? true) 71 | val) 72 | default-value)) 73 | (errorValue [this default-value] 74 | (if (keyword-identical? ::error state) 75 | (do 76 | (set! consumed? true) 77 | val) 78 | default-value)) 79 | 80 | IPending 81 | (-realized? [this] (core/realized this)) 82 | 83 | IDeref 84 | (-deref [this] 85 | (set! consumed? true) 86 | (deref-deferred))) 87 | 88 | (deftype SuccessDeferred 89 | [val 90 | executor] 91 | 92 | core/IMutableDeferred 93 | (claim [_] false) 94 | (addListener [_ listener] 95 | (if (nil? executor) 96 | (core/onSuccess listener val) 97 | (ex/execute executor #(core/onSuccess listener val))) 98 | true) 99 | (cancelListener [_ listener] false) 100 | (success [_ x] false) 101 | (success [_ x token] false) 102 | (error [_ x] false) 103 | (error [_ x token] false) 104 | 105 | IFn 106 | (-invoke [this x] nil) 107 | 108 | core/IDeferred 109 | (executor [_] executor) 110 | (realized [this] true) 111 | (onRealized [this on-success on-error] 112 | (if executor 113 | (ex/execute executor #(on-success val)) 114 | (on-success val))) 115 | (successValue [_ default-value] 116 | val) 117 | (errorValue [_ default-value] 118 | default-value) 119 | 120 | IPending 121 | (-realized? [this] (core/realized this)) 122 | 123 | IDeref 124 | (-deref [this] val)) 125 | 126 | (deftype ErrorDeferred 127 | [error 128 | ^:mutable consumed? 129 | executor] 130 | 131 | core/IMutableDeferred 132 | (claim [_] false) 133 | (addListener [_ listener] 134 | (set! consumed? true) 135 | (core/onError listener error) 136 | true) 137 | (cancelListener [_ listener] false) 138 | (success [_ x] false) 139 | (success [_ x token] false) 140 | (error [_ x] false) 141 | (error [_ x token] false) 142 | 143 | IFn 144 | (-invoke [this x] nil) 145 | 146 | core/IDeferred 147 | (executor [_] executor) 148 | (realized [_] true) 149 | (onRealized [this on-success on-error] 150 | (set! consumed? true) 151 | (if (nil? executor) 152 | (on-error error) 153 | (ex/execute executor #(on-error error)))) 154 | (successValue [_ default-value] 155 | default-value) 156 | (errorValue [_ default-value] 157 | (set! consumed? true) 158 | error) 159 | 160 | IPending 161 | (-realized? [this] (core/realized this)) 162 | 163 | IDeref 164 | (-deref [this] 165 | (set! consumed? true) 166 | (if (instance? js/Error error) 167 | (throw error) 168 | (throw (ex-info "" {:error error}))))) 169 | 170 | ;; Manifold uses `nil` as the default executor. 171 | ;; Manifold-cljs uses `ex/default-executor`, so we optimize for the relevant case. 172 | (def ^:no-doc true-deferred- (SuccessDeferred. true ex/default-executor)) 173 | (def ^:no-doc false-deferred- (SuccessDeferred. false ex/default-executor)) 174 | (def ^:no-doc nil-deferred- (SuccessDeferred. nil ex/default-executor)) 175 | 176 | (defn success-deferred 177 | "A deferred which already contains a realized value" 178 | ([val] 179 | (success-deferred val (ex/executor))) 180 | ([val executor] 181 | (if (identical? executor ex/default-executor) 182 | (condp = val 183 | true true-deferred- 184 | false false-deferred- 185 | nil nil-deferred- 186 | (SuccessDeferred. val executor)) 187 | (SuccessDeferred. val executor)))) 188 | 189 | (defn error-deferred 190 | "A deferred which already contains a realized error" 191 | ([error] 192 | (ErrorDeferred. error false (ex/executor))) 193 | ([error executor] 194 | (ErrorDeferred. error false executor))) 195 | 196 | (defn deferred [executor] 197 | (Deferred. nil ::unset nil (l/list) false executor)) 198 | -------------------------------------------------------------------------------- /test/manifold_cljs/deferred_test.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.deferred-test 2 | (:require [manifold-cljs.deferred :as d] 3 | [manifold-cljs.executor :as e] 4 | [manifold-cljs.test-util :refer [later capture-success capture-error]] 5 | [cljs.test :refer [deftest testing is are async]])) 6 | 7 | (deftest test-deferred-success 8 | (async done 9 | (let [d (d/deferred)] 10 | (is (= true (d/success! d 1))) 11 | (is (= 1 @d)) 12 | 13 | (let [callback-result (capture-success d)] 14 | (later 15 | (is (= 1 @callback-result)) 16 | (done)))))) 17 | 18 | (deftest test-deferred-error 19 | (async done 20 | (let [d (d/deferred) 21 | ex (js/Error. "boom")] 22 | (is (= true (d/error! d ex))) 23 | (is (thrown? js/Error @d)) 24 | 25 | (let [callback-result (capture-error d ::ok)] 26 | (later 27 | (is (= ex @callback-result)) 28 | (done)))))) 29 | 30 | (deftest test-success-deferred-default 31 | (testing "with a default executor" 32 | 33 | (let [d1 (d/success-deferred :value) 34 | d2 (d/success-deferred :value)] 35 | (is (= (e/executor) (.-executor d1) (.-executor d2))) 36 | (is (not (identical? d1 d2))) 37 | 38 | (testing ", true/false/nil with the default executor are cached" 39 | (are [x] (identical? (d/success-deferred x) (d/success-deferred x)) 40 | true 41 | false 42 | nil)))) 43 | 44 | (testing "with a custom executor" 45 | (let [e (e/sync-executor)] 46 | (e/with-executor e 47 | 48 | (testing ", true/false/nil not cached" 49 | (are [x] (not (identical? (d/success-deferred x) 50 | (d/success-deferred x))) 51 | true 52 | false 53 | nil)) 54 | 55 | (testing ", executor is propagated" 56 | (is (= e 57 | (.-executor (d/success-deferred :value)) 58 | (.-executor (d/success-deferred true))))))))) 59 | 60 | (deftest test-chain 61 | (is (= 0 @(d/chain 0))) 62 | 63 | (is (= 1 @(d/chain 0 inc))) 64 | 65 | (is (= 1 @(d/chain 0 (constantly 1))))) 66 | 67 | (deftest test-catch-no-catch 68 | (async done 69 | (let [d (-> 0 70 | (d/chain #(throw (js/Error. "boom"))) 71 | (d/catch js/Number (constantly :foo)))] 72 | (later (is (thrown-with-msg? js/Error #"boom" @d)) 73 | (done))))) 74 | 75 | (deftest test-catch 76 | (async done 77 | (let [d (-> 0 78 | (d/chain #(throw (js/Error. "boom"))) 79 | (d/catch (constantly :foo)))] 80 | (later (is (= :foo @d)) 81 | (done))))) 82 | 83 | (deftest test-catch-non-error 84 | (async done 85 | (let [d (-> (d/error-deferred :bar) 86 | (d/catch (constantly :foo)))] 87 | (later (is (= :foo @d)) 88 | (done))))) 89 | 90 | (deftest test-chain-errors 91 | (async done 92 | (let [boom (fn [n] (throw (ex-info "" {:n n})))] 93 | (doseq [b [boom (fn [n] (d/future (boom n)))]] 94 | (dorun 95 | (for [i (range 10) 96 | j (range 10)] 97 | (let [fs (concat (repeat i inc) [boom] (repeat j inc)) 98 | a (-> (apply d/chain 0 fs) 99 | (d/catch (fn [e] (:n (ex-data e))))) 100 | b (-> (apply d/chain' 0 fs) 101 | (d/catch' (fn [e] (:n (ex-data e)))))] 102 | (later (is (= i @a @b)))))))) 103 | (done))) 104 | 105 | (deftest test-callbacks-success 106 | (async done 107 | (let [d (d/deferred) 108 | result (atom nil) 109 | f #(reset! result %) 110 | l (d/listener f f)] 111 | (d/add-listener! d l) 112 | (d/success! d ::done) 113 | (later 114 | (is (= ::done @result)) 115 | (done))))) 116 | 117 | (deftest test-callbacks-error 118 | (async done 119 | (let [d (d/deferred) 120 | result (atom nil) 121 | f #(reset! result %) 122 | l (d/listener f f)] 123 | (d/add-listener! d l) 124 | (d/error! d ::error) 125 | (later 126 | (is (= ::error @result)) 127 | (done))))) 128 | 129 | (deftest test-callbacks-remove-listener 130 | (async done 131 | (let [d (d/deferred) 132 | result (atom nil) 133 | f #(reset! result %) 134 | l (d/listener f f)] 135 | (d/add-listener! d l) 136 | (d/cancel-listener! d l) 137 | (d/success! d ::done) 138 | (later 139 | (is (nil? @result)) 140 | (done))))) 141 | 142 | (deftest test-callbacks-removes-identical-listeners 143 | (async done 144 | (let [d (d/deferred) 145 | result (atom []) 146 | f (fn [v] (fn [_] (swap! result conj v))) 147 | l1 (d/listener (f 1) (f 1)) 148 | l2 (d/listener (f 2) (f 2))] 149 | (d/add-listener! d l1) 150 | (d/add-listener! d l2) 151 | (d/add-listener! d l1) 152 | (d/cancel-listener! d l1) 153 | (d/success! d ::done) 154 | (later 155 | (is (= [2] @result)) 156 | (done))))) 157 | 158 | (deftest test-callbacks-executes-listeners-in-order 159 | (async done 160 | (let [d (d/deferred) 161 | result (atom []) 162 | f (fn [v] (fn [_] (swap! result conj v))) 163 | l1 (d/listener (f 1) (f 1)) 164 | l2 (d/listener (f 2) (f 2))] 165 | (d/add-listener! d l1) 166 | (d/add-listener! d l2) 167 | (d/success! d ::done) 168 | (later 169 | (is (= [1 2] @result)) 170 | (done))))) 171 | 172 | (deftest test-alt-timeout 173 | (async done 174 | (let [d (d/alt (d/timeout! (d/deferred) 10) 2)] 175 | (later (is (= 2 @d)) 176 | (done))))) 177 | 178 | (deftest test-alt-deferred 179 | (async done 180 | (try (let [d (d/alt (d/future 1) 2)] 181 | (later (is (= 2 @d)) 182 | (done))) 183 | (catch js/Error e 184 | (done))))) 185 | 186 | (deftest test-alt-error 187 | (async done 188 | (let [d (d/alt (d/error-deferred (js/Error. "boom")) 189 | (d/timeout! (d/deferred) 10 1))] 190 | (is (thrown-with-msg? js/Error #"boom" @d) 191 | (done))))) 192 | 193 | (deftest test-alt 194 | (is (#{1 2 3} @(d/alt 1 2 3))) 195 | 196 | (testing "uniformly distributed" 197 | (let [results (atom {}) 198 | ;; within 10% 199 | n 1e4, r 10, eps (* n 0.1) 200 | f #(/ (% n eps) r)] 201 | (dotimes [_ n] 202 | @(d/chain (apply d/alt (range r)) 203 | #(swap! results update % (fnil inc 0)))) 204 | (doseq [[i times] @results] 205 | (is (<= (f -) times (f +))))))) 206 | 207 | (deftest test-loop-non-deferred 208 | (async done 209 | (let [result (capture-success 210 | (d/loop [] true))] 211 | (later 212 | (is (true? @result)) 213 | (done))))) 214 | 215 | (deftest test-loop-deferred 216 | (async done 217 | (let [ex (js/Error.) 218 | result (capture-error 219 | (d/loop [] (throw ex)))] 220 | (later (is (= ex @result)) 221 | (done))))) 222 | -------------------------------------------------------------------------------- /src/manifold_cljs/stream/graph.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream.graph 2 | (:require [org.weakmap] 3 | 4 | [manifold-cljs.deferred :as d] 5 | [manifold-cljs.utils :as utils] 6 | [manifold-cljs.stream.core :as s] 7 | [manifold-cljs.executor :as ex] 8 | [manifold-cljs.impl.list :as l] 9 | [manifold-cljs.impl.queue :as q] 10 | [manifold-cljs.impl.logging :as log])) 11 | 12 | ;; - ConcurrentHashMap -> WeakMap 13 | (def handle->downstreams (js/WeakMap.)) 14 | 15 | ;; - removed type hints 16 | (deftype Downstream 17 | [^long timeout 18 | ^boolean upstream? 19 | ^boolean downstream? 20 | sink 21 | description]) 22 | 23 | ;; - removed type hints 24 | (deftype AsyncPut 25 | [deferred 26 | dsts 27 | dst 28 | ^boolean upstream?]) 29 | 30 | ;;; 31 | 32 | ;; - removed COWAList-specific iteration 33 | ;; (.x) -> (.-x) 34 | (defn downstream [source] 35 | ;; TODO: why would it not return a handle? 36 | (when-let [handle (s/weak-handle source)] 37 | (when-let [l (.get handle->downstreams handle)] 38 | (map 39 | (fn [^Downstream d] 40 | [(.-description d) (.-sink d)]) l)))) 41 | 42 | ;;; 43 | 44 | ;; (.x) -> (.-x) 45 | (defn- async-send 46 | [^Downstream d msg dsts] 47 | (let [sink (.-sink d)] 48 | (let [x (if (== (.-timeout d) -1) 49 | (s/put sink msg false) 50 | (s/put sink msg false (.-timeout d) (if (.-downstream? d) sink false)))] 51 | (AsyncPut. x dsts d (.-upstream? d))))) 52 | 53 | ;; (.x) -> (.-x) 54 | ;; CHM#remove -> WeakMap.delete 55 | ;; COWAList.remove, size -> list/remove,size 56 | ;; instance? -> satisfies? 57 | (defn- handle-async-put [^AsyncPut x val source] 58 | (let [d (.-deferred x) 59 | val (if (satisfies? s/IEventSink val) 60 | (do 61 | (s/close! val) 62 | false) 63 | val)] 64 | (when (false? val) 65 | (let [l (.-dsts x)] 66 | (l/remove l (.-dst x)) 67 | (when (or (.-upstream? x) (== 0 (l/size l))) 68 | (s/close! source) 69 | (.delete handle->downstreams (s/weak-handle source))))))) 70 | 71 | ;; (.x) -> (.-x) 72 | ;; CHM#remove -> WeakMap.delete 73 | ;; COWAList.remove, size -> list/remove,size 74 | (defn- handle-async-error [^AsyncPut x err source] 75 | (some-> (.-dst x) .-sink s/close!) 76 | (log/error err "error in message propagation") 77 | (let [l (.-dsts x)] 78 | (l/remove l (.-dst x)) 79 | (when (or (.upstream? x) (== 0 (l/size l))) 80 | (s/close! source) 81 | (.delete handle->downstreams (s/weak-handle source))))) 82 | 83 | ;; LinkedList -> queue 84 | (defn- async-connect 85 | [source dsts] 86 | (let [sync-sinks (q/queue) 87 | deferreds (q/queue) 88 | 89 | sync-propagate 90 | (fn this [recur-point msg] 91 | (loop [] 92 | (let [^Downstream d (q/poll sync-sinks)] 93 | (if (nil? d) 94 | recur-point 95 | (let [^AsyncPut x (async-send d msg dsts) 96 | d (.-deferred x) 97 | val (d/success-value d ::none)] 98 | (if (keyword-identical? val ::none) 99 | (d/on-realized d 100 | (fn [v] 101 | (handle-async-put x v source) 102 | (trampoline #(this recur-point msg))) 103 | (fn [e] 104 | (handle-async-error x e source) 105 | (trampoline #(this recur-point msg)))) 106 | (do 107 | (handle-async-put x val source) 108 | (recur)))))))) 109 | 110 | async-propagate 111 | (fn this [recur-point msg] 112 | (loop [] 113 | (let [^AsyncPut x (q/poll deferreds)] 114 | (if (nil? x) 115 | 116 | ;; iterator over sync-sinks 117 | (if (q/empty? sync-sinks) 118 | recur-point 119 | #(sync-propagate recur-point msg)) 120 | 121 | ;; iterate over async-sinks 122 | (let [d (.-deferred x) 123 | val (d/success-value d ::none)] 124 | (if (keyword-identical? val ::none) 125 | (d/on-realized d 126 | (fn [val] 127 | (handle-async-put x val source) 128 | (trampoline #(this recur-point msg))) 129 | (fn [e] 130 | (handle-async-error x e source) 131 | (trampoline #(this recur-point msg)))) 132 | (do 133 | (handle-async-put x val source) 134 | (recur)))))))) 135 | 136 | err-callback 137 | (fn [err] 138 | (log/error err "error in source of 'connect'") 139 | (.delete handle->downstreams (s/weak-handle source)))] 140 | 141 | (trampoline 142 | (fn this 143 | ([] 144 | (let [d (s/take source ::drained false)] 145 | (if (d/realized? d) 146 | (this @d) 147 | (d/on-realized d 148 | (fn [msg] (trampoline #(this msg))) 149 | err-callback)))) 150 | ([msg] 151 | (cond 152 | 153 | (keyword-identical? ::drained msg) 154 | (do 155 | (.delete handle->downstreams (s/weak-handle source)) 156 | (doseq [^Downstream d dsts] 157 | (when (.-downstream? d) 158 | (s/close! (.-sink d))))) 159 | 160 | (== 1 (l/size dsts)) 161 | (let [dst (first dsts) 162 | ^AsyncPut x (async-send dst msg dsts) 163 | d (.-deferred x) 164 | val (d/success-value d ::none)] 165 | (if (keyword-identical? ::none val) 166 | (d/on-realized d 167 | (fn [val] 168 | (handle-async-put x val source) 169 | (trampoline this)) 170 | (fn [e] 171 | (handle-async-error x e source) 172 | (trampoline this))) 173 | (do 174 | (handle-async-put x val source) 175 | this))) 176 | 177 | :else 178 | (if (empty? dsts) 179 | (do 180 | (s/close! source) 181 | (.delete handle->downstreams (s/weak-handle source))) 182 | 183 | (do 184 | (doseq [^Downstream d dsts] 185 | (if (s/synchronous? (.-sink d)) 186 | (l/add sync-sinks d) 187 | (l/add deferreds (async-send d msg dsts)))) 188 | (async-propagate this msg))))))))) 189 | 190 | ;; CHM#putIfAbsent -> WeakMap.set 191 | (defn connect 192 | ([src dst 193 | {:keys [upstream? 194 | downstream? 195 | timeout 196 | description] 197 | :or {timeout -1 198 | upstream? false 199 | downstream? true} 200 | :as opts}] 201 | (let [d (Downstream. 202 | timeout 203 | (boolean (and upstream? (satisfies? s/IEventSink src))) 204 | downstream? 205 | dst 206 | description) 207 | k (s/weakHandle src nil)] 208 | (if-let [dsts (.get handle->downstreams k)] 209 | (l/add dsts d) 210 | (let [dsts (l/list)] 211 | (.set handle->downstreams k dsts) 212 | (l/add dsts d) 213 | (if (s/synchronous? src) 214 | (throw (js/Error. "Cannot connect to a synchronous source!")) 215 | (async-connect src dsts))))))) 216 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # manifold-cljs 2 | 3 | [![Build Status](https://travis-ci.org/dm3/manifold-cljs.png?branch=master)](https://travis-ci.org/dm3/manifold-cljs) 4 | 5 | A port of [Manifold](https://github.com/ztellman/manifold) to Clojurescript. 6 | 7 | This port tracks the latest Manifold version as closely as possible. As per 8 | [Clojurescript port](https://github.com/ztellman/manifold/issues/2) issue, Zach 9 | wanted to keep the port separate from the main project - so here it is. 10 | However, ~80% of the code was copied from the Clojure Manifold verbatim, so 11 | there's a chance it might get ported back with reader conditionals. 12 | 13 | The port hasn't been used in any serious applications yet, but there are some 14 | tests. And they pass! 15 | 16 | There are no blocking operations in Javascript, so some of the original 17 | Manifold functions had to go. 18 | 19 | ## Usage 20 | 21 | Add the following dependency to your project.clj or build.boot: 22 | 23 | ```clojure 24 | [manifold-cljs "0.1.7-1"] 25 | ``` 26 | 27 | Then use it in your project: 28 | 29 | ```clojure 30 | (ns example.project 31 | (:require [manifold-cljs.stream :as s] 32 | [manifold-cljs.deferred :as d])) 33 | ``` 34 | 35 | You can find several examples in the `examples/` directory. 36 | 37 | ## Extensions 38 | 39 | * [Core.Async](https://github.com/clojure/core.async) adapter at [Manifold-cljs.Core.Async](https://github.com/dm3/manifold-cljs.core.async). 40 | 41 | ## Differences to Clojure implementation 42 | 43 | ### Executors 44 | 45 | `manifold-cljs.executor` defines an `Executor` protocol with implementations 46 | backed by `goog.async.nextTick`, `setTimeout`, synchronous execution and a 47 | batched variation which takes another executor as its implementation. An 48 | executor is selected while creating a Stream or a Deferred. 49 | 50 | The call to `manifold-cljs.executor/executor` will always return the batched 51 | `next-tick` executor by default, so all of the callbacks on Streams and 52 | Deferreds are executed as tasks. Either as microtasks, if `setImmediate` is 53 | available, or as tasks (`setTimeout`). This means that the code will behave 54 | similarly to the way it would behave on the JVM if every stream and deferred 55 | were executed on an executor. 56 | 57 | On the JVM, the call to `manifold.executor/executor` will return no executor by 58 | default, which will make the callbacks run on whichever thread triggered the 59 | completion of the Deferred. 60 | 61 | The difference becomes apparent in the following snippet: 62 | 63 | ```clojure 64 | (let [s (s/stream), b (s/batch 2 s)] 65 | (s/put-all! s [1 2 3]) 66 | (s/close! s) 67 | (assert (= [[1 2] [3]] (s/stream->seq b)))) 68 | ``` 69 | 70 | The above succeeds when run on a single thread, but fails if run within a 71 | `(manifold.executor/with-executor (manifold.executor/execute-pool) ...)` block. 72 | The second result element - `[3]` - nevers gets delivered to the batched stream 73 | as the source stream gets closed first. All the `Consumer` events registered on 74 | the source get canceled. 75 | 76 | ### Blocking put/take 77 | 78 | `stream/put` and `stream/take` have the same signature as their Clojure 79 | counterparts, however setting the `blocking?` parameter to `true` will always 80 | trigger an assertion error. Puts and takes in manifold-cljs will always return 81 | a deferred result. Consequently there is no way to synchronously connect 82 | streams and `stream/isSynchronous` always returns false. 83 | 84 | ### Metadata 85 | 86 | I couldn't find a protocol allowing mutation of metadata in Clojurescript. The 87 | default deferred and stream implementations are mutable, so there are no `IMeta` 88 | or `IWithMeta` implementations for streams/deferreds. 89 | 90 | ### Deferred protocols 91 | 92 | The protocols for the Deferred have been moved to 93 | `manifold-cljs.deferred.core`. The default implementation - to 94 | `manifold-cljs.deferred.default-impl`. This is analogous to what has been done to 95 | streams. This was done in order to avoid a cyclic dependency between 96 | `manifold-cljs.deferred`, where the protocols used to live, and 97 | `manifold-cljs.time`. Clojurescript is compiled statically and can't `require` 98 | a namespace in the middle of the file. 99 | 100 | Ideally we should propagate this change to the Clojure Manifold. 101 | 102 | ### Missing functions 103 | 104 | * `manifold-cljs.stream/stream->seq` - inherently blocking 105 | * `manifold-cljs.deferred` 106 | - `let-flow` - TODO: needs some advanced code walking 107 | * `manifold-cljs.executor` 108 | - `instrumented-executor` - TODO: do we want this in Cljs? 109 | - `*stats-callbacks*` - TODO: do we want this in Cljs? 110 | - `utilization-executor` - not applicable 111 | - `execute-pool` - not applicable 112 | - `wait-pool` - not applicable 113 | * `manifold-cljs.time` 114 | - `format-duration` - niche 115 | - `floor` - niche 116 | - `add` - niche 117 | - `IClock` - TODO: do we want this in Cljs? 118 | - `IMockClock` - TODO: do we want this in Cljs? 119 | - `mock-clock` - TODO: do we want this in Cljs? 120 | - `*clock*` - TODO: do we want this in Cljs? 121 | - `with-clock` - TODO: do we want this in Cljs? 122 | - `scheduled-executor->clock` - not applicable 123 | * `manifold-cljs.utils` 124 | - `without-overflow` - not used 125 | - `fast-satisfies` - don't need 126 | - `with-lock` - don't need 127 | 128 | ### Cljs-only functions 129 | 130 | * `manifold-cljs.deferred` 131 | - `time` - measure time taken to evaluate the body in a deferred 132 | 133 | ## TODO 134 | 135 | * WeakMap dependency - this can somehow be compiled in by the GCC - how? 136 | * unhandled error reporting - like goog.Deferred/Bluebird 137 | * DEBUG stack traces - like goog.Deferred/Bluebird 138 | * better logging - format to dev console? 139 | * performance - currently ~3x slower than core.async on the `daisy` example 140 | * `deferred/let-flow` - needs a different deep code walking impl/riddley replacement for Cljs 141 | 142 | See [Closure Promise](https://github.com/google/closure-library/blob/master/closure/goog/promise/promise.js#L84) for more ideas. 143 | 144 | ## Patterns and Gotchas 145 | 146 | Manifold is in need of best practices/patterns/gotchas library. 147 | 148 | ### Writing `d/loop`-based stream combinators 149 | 150 | Many of the stream combinators, like `s/zip`, use `d/loop` inside to take from 151 | a source stream and put into the destination stream. There is an additional 152 | step needed to make a combinator like that work well when the source stream is 153 | connected to other streams as well as combined via the combinator - passing 154 | values through an intermediary stream. See [related Github 155 | issue](https://github.com/ztellman/manifold/issues/87) for more info. 156 | 157 | ### Error handling 158 | 159 | ### Signalling "no more messages" upstream 160 | 161 | ### Upstream is really closed only after an additional put 162 | 163 | Most people expect the `s/on-closed` callback to get called once the `s/close!` 164 | is called on a stream. This is true if the callback is registered on the stream 165 | that is being closed. However, in case we `s/close!` a downstream stream and 166 | the callback is registered upstream, the close callback will only trigger once 167 | the producer tries to put another value into the upstream. See 168 | [this](https://github.com/ztellman/manifold/issues/82) and 169 | [this](https://github.com/ztellman/manifold/issues/56) Github issues for more 170 | info. 171 | 172 | ### `d/let-flow` won't handle deferred conditionals in a smart way 173 | 174 | If you have a conditional clause where the condition is a deferred as well as a 175 | result - the result deferred will be awaited even if the condition is falsey, 176 | e.g.: 177 | 178 | ```clojure 179 | (let [x (deferred-never-realized-unless-y)] 180 | (let-flow [y (deferred-false)] 181 | (if y x :ok)) 182 | ``` 183 | 184 | The above will block on `x`, even though `y` realizes to `false`. 185 | 186 | See [this](https://github.com/ztellman/manifold/issues/47) Github issue for more info. 187 | 188 | ## License 189 | 190 | Copyright © 2016 Zach Tellman, Vadim Platonov 191 | 192 | Distributed under the MIT License. 193 | -------------------------------------------------------------------------------- /src/manifold_cljs/stream/default_impl.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream.default-impl 2 | (:require [manifold-cljs.deferred :as d] 3 | [manifold-cljs.impl.queue :as q] 4 | [manifold-cljs.impl.logging :as log] 5 | [manifold-cljs.utils :as u] 6 | [manifold-cljs.executor :as ex] 7 | [manifold-cljs.stream.core :as s] 8 | [manifold-cljs.stream.graph :as g])) 9 | 10 | (deftype Production [deferred message token]) 11 | (deftype Consumption [message deferred token]) 12 | (deftype Producer [message deferred]) 13 | (deftype Consumer [deferred default-val]) 14 | 15 | ;; - Throwable -> js/Error 16 | ;; - LinkedList methods -> queue ns 17 | (s/def-sink+source Stream 18 | [^boolean permanent? 19 | description 20 | producers 21 | consumers 22 | capacity 23 | messages 24 | executor 25 | add!] 26 | 27 | :stream 28 | [(isSynchronous [_] false) 29 | 30 | (description [this] 31 | (let [m {:type "manifold" 32 | :sink? true 33 | :source? true 34 | :pending-puts (q/size producers) 35 | :buffer-capacity capacity 36 | :buffer-size (if messages (q/size messages) 0) 37 | :pending-takes (q/size consumers) 38 | :permanent? permanent? 39 | :closed? (s/closed? this) 40 | :drained? (s/drained? this)}] 41 | (if description 42 | (description m) 43 | m))) 44 | 45 | (close [this] 46 | (when-not permanent? 47 | (when-not (s/closed? this) 48 | 49 | (try 50 | (add!) 51 | (catch js/Error e 52 | (log/error e "error in stream transformer"))) 53 | 54 | (loop [] 55 | (when-let [c (q/poll consumers)] 56 | (try 57 | (d/success! (.-deferred c) (.-default-val c)) 58 | (catch js/Error e 59 | (log/error e "error in callback"))) 60 | (recur))) 61 | 62 | (s/markClosed this) 63 | 64 | (when (s/drained? this) 65 | (s/markDrained this)))))] 66 | 67 | :sink 68 | [(put [this msg blocking? timeout timeout-val] 69 | (assert (not blocking?) "Blocking operations not supported!") 70 | (let [acc (q/queue) 71 | 72 | result 73 | (try 74 | (if (s/isClosed this) 75 | false 76 | (add! acc msg)) 77 | (catch js/Error e 78 | (log/error e "error in stream transformer") 79 | false)) 80 | 81 | close? 82 | (reduced? result) 83 | 84 | result 85 | (if close? 86 | @result 87 | result) 88 | 89 | val (loop [val true] 90 | (if (q/empty? acc) 91 | val 92 | (let [x (q/pop acc)] 93 | (cond 94 | 95 | (instance? Producer x) 96 | (do 97 | (log/warn "excessive pending puts (> 16384), closing stream") 98 | (s/close! this) 99 | false) 100 | 101 | (instance? Production x) 102 | (let [^Production p x] 103 | (d/success! (.-deferred p) (.-message p) (.-token p)) 104 | (recur true)) 105 | 106 | :else 107 | (do 108 | (d/timeout! x timeout timeout-val) 109 | (recur x))))))] 110 | 111 | (cond 112 | 113 | (or close? (false? result)) 114 | (do 115 | (s/close this) 116 | (d/success-deferred false executor)) 117 | 118 | (d/deferred? val) 119 | val 120 | 121 | :else 122 | (d/success-deferred val executor)))) 123 | 124 | (put [this msg blocking?] 125 | (s/put this msg blocking? nil nil))] 126 | 127 | :source 128 | [(isDrained [this] 129 | (and (s/closed? this) 130 | (q/empty? producers) 131 | (or (nil? messages) 132 | (q/empty? messages)))) 133 | 134 | ;; TODO: remove claim! - we don't need it in single-threaded environment 135 | (take [this default-val blocking? timeout timeout-val] 136 | (assert (not blocking?) "Blocking operations not supported!") 137 | (let [result 138 | (or 139 | 140 | ;; see if we can dequeue from the buffer 141 | (when-let [msg (and messages (q/poll messages))] 142 | 143 | ;; check if we're drained 144 | (when (and (s/closed? this) (s/drained? this)) 145 | (s/markDrained this)) 146 | 147 | (if-let [^Producer p (q/poll producers)] 148 | (if-let [token (d/claim! (.-deferred p))] 149 | (do 150 | (q/offer messages (.-message p)) 151 | (Consumption. msg (.-deferred p) token)) 152 | (d/success-deferred msg executor)) 153 | (d/success-deferred msg executor))) 154 | 155 | ;; see if there are any unclaimed producers left 156 | (loop [^Producer p (q/poll producers)] 157 | (when p 158 | (if-let [token (d/claim! (.-deferred p))] 159 | (let [c (Consumption. (.-message p) (.-deferred p) token)] 160 | 161 | ;; check if we're drained 162 | (when (and (s/closed? this) (s/drained? this)) 163 | (s/markDrained this)) 164 | 165 | c) 166 | (recur (q/poll producers))))) 167 | 168 | ;; closed, return << default-val >> 169 | (and (s/closed? this) 170 | (d/success-deferred default-val executor)) 171 | 172 | ;; add to the consumers queue 173 | (if (and timeout (<= timeout 0)) 174 | (d/success-deferred timeout-val executor) 175 | (let [d (d/deferred executor)] 176 | (d/timeout! d timeout timeout-val) 177 | (let [c (Consumer. d default-val)] 178 | (if (and (< (q/size consumers) 16384) (q/offer consumers c)) 179 | d 180 | c)))))] 181 | 182 | (cond 183 | 184 | (instance? Consumer result) 185 | (do 186 | (log/warn "excessive pending takes (> 16384), closing stream") 187 | (s/close! this) 188 | (d/success-deferred false executor)) 189 | 190 | (instance? Consumption result) 191 | (let [^Consumption result result] 192 | (try 193 | (d/success! (.-deferred result) true (.-token result)) 194 | (catch js/Error e 195 | (log/error e "error in callback"))) 196 | (let [msg (.-message result)] 197 | (d/success-deferred msg executor))) 198 | 199 | :else result))) 200 | 201 | (take [this default-val blocking?] 202 | (s/take this default-val blocking? nil nil))]) 203 | 204 | ;; same as clj 205 | ;; - removed type annotations 206 | ;; - LinkedList -> array 207 | ;; - ArrayDeque -> queue 208 | (defn add! 209 | [producers 210 | consumers 211 | messages 212 | capacity 213 | executor] 214 | (let [capacity (long capacity) 215 | t-d (d/success-deferred true executor)] 216 | (fn 217 | ([] 218 | ) 219 | ([_] 220 | (d/success-deferred false executor)) 221 | ([acc msg] 222 | (doto acc 223 | (q/offer 224 | (or 225 | 226 | ;; see if there are any unclaimed consumers left 227 | (loop [^Consumer c (q/poll consumers)] 228 | (when c 229 | (if-let [token (d/claim! (.-deferred c))] 230 | (Production. (.-deferred c) msg token) 231 | (recur (q/poll consumers))))) 232 | 233 | ;; see if we can enqueue into the buffer 234 | (and 235 | messages 236 | (when (< (q/size messages) capacity) 237 | (q/offer messages msg)) 238 | t-d) 239 | 240 | ;; add to the producers queue 241 | (let [d (d/deferred executor)] 242 | (let [pr (Producer. msg d)] 243 | (if (and (< (q/size producers) 16384) (q/offer producers pr)) 244 | d 245 | pr)))))))))) 246 | 247 | ;; - LinkedList -> array 248 | ;; - ArrayDeque -> queue 249 | ;; - Math/max -> max 250 | (defn stream 251 | ([] 252 | (stream 0 nil (ex/executor))) 253 | ([buffer-size] 254 | (stream buffer-size nil (ex/executor))) 255 | ([buffer-size xform] 256 | (stream buffer-size xform (ex/executor))) 257 | ([buffer-size xform executor] 258 | (let [consumers (q/queue) 259 | producers (q/queue) 260 | buffer-size (long (max 0 (long buffer-size))) 261 | messages (when (pos? buffer-size) (q/queue)) 262 | add! (add! producers consumers messages buffer-size executor) 263 | add! (if xform (xform add!) add!)] 264 | (->Stream 265 | false 266 | nil 267 | producers 268 | consumers 269 | buffer-size 270 | messages 271 | executor 272 | add!)))) 273 | 274 | ;; - LinkedList -> array 275 | ;; - ArrayDeque -> queue 276 | ;; - Math/max -> max 277 | (defn stream* 278 | [{:keys [permanent? 279 | buffer-size 280 | description 281 | executor 282 | xform] 283 | :or {permanent? false 284 | executor (ex/executor)}}] 285 | (let [consumers (q/queue) 286 | producers (q/queue) 287 | buffer-size (long (or buffer-size 0)) 288 | messages (when buffer-size (q/queue)) 289 | buffer-size (if buffer-size (long (max 0 buffer-size)) 0) 290 | add! (add! producers consumers messages buffer-size executor) 291 | add! (if xform (xform add!) add!)] 292 | (->Stream 293 | permanent? 294 | description 295 | producers 296 | consumers 297 | buffer-size 298 | messages 299 | executor 300 | add!))) 301 | -------------------------------------------------------------------------------- /test/manifold_cljs/stream_test.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream-test 2 | (:require [manifold-cljs.stream :as s] 3 | [manifold-cljs.stream.core :as core] 4 | [manifold-cljs.deferred :as d] 5 | [manifold-cljs.time :as t] 6 | [manifold-cljs.test-util :refer [later no-success?]] 7 | [cljs.test :refer [deftest testing is async]])) 8 | 9 | (deftest test-default-stream 10 | (testing "stream" 11 | (let [s (s/stream)] 12 | (is (s/sinkable? s)) 13 | (is (s/sourceable? s)) 14 | (is (= (s/->sink s) s)) 15 | (is (= (s/->source s) s)) 16 | 17 | (is (empty? (s/downstream s))) 18 | (is (not (s/synchronous? s))))) 19 | 20 | (testing "stream proxy" 21 | (let [s (s/stream) 22 | sink (s/sink-only s) 23 | source (s/source-only s)] 24 | (is (s/sink? s)) 25 | (is (s/source? s)) 26 | (is (not= sink source)) 27 | 28 | (is (s/sink? sink)) 29 | (is (not (s/source? sink))) 30 | 31 | (is (s/source? source)) 32 | (is (not (s/sink? source))))) 33 | 34 | (testing "put then take" 35 | (let [s (s/stream) 36 | p (s/put! s 1)] 37 | (is (no-success? p)) 38 | 39 | (let [t (s/take! s)] 40 | (is (= 1 @t)) 41 | (is (true? @p))))) 42 | 43 | (testing "take then put" 44 | (let [s (s/stream) 45 | t (s/take! s)] 46 | (is (no-success? t)) 47 | 48 | (let [p (s/put! s 1)] 49 | (is (true? @p)) 50 | (is (= 1 @t))))) 51 | 52 | (testing "closes and drains" 53 | (testing "empty stream" 54 | (let [s (s/stream) 55 | status (atom {:closed? false, :drained? false})] 56 | (s/on-closed s #(swap! status assoc :closed? true)) 57 | (s/on-drained s #(swap! status assoc :drained? true)) 58 | 59 | (is (not (s/closed? s))) 60 | 61 | (s/close! s) 62 | (is (s/closed? s)) 63 | (is (s/drained? s)) 64 | (is (= @status {:closed? false, :drained? false})) 65 | 66 | (later 67 | (= @status {:closed? true, :drained? true})))) 68 | 69 | (testing "non-empty stream" 70 | (let [s (s/stream) 71 | p (s/put! s 1)] 72 | (s/close! s) 73 | 74 | (is (s/closed? s)) 75 | (is (not (s/drained? s))) 76 | 77 | (is (= 1 @(s/take! s))) 78 | (is (s/drained? s))))) 79 | 80 | (testing "buffered" 81 | (let [s (s/stream 1)] 82 | (is (true? @(s/put! s 1))) 83 | (is (no-success? (s/put! s 2))) 84 | 85 | (is (= 1 @(s/take! s))) 86 | (is (= 2 @(s/take! s)))))) 87 | 88 | (deftest test-stream-xform 89 | (async done 90 | (let [s (s/stream 0 (mapcat #(vector % % %)))] 91 | (s/put! s 1) 92 | (let [t1 (s/take! s), t2 (s/take! s)] 93 | (later 94 | (is (= 1 @t1)) 95 | (is (= 1 @t2)) 96 | (done)))))) 97 | 98 | (deftest test-put-all 99 | (async done 100 | (let [s (s/stream) 101 | p (s/put-all! s [1 2]) 102 | t1 (s/take! s), t2 (s/take! s)] 103 | (is (= 1 @t1)) 104 | (is (no-success? t2)) 105 | (later 106 | (is (= 2 @t2)) 107 | (done))))) 108 | 109 | (deftest test-try-take 110 | (async done 111 | (let [s (s/stream) 112 | t1 (s/try-take! s ::none 500 ::timeout)] 113 | (t/in 600 114 | (fn [] 115 | (do 116 | (is (= ::timeout @t1)) 117 | (done))))))) 118 | 119 | (deftest test-async-propagate 120 | (testing "new takes propagate asynchronously" 121 | (async done 122 | (let [a (s/stream), b (s/stream)] 123 | (s/connect a b) 124 | (let [p (s/put! a 1), t (s/take! b 1)] 125 | (is (true? @p)) 126 | (is (no-success? t)) 127 | (later 128 | (is (= 1 @t)) 129 | (done))))))) 130 | 131 | (deftest test-propagate-buffered 132 | (testing "propagates with buffered streams" 133 | (async done 134 | (let [a (s/stream 1), b (s/stream 1)] 135 | (s/connect a b) 136 | (is (true? @(s/put! a 1))) 137 | (is (true? @(s/put! a 2))) 138 | (let [t1 (s/take! b), t2 (s/take! b)] 139 | (later 140 | (is (= 1 @t1)) 141 | (is (= 2 @t2)) 142 | (done))))))) 143 | 144 | (deftest test-close-downstream 145 | (testing "closes all downstreams when single upstream closed" 146 | (async done 147 | (let [a (s/stream), b (s/stream), c (s/stream)] 148 | (s/connect a b) 149 | (s/connect a c) 150 | 151 | (is (not (s/closed? a))) 152 | (is (not (s/closed? b))) 153 | (is (not (s/closed? c))) 154 | 155 | (s/close! a) 156 | (is (s/closed? a)) 157 | (is (not (s/closed? b))) 158 | (is (not (s/closed? c))) 159 | (later 160 | (is (s/closed? b)) 161 | (is (s/closed? c)) 162 | (done)))))) 163 | 164 | (deftest test-not-close-downstream 165 | (testing "doesn't close downstream when connected with downstream? = false" 166 | (async done 167 | (let [a (s/stream), b (s/stream)] 168 | (s/connect a b {:downstream? false}) 169 | 170 | (s/close! a) 171 | (later 172 | (is (not (s/closed? b))) 173 | (done)))))) 174 | 175 | (deftest test-existing-propagate 176 | (testing "existing puts/take propagate synchronously after connect" 177 | (let [a (s/stream), b (s/stream) 178 | p (s/put! a 1), t (s/take! b 1)] 179 | (s/connect a b) 180 | (is (true? @p)) 181 | (is (= 1 @t))))) 182 | 183 | (deftest test-consume 184 | (async done 185 | (let [a (s/stream) 186 | result (atom []) 187 | consume-result (s/consume #(swap! result conj %) a)] 188 | (s/put! a 1) 189 | (s/put! a 2) 190 | (s/close! a) 191 | (is (= @result [])) 192 | (is (no-success? consume-result)) 193 | (later 194 | (is (= @result [1 2])) 195 | (later 196 | (is (true? @consume-result)) 197 | (done)))))) 198 | 199 | (deftest test-async-consume 200 | (async done 201 | (let [a (s/stream) 202 | result (atom []) 203 | consume-result (s/consume-async 204 | #(do (swap! result conj %) 205 | (d/success-deferred (= (count @result) 1))) a)] 206 | (s/put! a 1) 207 | (s/put! a 2) 208 | (is (= @result [])) 209 | (later 210 | (is (s/closed? a)) 211 | (is (= @result [1 2])) 212 | (later 213 | (is (true? @consume-result)) 214 | (done)))))) 215 | 216 | (deftest test-connect-via 217 | (async done 218 | (let [src (s/stream), dst (s/stream) 219 | result (atom []) 220 | done? (s/connect-via src #(do (swap! result conj %) (s/put! dst %)) dst)] 221 | (s/put! src 1) 222 | (s/put! src 2) 223 | (s/close! src) 224 | (let [t1 (s/take! dst), t2 (s/take! dst)] 225 | (later 226 | (is (= [1 2] @result [@t1 @t2])) 227 | (later 228 | (is (s/closed? dst)) 229 | (is (true? @done?)) 230 | (done))))))) 231 | 232 | (deftest test-connect-via-proxy 233 | (async done 234 | (let [src (s/stream), prx (s/stream), dst (s/stream) 235 | done? (s/connect-via-proxy src prx dst)] 236 | (s/put! src 1) 237 | (s/put! src 2) 238 | (s/close! src) 239 | (let [t1 (s/take! prx), t2 (s/take! prx)] 240 | (later 241 | (is (= [1 2] [@t1 @t2])) 242 | (later 243 | (is (s/closed? prx)) 244 | (is (true? @done?)) 245 | (done))))))) 246 | 247 | (deftest test-drain-into 248 | (async done 249 | (let [src (s/stream), dst (s/stream) 250 | done? (s/drain-into src dst)] 251 | (s/put! src 1) 252 | (s/put! src 2) 253 | (s/close! src) 254 | 255 | (let [t1 (s/take! dst), t2 (s/take! dst)] 256 | (later 257 | (is (= [1 2] [@t1 @t2])) 258 | (later 259 | (is @done?) 260 | (is (not (s/closed? dst))) 261 | (done))))))) 262 | 263 | (deftest test-periodically-initial-delay 264 | (testing "initial delay set below period when not provided explicitly" 265 | (async done 266 | (let [result (atom 0) 267 | period 50 268 | s (s/periodically period #(swap! result inc))] 269 | (s/consume identity s) 270 | (t/in period 271 | #(do (is (= @result 1)) 272 | (done))))))) 273 | 274 | (deftest test-periodically 275 | (async done 276 | (let [result (atom 0) 277 | period 50, init-delay 25 278 | s (s/periodically init-delay period #(swap! result inc))] 279 | (s/consume identity s) 280 | (t/in (+ init-delay (* 2 period)) 281 | #(do (is (= @result 3)) 282 | (done)))))) 283 | 284 | (deftest test-transform 285 | (async done 286 | (let [s (s/stream) 287 | r (s/transform (map inc) s)] 288 | (s/put! s 1) 289 | (let [t (s/take! r)] 290 | (later (is (= 2 @t)) 291 | (done)))))) 292 | 293 | (deftest test-map 294 | (async done 295 | (let [s (s/stream) 296 | r (s/map inc s)] 297 | (s/put! s 1) 298 | (let [t (s/take! r)] 299 | (later 300 | (is (= 2 @t)) 301 | (done)))))) 302 | 303 | (deftest test-realize-each 304 | (async done 305 | (let [s (s/stream) 306 | r (s/realize-each s) 307 | d (d/deferred)] 308 | (s/put! s d) 309 | (s/close! s) 310 | (let [t (s/take! r)] 311 | (d/success! d 1) 312 | (later 313 | (is (= 1 @t)) 314 | (later 315 | (is (s/drained? r)) 316 | (done))))))) 317 | 318 | (deftest test-zip 319 | (async done 320 | (let [s1 (s/stream), s2 (s/stream) 321 | r (s/zip s1 s2)] 322 | (s/put! s1 1) 323 | (let [t (s/take! r)] 324 | (later 325 | (is (no-success? t)) 326 | (s/put! s2 'x) 327 | (s/close! s1) 328 | (s/close! s2) 329 | (later 330 | (is (= [1 'x] @t)) 331 | (later 332 | (is (s/drained? r)) 333 | (done)))))))) 334 | 335 | (deftest test-filter 336 | (async done 337 | (let [s (s/stream) 338 | r (s/filter even? s)] 339 | (s/put! s 1) 340 | (s/put! s 2) 341 | (s/close! s) 342 | (let [t (s/take! r)] 343 | (later 344 | (is (= 2 @t)) 345 | (later 346 | (is (s/drained? r)) 347 | (done))))))) 348 | 349 | (deftest test-reductions 350 | (async done 351 | (let [s (s/stream) 352 | r (s/reductions (fn [[a acc] b] [(+ a acc) (+ a b)]) [0 1] s)] 353 | (s/put! s 1) 354 | (s/put! s 2) 355 | (s/close! s) 356 | (let [t1 (s/take! r), t2 (s/take! r), t3 (s/take! r)] 357 | (is (= [0 1] @t1)) 358 | (later 359 | (is (= [1 1] @t2)) 360 | (is (= [2 3] @t3)) 361 | (later 362 | (is (s/drained? r)) 363 | (done))))))) 364 | 365 | (deftest test-reduce 366 | (async done 367 | (let [s (s/stream) 368 | r (s/reduce + 0 s)] 369 | (s/put! s 1) 370 | (s/put! s 2) 371 | (s/close! s) 372 | (later 373 | (is (= 3 @r)) 374 | (done))))) 375 | 376 | (deftest test-reduce-reduced 377 | (async done 378 | (let [inputs (range 10) 379 | accf (fn [acc el] 380 | (if (= el 5) (reduced :large) el)) 381 | s (s/->source inputs) 382 | result (s/reduce accf 0 s)] 383 | (later 384 | (is (= :large (reduce accf 0 inputs) @result)) 385 | (is (not (s/drained? s))) 386 | (let [t (s/try-take! s 1)] 387 | (later 388 | (is (= 6 @t)) 389 | (done))))))) 390 | 391 | (deftest test-mapcat 392 | (async done 393 | (let [s (s/stream) 394 | r (s/mapcat #(vector % %) s)] 395 | (s/put! s 1) 396 | (s/close! s) 397 | (let [t1 (s/take! r), t2 (s/take! r)] 398 | (later 399 | (is (= 1 @t1)) 400 | (is (= 1 @t2)) 401 | (later 402 | (is (s/drained? r)) 403 | (done))))))) 404 | 405 | (deftest test-lazily-partition-by 406 | (async done 407 | (let [s (s/stream) 408 | r (s/lazily-partition-by even? s)] 409 | (s/put! s 1) 410 | (s/put! s 3) 411 | (s/put! s 2) 412 | (s/close! s) 413 | (let [t1 (s/take! r), t2 (s/take! r)] 414 | (later 415 | (let [r1 @t1] 416 | (is (s/source? r1)) 417 | (let [x1 (s/take! r1), x2 (s/take! r1)] 418 | (is (= 1 @x1)) 419 | (later 420 | (is (s/drained? s)) 421 | (is (= 3 @x2)) 422 | (let [r2 @t2] 423 | (is (= 2 @(s/take! r2))) 424 | (done)))))))))) 425 | 426 | (deftest test-concat 427 | (async done 428 | (let [s (s/stream), r (s/concat s) 429 | s1 (s/stream), s2 (s/stream)] 430 | (s/put! s1 1) 431 | (s/put! s2 2) 432 | (s/put! s s1) 433 | (s/put! s s2) 434 | (s/close! s1) 435 | (s/close! s2) 436 | (s/close! s) 437 | (let [t1 (s/take! r), t2 (s/take! r)] 438 | (later 439 | (is (= 1 @t1)) 440 | (is (= 2 @t2)) 441 | (later 442 | (is (s/drained? s)) 443 | (done))))))) 444 | 445 | (deftest test-buffered-stream 446 | (async done 447 | (let [s (s/buffered-stream (constantly 2) 5) 448 | p1 (s/put! s 1), p2 (s/put! s 2), p3 (s/put! s 3)] 449 | (is @p1) 450 | (is @p2) 451 | (is (no-success? p3)) 452 | ;; buffered-stream has an infinite-buffer stream backing it 453 | ;; so all the takes complete immediately if one disregards 454 | ;; the backpressure on the `put!`s. 455 | (is (= 1 @(s/take! s))) 456 | (is (= 2 @(s/take! s))) 457 | (is (= 3 @(s/take! s))) 458 | (later 459 | (is @p3) 460 | (done))))) 461 | 462 | (deftest test-batch 463 | (testing "batch size" 464 | (async done 465 | (let [s (s/stream) 466 | r (s/batch 2 s)] 467 | (s/put-all! s [1 2 3]) 468 | (let [t1 (s/take! r), t2 (s/take! r)] 469 | ;; closing `s` here will close the Consumer associated with `t2` 470 | (later 471 | (is (= [1 2] @t1)) 472 | (s/close! s) 473 | (later 474 | ;; on-closed callbacks are triggered 475 | (later 476 | (is (= [3] @t2)) 477 | (done))))))))) 478 | 479 | (deftest test-throttle 480 | (async done 481 | (let [s (s/stream), r (s/throttle 2 s)] 482 | (s/put-all! s [1 2]) 483 | (s/close! s) 484 | (let [t1 (s/take! r), t2 (s/take! r)] 485 | (later 486 | (is (= 1 @t1)) 487 | (t/in 100 488 | (fn [] 489 | (is (no-success? t2)) 490 | ;; 2 msg per second => 1 every ~500 ms 491 | (t/in 500 492 | (fn [] 493 | (is (= 2 @t2)) 494 | ;; wait for the throttle timeout to realize 495 | (t/in 500 496 | (fn [] 497 | (is (s/drained? r)) 498 | (done)))))))))))) 499 | 500 | (deftest test-connect-timeout 501 | (async done 502 | (let [src (s/stream) 503 | sink (s/stream)] 504 | 505 | (s/connect src sink {:timeout 10}) 506 | (s/put-all! src (range 10)) 507 | 508 | (t/in 100 509 | (fn [] 510 | (is (s/closed? sink)) 511 | (is (s/closed? src)) 512 | (done)))))) 513 | -------------------------------------------------------------------------------- /src/manifold_cljs/deferred.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.deferred 2 | (:refer-clojure :exclude [realized?]) 3 | (:require [manifold-cljs.deferred.default-impl :as d] 4 | [manifold-cljs.deferred.core :as core] 5 | [manifold-cljs.executor :as ex] 6 | [manifold-cljs.time :as time]) 7 | (:require-macros [manifold-cljs.deferred :refer [success-error-unrealized]])) 8 | 9 | (defprotocol Deferrable 10 | (^:private to-deferred [_] "Provides a conversion mechanism to manifold deferreds.")) 11 | 12 | ;; - no definline 13 | (defn realized? 14 | "Returns true if the manifold deferred is realized." 15 | [x] (core/realized x)) 16 | 17 | ;; - definline -> defn 18 | (defn success-value [x default-value] 19 | (core/successValue x default-value)) 20 | 21 | ;; - definline -> defn 22 | (defn error-value [x default-value] 23 | (core/errorValue x default-value)) 24 | 25 | ;; - definline -> defn 26 | (defn on-realized 27 | "Registers callbacks with the manifold deferred for both success and error outcomes." 28 | [x on-success on-error] 29 | (do 30 | (core/onRealized x on-success on-error) 31 | x)) 32 | 33 | ;; - instance? -> satisfies? 34 | (defn deferred? 35 | "Returns true if the object is an instance of a Manifold deferred." 36 | [x] (satisfies? core/IDeferred x)) 37 | 38 | ;; - instance? -> satisfies? 39 | (defn- satisfies-deferrable? 40 | [x] (satisfies? Deferrable x)) 41 | 42 | ;; no IPending support 43 | (defn deferrable? 44 | "Returns true if the object can be coerced to a Manifold deferred." 45 | [x] 46 | (or 47 | (deferred? x) 48 | (satisfies-deferrable? x))) 49 | 50 | ;; - cannot coerce IDeref + IPending 51 | ;; - throws ex-info 52 | (defn ->deferred 53 | "Transforms `x` into a deferred if possible, or returns `default-val`. If no default value 54 | is given, an `IllegalArgumentException` is thrown." 55 | ([x] 56 | (let [x' (->deferred x ::none)] 57 | (if (keyword-identical? ::none x') 58 | (throw 59 | (ex-info (str "cannot convert " (type x) " to deferred.") {})) 60 | x'))) 61 | ([x default-val] 62 | (cond 63 | (deferred? x) 64 | x 65 | 66 | (satisfies-deferrable? x) 67 | (to-deferred x) 68 | 69 | :else 70 | default-val))) 71 | 72 | ;; - moved to manifold-cljs.deferred.core 73 | (def ^{:doc "Creates a listener which can be registered or cancelled via 74 | `add-listener!` and `cancel-listener!`."} 75 | listener core/listener) 76 | 77 | ;; - definiline -> defn 78 | (defn success! 79 | "Equivalent to `deliver`, but allows a `claim-token` to be passed in." 80 | ([deferred x] 81 | (core/success deferred x)) 82 | ([deferred x claim-token] 83 | (core/success deferred x claim-token))) 84 | 85 | ;; - definiline -> defn 86 | (defn error! 87 | "Puts the deferred into an error state." 88 | ([deferred x] 89 | (core/error deferred x)) 90 | ([deferred x claim-token] 91 | (core/error deferred x claim-token))) 92 | 93 | ;; - definiline -> defn 94 | (defn claim! 95 | "Attempts to claim the deferred for future updates. If successful, a claim token is returned, otherwise returns `nil`." 96 | [deferred] 97 | (core/claim deferred)) 98 | 99 | ;; - definiline -> defn 100 | (defn add-listener! 101 | "Registers a listener which can be cancelled via `cancel-listener!`. Unless this is useful, prefer `on-realized`." 102 | [deferred listener] 103 | (core/addListener deferred listener)) 104 | 105 | ;; - definiline -> defn 106 | (defn cancel-listener! 107 | "Cancels a listener which has been registered via `add-listener!`." 108 | [deferred listener] 109 | (core/cancelListener deferred listener)) 110 | 111 | (defn deferred 112 | "Equivalent to Clojure's `promise`, but also allows asynchronous callbacks to be registered 113 | and composed via `chain`." 114 | ([] (deferred (ex/executor))) 115 | ([executor] (d/deferred executor))) 116 | 117 | (defn success-deferred 118 | "A deferred which already contains a realized value" 119 | ([val] (success-deferred val (ex/executor))) 120 | ([val executor] (d/success-deferred val executor))) 121 | 122 | (defn error-deferred 123 | "A deferred which already contains a realized error" 124 | ([error] (error-deferred error (ex/executor))) 125 | ([error executor] (d/error-deferred error executor))) 126 | 127 | ;; identical? -> keyword-identical? 128 | (defn unwrap' [x] 129 | (if (deferred? x) 130 | (let [val (success-value x ::none)] 131 | (if (keyword-identical? val ::none) 132 | x 133 | (recur val))) 134 | x)) 135 | 136 | ;; same 137 | (defn unwrap [x] 138 | (let [d (->deferred x nil)] 139 | (if (nil? d) 140 | x 141 | (let [val (success-value d ::none)] 142 | (if (keyword-identical? ::none val) 143 | d 144 | (recur val)))))) 145 | 146 | ;; `instance? IDeferred` -> `deferred?` 147 | (defn connect 148 | "Conveys the realized value of `a` into `b`." 149 | [a b] 150 | (assert (deferred? b) "sink `b` must be a Manifold deferred") 151 | (let [a (unwrap a)] 152 | (if (deferred? a) 153 | (if (realized? b) 154 | false 155 | (do 156 | (on-realized a 157 | #(let [a' (unwrap %)] 158 | (if (deferred? a') 159 | (connect a' b) 160 | (success! b a'))) 161 | #(error! b %)) 162 | true)) 163 | (success! b a)))) 164 | 165 | ;; - inline `subscribe` 166 | ;; - less unrolled arities 167 | ;; - Throwable -> js/Error 168 | (defn chain'- 169 | ([d x] 170 | (try 171 | (let [x' (unwrap' x)] 172 | 173 | (if (deferred? x') 174 | 175 | (let [d (or d (deferred))] 176 | (on-realized x' 177 | #(chain'- d %) 178 | #(error! d %)) 179 | d) 180 | 181 | (if (nil? d) 182 | (success-deferred x') 183 | (success! d x')))) 184 | (catch js/Error e 185 | (if (nil? d) 186 | (error-deferred e) 187 | (error! d e))))) 188 | 189 | ([d x f] 190 | (try 191 | (let [x' (unwrap' x)] 192 | 193 | (if (deferred? x') 194 | 195 | (let [d (or d (deferred))] 196 | (on-realized x' 197 | #(chain'- d % f) 198 | #(error! d %)) 199 | d) 200 | 201 | (let [x'' (f x')] 202 | (if (deferred? x'') 203 | (chain'- d x'') 204 | (if (nil? d) 205 | (success-deferred x'') 206 | (success! d x'')))))) 207 | (catch js/Error e 208 | (if (nil? d) 209 | (error-deferred e) 210 | (error! d e))))) 211 | 212 | ([d x f & fs] 213 | (when (or (nil? d) (not (realized? d))) 214 | (let [d (or d (deferred))] 215 | (clojure.core/loop [x x, fs (list* f fs)] 216 | (if (empty? fs) 217 | (success! d x) 218 | (let [[f & fs] fs 219 | d' (chain'- nil x f)] 220 | (success-error-unrealized d' 221 | val (recur val fs) 222 | err (error! d err) 223 | (on-realized d' 224 | #(apply chain'- d % fs) 225 | #(error! d %)))))) 226 | d)))) 227 | 228 | ;; - inline `subscribe` 229 | ;; - less unrolled arities 230 | ;; - Throwable -> js/Error 231 | (defn chain- 232 | ([d x] 233 | (let [x' (unwrap x)] 234 | 235 | (if (deferred? x') 236 | 237 | (let [d (or d (deferred))] 238 | (on-realized x' 239 | #(chain- d %) 240 | #(error! d %)) 241 | d) 242 | 243 | (if (nil? d) 244 | (success-deferred x') 245 | (success! d x'))))) 246 | ([d x f] 247 | (if (or (nil? d) (not (realized? d))) 248 | (try 249 | (let [x' (unwrap x)] 250 | 251 | (if (deferred? x') 252 | 253 | (let [d (or d (deferred))] 254 | (on-realized x' 255 | #(chain- d % f) 256 | #(error! d %)) 257 | d) 258 | 259 | (let [x'' (f x')] 260 | (if (deferrable? x'') 261 | (chain- d x'') 262 | (if (nil? d) 263 | (success-deferred x'') 264 | (success! d x'')))))) 265 | (catch js/Error e 266 | (if (nil? d) 267 | (error-deferred e) 268 | (error! d e)))) 269 | d)) 270 | ([d x f & fs] 271 | (when (or (nil? d) (not (realized? d))) 272 | (let [d (or d (deferred))] 273 | (clojure.core/loop [x x, fs (list* f fs)] 274 | (if (empty? fs) 275 | (success! d x) 276 | (let [[f & fs] fs 277 | d' (deferred) 278 | _ (chain- d' x f)] 279 | (success-error-unrealized d 280 | val (recur val fs) 281 | err (error! d err) 282 | (on-realized d' 283 | #(apply chain- d % fs) 284 | #(error! d %)))))) 285 | d)))) 286 | 287 | ;; - removed inline block 288 | ;; - less unrolled arities 289 | (defn chain' 290 | "Like `chain`, but does not coerce deferrable values. This is useful when 291 | coercion is undesired." 292 | ([x] 293 | (chain'- nil x identity)) 294 | ([x f] 295 | (chain'- nil x f)) 296 | ([x f & fs] 297 | (apply chain'- nil x f fs))) 298 | 299 | ;; - removed inline block 300 | ;; - less unrolled arities 301 | (defn chain 302 | "Composes functions, left to right, over the value `x`, returning a deferred containing 303 | the result. When composing, either `x` or the returned values may be values which can 304 | be converted to a deferred, causing the composition to be paused. 305 | 306 | The returned deferred will only be realized once all functions have been applied and their 307 | return values realized. 308 | 309 | @(chain 1 inc #(async (inc %))) => 3 310 | 311 | @(chain (success-deferred 1) inc inc) => 3 312 | 313 | " 314 | ([x] 315 | (chain- nil x identity)) 316 | ([x f] 317 | (chain- nil x f)) 318 | ([x f & fs] 319 | (apply chain- nil x f fs))) 320 | 321 | ;; - Throwable -> js/Error 322 | (defn catch' 323 | "Like `catch`, but does not coerce deferrable values." 324 | ([x error-handler] 325 | (catch' x nil error-handler)) 326 | ([x error-class error-handler] 327 | (let [x (chain' x) 328 | catch? #(or (nil? error-class) (instance? error-class %))] 329 | (if-not (deferred? x) 330 | 331 | ;; not a deferred value, skip over it 332 | x 333 | 334 | (success-error-unrealized x 335 | val x 336 | 337 | err (try 338 | (if (catch? err) 339 | (chain' (error-handler err)) 340 | (error-deferred err)) 341 | (catch js/Error e 342 | (error-deferred e))) 343 | 344 | (let [d' (deferred)] 345 | 346 | (on-realized x 347 | #(success! d' %) 348 | #(try 349 | (if (catch? %) 350 | (chain'- d' (error-handler %)) 351 | (chain'- d' (error-deferred %))) 352 | (catch js/Error e 353 | (error! d' e)))) 354 | 355 | d')))))) 356 | 357 | ;; - Throwable -> js/Error 358 | (defn catch 359 | "An equivalent of the catch clause, which takes an `error-handler` function that will be invoked 360 | with the exception, and whose return value will be yielded as a successful outcome. If an 361 | `error-class` is specified, only exceptions of that type will be caught. If not, all exceptions 362 | will be caught. 363 | 364 | (-> d 365 | (chain f g h) 366 | (catch MyError #(str \"oh no: \" (.getMessage %))) 367 | (catch #(str \"something unexpected: \" (.getMessage %)))) 368 | 369 | " 370 | ([x error-handler] 371 | (catch x nil error-handler)) 372 | ([x error-class error-handler] 373 | (if-let [d (->deferred x nil)] 374 | (-> d 375 | chain 376 | (catch' error-class error-handler) 377 | chain) 378 | x))) 379 | 380 | ;; - Throwable -> js/Error 381 | (defn finally' 382 | "Like `finally`, but doesn't coerce deferrable values." 383 | [x f] 384 | (success-error-unrealized x 385 | 386 | val (try 387 | (f) 388 | x 389 | (catch js/Error e 390 | (error-deferred e))) 391 | 392 | err (try 393 | (f) 394 | (error-deferred err) 395 | (catch js/Error e 396 | (error-deferred e))) 397 | 398 | (let [d (deferred)] 399 | (on-realized x 400 | #(try 401 | (f) 402 | (success! d %) 403 | (catch js/Error e 404 | (error! d e))) 405 | #(try 406 | (f) 407 | (error! d %) 408 | (catch js/Error e 409 | (error! d e)))) 410 | d))) 411 | 412 | ;; same 413 | (defn finally 414 | "An equivalent of the finally clause, which takes a no-arg side-effecting function that executes 415 | no matter what the result." 416 | [x f] 417 | (if-let [d (->deferred x nil)] 418 | (finally' d f) 419 | (finally' x f))) 420 | 421 | ;; - remove type tags 422 | ;; - AtomicInteger -> volatile 423 | (defn zip' 424 | "Like `zip`, but only unwraps Manifold deferreds." 425 | [& vals] 426 | (let [cnt (count vals) 427 | ary (object-array cnt) 428 | counter (volatile! cnt)] 429 | (clojure.core/loop [d nil, idx 0, s vals] 430 | 431 | (if (empty? s) 432 | 433 | ;; no further results, decrement the counter one last time 434 | ;; and return the result if everything else has been realized 435 | (if (zero? @counter) 436 | (success-deferred (or (seq ary) (list))) 437 | d) 438 | 439 | (let [x (first s) 440 | rst (rest s) 441 | idx' (unchecked-inc idx)] 442 | (if (deferred? x) 443 | 444 | (success-error-unrealized x 445 | 446 | val (do 447 | (aset ary idx val) 448 | (vswap! counter dec) 449 | (recur d idx' rst)) 450 | 451 | err (error-deferred err) 452 | 453 | (let [d (or d (deferred))] 454 | (on-realized (chain' x) 455 | (fn [val] 456 | (aset ary idx val) 457 | (when (zero? (vswap! counter dec)) 458 | (success! d (seq ary)))) 459 | (fn [err] 460 | (error! d err))) 461 | (recur d idx' rst))) 462 | 463 | ;; not deferred - set, decrement, and recur 464 | (do 465 | (aset ary idx x) 466 | (vswap! counter dec) 467 | (recur d idx' rst)))))))) 468 | 469 | ;; - remove inline block 470 | (defn zip 471 | "Takes a list of values, some of which may be deferrable, and returns a deferred that will yield a list 472 | of realized values. 473 | 474 | @(zip 1 2 3) => [1 2 3] 475 | @(zip (async 1) 2 3) => [1 2 3] 476 | 477 | " 478 | [& vals] 479 | (->> vals 480 | (map #(or (->deferred % nil) %)) 481 | (apply zip'))) 482 | 483 | ;; https://github.com/ztellman/manifold/pull/102 484 | ;; not in Manifold proper 485 | ;; same technique as clojure.core.async/random-array 486 | ;; same as clj 487 | ;; - set zero element to zero (JS arrays have nils by default) 488 | (defn- random-array [n] 489 | (let [a (int-array n)] 490 | (aset a 0 0) 491 | (clojure.core/loop [i 1] 492 | (if (= i n) 493 | a 494 | (let [j (rand-int (inc i))] 495 | (aset a i (aget a j)) 496 | (aset a j i) 497 | (recur (inc i))))))) 498 | 499 | ;; same as clj 500 | (defn alt' 501 | "Like `alt`, but only unwraps Manifold deferreds." 502 | [& vals] 503 | (let [d (deferred) 504 | cnt (count vals) 505 | ^ints idxs (random-array cnt)] 506 | (clojure.core/loop [i 0] 507 | (when (< i cnt) 508 | (let [i' (aget idxs i) 509 | x (nth vals i')] 510 | (if (deferred? x) 511 | (success-error-unrealized x 512 | val (success! d val) 513 | err (error! d err) 514 | (do (on-realized (chain' x) 515 | #(success! d %) 516 | #(error! d %)) 517 | (recur (inc i)))) 518 | (success! d x))))) 519 | d)) 520 | 521 | (defn alt 522 | "Takes a list of values, some of which may be deferrable, and returns a 523 | deferred that will yield the value which was realized first. 524 | 525 | @(alt 1 2) => 1 526 | @(alt (future (Thread/sleep 1) 1) 527 | (future (Thread/sleep 1) 2)) => 1 or 2 depending on the thread scheduling 528 | 529 | Values appearing earlier in the input are preferred." 530 | [& vals] 531 | (->> vals 532 | (map #(or (->deferred % nil) %)) 533 | (apply alt'))) 534 | 535 | ;; - TimeoutException -> ex-info 536 | (defn timeout! 537 | "Takes a deferred, and sets a timeout on it, such that it will be realized as `timeout-value` 538 | (or a TimeoutException if none is specified) if it is not realized in `interval` ms. Returns 539 | the deferred that was passed in. 540 | 541 | This will act directly on the deferred value passed in. If the deferred represents a value 542 | returned by `chain`, all actions not yet completed will be short-circuited upon timeout." 543 | ([d interval] 544 | (cond 545 | (or (nil? interval) (not (deferred? d)) (realized? d)) 546 | nil 547 | 548 | (not (pos? interval)) 549 | (error! d 550 | (ex-info 551 | (str "timed out after " interval " milliseconds") {})) 552 | 553 | :else 554 | (time/in interval 555 | #(error! d 556 | (ex-info 557 | (str "timed out after " interval " milliseconds") {})))) 558 | d) 559 | ([d interval timeout-value] 560 | (cond 561 | (or (nil? interval) (not (deferred? d)) (realized? d)) 562 | nil 563 | 564 | (not (pos? interval)) 565 | (success! d timeout-value) 566 | 567 | :else 568 | (time/in interval #(success! d timeout-value))) 569 | d)) 570 | 571 | ;; same 572 | (deftype Recur [s] 573 | IDeref 574 | (-deref [_] s)) 575 | 576 | ;; same 577 | (defn recur 578 | "A special recur that can be used with `manifold.deferred/loop`." 579 | [& args] 580 | (Recur. args)) 581 | 582 | ;; cljs specific 583 | (defn time* [deferred-fn] 584 | (let [start (system-time) 585 | announce #(prn (str "Elapsed time: " 586 | (.toFixed (- (system-time) start) 6) 587 | " msecs")) 588 | d (deferred-fn)] 589 | (on-realized d announce announce) 590 | d)) 591 | -------------------------------------------------------------------------------- /src/manifold_cljs/stream.cljs: -------------------------------------------------------------------------------- 1 | (ns manifold-cljs.stream 2 | (:refer-clojure :exclude [map filter repeatedly reductions reduce mapcat concat]) 3 | (:require [clojure.core :as clj] 4 | [manifold-cljs.stream.core :as core] 5 | [manifold-cljs.stream.default-impl :as default] 6 | [manifold-cljs.stream.graph :as g] 7 | [manifold-cljs.time :as time] 8 | [manifold-cljs.utils :as u] 9 | [manifold-cljs.deferred :as d] 10 | [manifold-cljs.executor :as e] 11 | [manifold-cljs.impl.logging :as log] 12 | 13 | [manifold-cljs.stream.seq :as sq])) 14 | 15 | ;; - IEventSink is a protocol 16 | ;; - remove utils/fast-satisfies 17 | (defn sinkable? [x] 18 | (or 19 | (satisfies? core/IEventSink x) 20 | (satisfies? core/Sinkable x))) 21 | 22 | ;; - IEventSource is a protocol 23 | ;; - remove utils/fast-satisfies 24 | (defn sourceable? [x] 25 | (or 26 | (satisfies? core/IEventSource x) 27 | (satisfies? core/Sourceable x))) 28 | 29 | ;; - identical? -> keyword-identical? 30 | ;; - IEventSink is a protocol 31 | ;; - IllegalArgumentException -> js/Error 32 | (defn ->sink 33 | "Converts, if possible, the object to a Manifold sink, or `default-val` if it cannot. If no 34 | default value is given, an exception is thrown." 35 | ([x] 36 | (let [x' (->sink x ::none)] 37 | (if (keyword-identical? ::none x') 38 | (throw 39 | (js/Error. 40 | (str "cannot convert " (type x) " to sink"))) 41 | x'))) 42 | ([x default-val] 43 | (cond 44 | (satisfies? core/IEventSink x) x 45 | (sinkable? x) (core/to-sink x) 46 | :else default-val))) 47 | 48 | ;; - identical? -> keyword-identical? 49 | ;; - IEventSource is a protocol 50 | ;; - IllegalArgumentException -> js/Error 51 | (defn ->source 52 | "Converts, if possible, the object to a Manifold source, or `default-val` if it cannot. If no 53 | default value is given, an exception is thrown." 54 | ([x] 55 | (let [x' (->source x ::none)] 56 | (if (keyword-identical? ::none x') 57 | (throw 58 | (js/Error. 59 | (str "cannot convert " (type x) " to source"))) 60 | x'))) 61 | ([x default-val] 62 | (cond 63 | (satisfies? core/IEventSource x) x 64 | (sourceable? x) (core/to-source x) 65 | (sq/seq-source? x) (sq/to-source x) 66 | :else default-val))) 67 | 68 | ;; - interface method calls -> protocols 69 | ;; - remove type annotations 70 | (deftype SinkProxy [sink] 71 | core/IEventStream 72 | (description [_] 73 | (core/description sink)) 74 | (isSynchronous [_] 75 | (core/isSynchronous sink)) 76 | (downstream [_] 77 | (core/downstream sink)) 78 | (close [_] 79 | (core/close sink)) 80 | (weakHandle [_ ref-queue] 81 | (core/weakHandle sink ref-queue)) 82 | core/IEventSink 83 | (put [_ x blocking?] 84 | (core/put sink x blocking?)) 85 | (put [_ x blocking? timeout timeout-val] 86 | (core/put sink x blocking? timeout timeout-val)) 87 | (isClosed [_] 88 | (core/isClosed sink)) 89 | (onClosed [_ callback] 90 | (core/onClosed sink callback))) 91 | 92 | (declare connect) 93 | 94 | ;; - interface method calls -> protocols 95 | ;; - remove type annotations 96 | (deftype SourceProxy [source] 97 | core/IEventStream 98 | (description [_] 99 | (core/description source)) 100 | (isSynchronous [_] 101 | (core/isSynchronous source)) 102 | (downstream [_] 103 | (core/downstream source)) 104 | (close [_] 105 | (core/close source)) 106 | (weakHandle [_ ref-queue] 107 | (core/weakHandle source ref-queue)) 108 | core/IEventSource 109 | (take [_ default-val blocking?] 110 | (core/take source default-val blocking?)) 111 | (take [_ default-val blocking? timeout timeout-val] 112 | (core/take source default-val blocking? timeout timeout-val)) 113 | (isDrained [_] 114 | (core/isDrained source)) 115 | (onDrained [_ callback] 116 | (core/onDrained source callback)) 117 | (connector [_ sink] 118 | (fn [_ sink options] 119 | (connect source sink options)))) 120 | 121 | ;; same 122 | (defn source-only 123 | "Returns a view of the stream which is only a source." 124 | [s] 125 | (SourceProxy. s)) 126 | 127 | ;; same 128 | (defn sink-only 129 | "Returns a view of the stream which is only a sink." 130 | [s] 131 | (SinkProxy. s)) 132 | 133 | ;; - definline -> defn 134 | ;; - interface -> protocol 135 | (defn stream? 136 | "Returns true if the object is a Manifold stream." 137 | [x] (satisfies? core/IEventStream x)) 138 | 139 | ;; - definline -> defn 140 | ;; - interface -> protocol 141 | (defn source? 142 | "Returns true if the object is a Manifold source." 143 | [x] (satisfies? core/IEventSource x)) 144 | 145 | ;; - definline -> defn 146 | ;; - interface -> protocol 147 | (defn sink? 148 | "Returns true if the object is a Manifold sink." 149 | [x] (satisfies? core/IEventSink x)) 150 | 151 | ;; - definline -> defn 152 | ;; - interface -> protocol 153 | (defn description 154 | "Returns a description of the stream." 155 | [x] (core/description x)) 156 | 157 | ;; - definline -> defn 158 | ;; - interface -> protocol 159 | (defn downstream 160 | "Returns all sinks downstream of the given source as a sequence of 2-tuples, with the 161 | first element containing the connection's description, and the second element containing 162 | the sink." 163 | [x] (core/downstream x)) 164 | 165 | ;; - definline -> defn 166 | ;; - interface -> protocol 167 | (defn weak-handle 168 | "Returns a weak reference that can be used to construct topologies of streams." 169 | [x] (core/weakHandle x nil)) 170 | 171 | ;; - definline -> defn 172 | ;; - interface -> protocol 173 | (defn synchronous? 174 | "Returns true if the underlying abstraction behaves synchronously, using thread blocking 175 | to provide backpressure." 176 | [x] (core/isSynchronous x)) 177 | 178 | ;; - definline -> defn 179 | ;; - interface -> protocol 180 | (defn close! 181 | "Closes a source or sink, so that it can't emit or accept any more messages." 182 | [sink] (core/close sink)) 183 | 184 | ;; - definline -> defn 185 | ;; - interface -> protocol 186 | (defn closed? 187 | "Returns true if the event sink is closed." 188 | [sink] (core/isClosed sink)) 189 | 190 | ;; - definline -> defn 191 | ;; - interface -> protocol 192 | (defn on-closed 193 | "Registers a no-arg callback which is invoked when the sink is closed." 194 | [sink callback] (core/onClosed sink callback)) 195 | 196 | ;; - definline -> defn 197 | ;; - interface -> protocol 198 | (defn drained? 199 | "Returns true if the event source is drained." 200 | [source] (core/isDrained source)) 201 | 202 | ;; - definline -> defn 203 | ;; - interface -> protocol 204 | (defn on-drained 205 | "Registers a no-arg callback which is invoked when the source is drained." 206 | [source callback] (core/onDrained source callback)) 207 | 208 | ;; - remove inline 209 | (defn put! 210 | "Puts a value into a sink, returning a deferred that yields `true` if it succeeds, 211 | and `false` if it fails. Guaranteed to be non-blocking." 212 | ([^IEventSink sink x] 213 | (core/put sink x false))) 214 | 215 | ;; same 216 | (defn put-all! 217 | "Puts all values into the sink, returning a deferred that yields `true` if all puts 218 | are successful, or `false` otherwise. If the sink provides backpressure, will 219 | pause. Guaranteed to be non-blocking." 220 | [^IEventSink sink msgs] 221 | (d/loop [msgs msgs] 222 | (if (empty? msgs) 223 | true 224 | (d/chain' (put! sink (first msgs)) 225 | (fn [result] 226 | (if result 227 | (d/recur (rest msgs)) 228 | false)))))) 229 | 230 | ;; - remove inline 231 | (defn try-put! 232 | "Puts a value into a stream if the put can successfully be completed in `timeout` 233 | milliseconds. Returns a promiise that yields `true` if it succeeds, and `false` 234 | if it fails or times out. Guaranteed to be non-blocking. 235 | 236 | A special `timeout-val` may be specified, if it is important to differentiate 237 | between failure due to timeout and other failures." 238 | ([^IEventSink sink x ^double timeout] 239 | (core/put sink x false timeout false)) 240 | ([^IEventSink sink x ^double timeout timeout-val] 241 | (core/put sink x false timeout timeout-val))) 242 | 243 | ;; - remove inline 244 | (defn take! 245 | "Takes a value from a stream, returning a deferred that yields the value when it 246 | is available, or `nil` if the take fails. Guaranteed to be non-blocking. 247 | 248 | A special `default-val` may be specified, if it is important to differentiate 249 | between actual `nil` values and failures." 250 | ([^IEventSource source] 251 | (core/take source nil false)) 252 | ([^IEventSource source default-val] 253 | (core/take source default-val false))) 254 | 255 | ;; - remove inline 256 | (defn try-take! 257 | "Takes a value from a stream, returning a deferred that yields the value if it is 258 | available within `timeout` milliseconds, or `nil` if it fails or times out. 259 | Guaranteed to be non-blocking. 260 | 261 | Special `timeout-val` and `default-val` values may be specified, if it is 262 | important to differentiate between actual `nil` values and failures." 263 | ([^IEventSource source ^double timeout] 264 | (core/take source nil false timeout nil)) 265 | ([^IEventSource source default-val ^double timeout timeout-val] 266 | (core/take source default-val false timeout timeout-val))) 267 | 268 | (defn connect 269 | "Connects a source to a sink, propagating all messages from the former into the latter. 270 | 271 | Optionally takes a map of parameters: 272 | 273 | |:---|:--- 274 | | `upstream?` | if closing the sink should always close the source, even if there are other sinks downstream of the source. Defaults to `false`. Note that if the sink is the only thing downstream of the source, the source will always be closed, unless it is permanent. 275 | | `downstream?` | if closing the source will close the sink. Defaults to `true`. 276 | | `timeout` | if defined, the maximum time, in milliseconds, that will be spent trying to put a message into the sink before closing it. Useful when there are multiple sinks downstream of a source, and you want to avoid a single backed up sink from blocking all the others. 277 | | `description` | describes the connection, useful for traversing the stream topology via `downstream`." 278 | {:arglists 279 | '[[source sink] 280 | [source 281 | sink 282 | {:keys [upstream? 283 | downstream? 284 | timeout 285 | description] 286 | :or {upstream? false 287 | downstream? true}}]]} 288 | ([source sink] 289 | (connect source sink nil)) 290 | ([source sink options] 291 | (let [source (->source source) 292 | sink (->sink sink) 293 | connector (core/connector source sink)] 294 | (if connector 295 | (connector source sink options) 296 | (g/connect source sink options)) 297 | nil))) 298 | 299 | ;;; 300 | 301 | ;; same 302 | (defn stream 303 | "Returns a Manifold stream with a configurable `buffer-size`. If a capacity is specified, 304 | `put!` will yield `true` when the message is in the buffer. Otherwise it will only yield 305 | `true` once it has been consumed. 306 | 307 | `xform` is an optional transducer, which will transform all messages that are enqueued 308 | via `put!` before they are dequeued via `take!`. 309 | 310 | `executor`, if defined, specifies which java.util.concurrent.Executor will be used to 311 | handle the deferreds returned by `put!` and `take!`." 312 | ([] 313 | (default/stream)) 314 | ([buffer-size] 315 | (default/stream buffer-size)) 316 | ([buffer-size xform] 317 | (default/stream buffer-size xform)) 318 | ([buffer-size xform executor] 319 | (default/stream buffer-size xform executor))) 320 | 321 | ;; same 322 | (defn stream* 323 | "An alternate way to build a stream, via a map of parameters. 324 | 325 | |:---|:--- 326 | | `permanent?` | if `true`, the channel cannot be closed 327 | | `buffer-size` | the number of messages that can accumulate in the channel before backpressure is applied 328 | | `description` | the description of the channel, which is a single arg function that takes the base properties and returns an enriched map. 329 | | `executor` | the `manifold-cljs.executor/Executor` that will execute all callbacks registered on the deferreds returns by `put!` and `take!` 330 | | `xform` | a transducer which will transform all messages that are enqueued via `put!` before they are dequeued via `take!`." 331 | {:arglists '[[{:keys [permanent? buffer-size description executor xform]}]]} 332 | [options] 333 | (default/stream* options)) 334 | 335 | ;;; 336 | 337 | ;; - removed type annotations, lock, meta 338 | ;; - interface method calls -> protocol calls 339 | (deftype SplicedStream [sink source] 340 | core/IEventStream 341 | (isSynchronous [_] 342 | (or (synchronous? sink) 343 | (synchronous? source))) 344 | (description [_] 345 | {:type "splice" 346 | :sink (core/description sink) 347 | :source (core/description source)}) 348 | (downstream [_] 349 | (core/downstream source)) 350 | (close [_] 351 | (core/close source) 352 | (core/close sink)) 353 | (weakHandle [_ ref-queue] 354 | (core/weakHandle source ref-queue)) 355 | 356 | core/IEventSink 357 | (put [_ x blocking?] 358 | (core/put sink x blocking?)) 359 | (put [_ x blocking? timeout timeout-val] 360 | (core/put sink x blocking? timeout timeout-val)) 361 | (isClosed [_] 362 | (core/isClosed sink)) 363 | (onClosed [_ callback] 364 | (core/onClosed sink callback)) 365 | 366 | core/IEventSource 367 | (take [_ default-val blocking?] 368 | (core/take source default-val blocking?)) 369 | (take [_ default-val blocking? timeout timeout-val] 370 | (core/take source default-val blocking? timeout timeout-val)) 371 | (isDrained [_] 372 | (core/isDrained source)) 373 | (onDrained [_ callback] 374 | (core/onDrained source callback)) 375 | (connector [_ sink] 376 | (core/connector source sink))) 377 | 378 | (defn splice 379 | "Splices together two halves of a stream, such that all messages enqueued via `put!` go 380 | into `sink`, and all messages dequeued via `take!` come from `source`." 381 | [sink source] 382 | (SplicedStream. (->sink sink) (->source source))) 383 | 384 | ;;; 385 | 386 | ;; - protocols 387 | ;; - Throwable, IAE -> js/Error 388 | (deftype Callback 389 | [f 390 | close-callback 391 | downstream 392 | constant-response] 393 | core/IEventStream 394 | (isSynchronous [_] 395 | false) 396 | (close [_] 397 | (when close-callback 398 | (e/execute-on-next-tick close-callback))) 399 | (weakHandle [_ ref-queue] 400 | (if downstream 401 | (core/weakHandle downstream ref-queue) 402 | (throw (js/Error. "No downstream!")))) 403 | (description [_] 404 | {:type "callback"}) 405 | (downstream [_] 406 | (when downstream 407 | [[(description downstream) downstream]])) 408 | core/IEventSink 409 | (put [this x _] 410 | (try 411 | (let [rsp (f x)] 412 | (if (nil? constant-response) 413 | rsp 414 | constant-response)) 415 | (catch js/Error e 416 | (log/error e "error in stream handler") 417 | (core/close this) 418 | (d/success-deferred false)))) 419 | (put [this x default-val _ _] 420 | (core/put this x default-val)) 421 | (isClosed [_] 422 | (if downstream 423 | (core/isClosed downstream) 424 | false)) 425 | (onClosed [_ callback] 426 | (when downstream 427 | (core/onClosed downstream callback)))) 428 | 429 | ;; same 430 | (let [result (d/success-deferred true)] 431 | (defn consume 432 | "Feeds all messages from `source` into `callback`. 433 | 434 | Messages will be processed as quickly as the callback can be executed. Returns 435 | a deferred which yields `true` when `source` is exhausted." 436 | [callback source] 437 | (let [complete (d/deferred)] 438 | (connect source (Callback. callback #(d/success! complete true) nil result) nil) 439 | complete))) 440 | 441 | ;; same 442 | (defn consume-async 443 | "Feeds all messages from `source` into `callback`, which must return a deferred yielding 444 | `true` or `false`. If the returned value yields `false`, the consumption will be cancelled. 445 | 446 | Messages will be processed only as quickly as the deferred values are realized. Returns a 447 | deferred which yields `true` when `source` is exhausted or `callback` yields `false`." 448 | [callback source] 449 | (let [complete (d/deferred) 450 | callback #(d/chain % 451 | callback 452 | (fn [result] 453 | (when (false? result) 454 | (d/success! complete true)) 455 | result))] 456 | (connect source (Callback. callback #(d/success! complete true) nil nil) nil) 457 | complete)) 458 | 459 | ;; same 460 | (defn connect-via 461 | "Feeds all messages from `src` into `callback`, with the understanding that they will 462 | eventually be propagated into `dst` in some form. The return value of `callback` 463 | should be a deferred yielding either `true` or `false`. When `false`, the downstream 464 | sink is assumed to be closed, and the connection is severed. 465 | 466 | Returns a deferred which yields `true` when `src` is exhausted or `callback` yields `false`." 467 | ([src callback dst] 468 | (connect-via src callback dst nil)) 469 | ([src callback dst options] 470 | (let [dst (->sink dst) 471 | complete (d/deferred) 472 | close-callback #(do 473 | (close! dst) 474 | (d/success! complete true))] 475 | (connect 476 | src 477 | (Callback. callback close-callback dst nil) 478 | options) 479 | complete))) 480 | 481 | ;; same 482 | (defn- connect-via-proxy 483 | ([src proxy dst] 484 | (connect-via-proxy src proxy dst nil)) 485 | ([src proxy dst options] 486 | (let [dst (->sink dst) 487 | proxy (->sink proxy) 488 | complete (d/deferred) 489 | close-callback #(do 490 | (close! proxy) 491 | (d/success! complete true))] 492 | (connect 493 | src 494 | (Callback. #(put! proxy %) close-callback dst nil) 495 | options) 496 | complete))) 497 | 498 | ;; same 499 | (defn drain-into 500 | "Takes all messages from `src` and puts them into `dst`, and returns a deferred that 501 | yields `true` once `src` is drained or `dst` is closed. If `src` is closed or drained, 502 | `dst` will not be closed." 503 | [src dst] 504 | (let [dst (->sink dst) 505 | complete (d/deferred)] 506 | (connect 507 | src 508 | (Callback. #(put! dst %) #(d/success! complete true) dst nil) 509 | {:description "drain-into"}) 510 | complete)) 511 | 512 | ;;; 513 | 514 | ;; - no stream->seq as we can't block 515 | 516 | ;; - Throwable -> js/Error 517 | ;; - System/currentTimeMillis -> time/current-millis 518 | (defn- periodically- 519 | [stream period initial-delay f] 520 | (let [cancel (atom nil)] 521 | (reset! cancel 522 | (time/every period initial-delay 523 | (fn [] 524 | (try 525 | (let [d (if (closed? stream) 526 | (d/success-deferred false) 527 | (put! stream (f)))] 528 | (if (realized? d) 529 | (when-not @d 530 | (do 531 | (@cancel) 532 | (close! stream))) 533 | (do 534 | (@cancel) 535 | (d/chain' d 536 | (fn [x] 537 | (if-not x 538 | (close! stream) 539 | (periodically- stream period (- period (rem (time/current-millis) period)) f))))))) 540 | (catch js/Error e 541 | (@cancel) 542 | (close! stream) 543 | (log/error e "error in 'periodically' callback")))))))) 544 | 545 | ;; - System/currentTimeMillis -> time/current-millis 546 | (defn periodically 547 | "Creates a stream which emits the result of invoking `(f)` every `period` milliseconds." 548 | ([period initial-delay f] 549 | (let [s (stream 1)] 550 | (periodically- s period initial-delay f) 551 | (source-only s))) 552 | ([period f] 553 | (periodically period (- period (rem (time/current-millis) period)) f))) 554 | 555 | (declare zip) 556 | 557 | ;; - remove type annotation 558 | (defn transform 559 | "Takes a transducer `xform` and returns a source which applies it to source `s`. A buffer-size 560 | may optionally be defined for the output source." 561 | ([xform s] 562 | (transform xform 0 s)) 563 | ([xform buffer-size s] 564 | (let [s' (stream buffer-size xform)] 565 | (connect s s' {:description {:op "transducer"}}) 566 | (source-only s')))) 567 | 568 | ;; same 569 | (defn map 570 | "Equivalent to Clojure's `map`, but for streams instead of sequences." 571 | ([f s] 572 | (let [s' (stream)] 573 | (connect-via s 574 | (fn [msg] 575 | (put! s' (f msg))) 576 | s' 577 | {:description {:op "map"}}) 578 | (source-only s'))) 579 | ([f s & rest] 580 | (map #(apply f %) 581 | (apply zip s rest)))) 582 | 583 | ;; same 584 | (defn realize-each 585 | "Takes a stream of potentially deferred values, and returns a stream of realized values." 586 | [s] 587 | (let [s' (stream)] 588 | (connect-via s 589 | (fn [msg] 590 | (-> msg 591 | (d/chain' #(put! s' %)) 592 | (d/catch' (fn [e] 593 | (log/error e "deferred realized as error, closing stream") 594 | (close! s') 595 | false)))) 596 | s' 597 | {:description {:op "realize-each"}}) 598 | (source-only s'))) 599 | 600 | ;; same 601 | (let [some-drained? (partial some #{::drained})] 602 | (defn zip 603 | "Takes n-many streams, and returns a single stream which will emit n-tuples representing 604 | a message from each stream." 605 | ([a] 606 | (map vector a)) 607 | ([a & rest] 608 | (let [srcs (list* a rest) 609 | intermediates (clj/repeatedly (count srcs) stream) 610 | dst (stream)] 611 | 612 | (doseq [[a b] (clj/map list srcs intermediates)] 613 | (connect-via a #(put! b %) b {:description {:op "zip"}})) 614 | 615 | (d/loop [] 616 | (d/chain' 617 | (->> intermediates 618 | (clj/map #(take! % ::drained)) 619 | (apply d/zip)) 620 | (fn [msgs] 621 | (if (some-drained? msgs) 622 | (do (close! dst) false) 623 | (put! dst msgs))) 624 | (fn [result] 625 | (when result 626 | (d/recur))))) 627 | 628 | (source-only dst))))) 629 | 630 | ;; same 631 | (defn filter 632 | "Equivalent to Clojure's `filter`, but for streams instead of sequences." 633 | [pred s] 634 | (let [s' (stream)] 635 | (connect-via s 636 | (fn [msg] 637 | (if (pred msg) 638 | (put! s' msg) 639 | (d/success-deferred true))) 640 | s' 641 | {:description {:op "filter"}}) 642 | (source-only s'))) 643 | 644 | ;; - identical? -> keyword-identical? 645 | (defn reductions 646 | "Equivalent to Clojure's `reductions`, but for streams instead of sequences." 647 | ([f s] 648 | (reductions f ::none s)) 649 | ([f initial-value s] 650 | (let [s' (stream) 651 | val (atom initial-value)] 652 | (d/chain' (if (keyword-identical? ::none initial-value) 653 | true 654 | (put! s' initial-value)) 655 | (fn [_] 656 | (connect-via s 657 | (fn [msg] 658 | (if (keyword-identical? ::none @val) 659 | (do 660 | (reset! val msg) 661 | (put! s' msg)) 662 | (-> msg 663 | (d/chain' 664 | (partial f @val) 665 | (fn [x] 666 | (reset! val x) 667 | (put! s' x))) 668 | (d/catch' (fn [e] 669 | (log/error e "error in reductions") 670 | (close! s) 671 | false))))) 672 | s'))) 673 | 674 | (source-only s')))) 675 | 676 | ;; identical? -> keyword-identical? 677 | (defn reduce 678 | "Equivalent to Clojure's `reduce`, but returns a deferred representing the return value. 679 | 680 | The deferred will be realized once the stream is closed or if the accumulator 681 | functions returns a `reduced` value." 682 | ([f s] 683 | (reduce f ::none s)) 684 | ([f initial-value s] 685 | (-> (if (keyword-identical? ::none initial-value) 686 | (take! s ::none) 687 | initial-value) 688 | (d/chain' 689 | (fn [initial-value] 690 | (if (keyword-identical? ::none initial-value) 691 | (f) 692 | (d/loop [val initial-value] 693 | (-> (take! s ::none) 694 | (d/chain' (fn [x] 695 | (if (keyword-identical? ::none x) 696 | val 697 | (let [r (f val x)] 698 | (if (reduced? r) 699 | (deref r) 700 | (d/recur r)))))))))))))) 701 | 702 | ;; same 703 | (defn mapcat 704 | "Equivalent to Clojure's `mapcat`, but for streams instead of sequences." 705 | ([f s] 706 | (let [s' (stream)] 707 | (connect-via s 708 | (fn [msg] 709 | (d/loop [s (f msg)] 710 | (when-not (empty? s) 711 | (d/chain' (put! s' (first s)) 712 | (fn [_] 713 | (d/recur (rest s))))))) 714 | s' 715 | {:description {:op "mapcat"}}) 716 | (source-only s'))) 717 | ([f s & rest] 718 | (->> (apply zip s rest) 719 | (mapcat #(apply f %))))) 720 | 721 | ;; identical? -> keyword-identical? 722 | ;; Throwable -> js/Error 723 | (defn lazily-partition-by 724 | "Equivalent to Clojure's `partition-by`, but returns a stream of streams. This means that 725 | if a sub-stream is not completely consumed, the next sub-stream will never be emitted. 726 | 727 | Use with caution. If you're not totally sure you want a stream of streams, use 728 | `(transform (partition-by f))` instead." 729 | [f s] 730 | (let [in (stream) 731 | out (stream)] 732 | 733 | (connect-via-proxy s in out {:description {:op "lazily-partition-by"}}) 734 | 735 | ;; TODO: how is this represented in the topology? 736 | (d/loop [prev ::x, s' nil] 737 | (d/chain' (take! in ::none) 738 | (fn [msg] 739 | (if (keyword-identical? ::none msg) 740 | (do 741 | (when s' (close! s')) 742 | (close! out)) 743 | (let [curr (try 744 | (f msg) 745 | (catch js/Error e 746 | (close! in) 747 | (close! out) 748 | (log/error e "error in lazily-partition-by") 749 | ::error))] 750 | (when-not (keyword-identical? ::error curr) 751 | (if (= prev curr) 752 | (d/chain' (put! s' msg) 753 | (fn [_] (d/recur curr s'))) 754 | (let [s'' (stream)] 755 | (when s' (close! s')) 756 | (d/chain' (put! out s'') 757 | (fn [_] (put! s'' msg)) 758 | (fn [_] (d/recur curr s''))))))))))) 759 | 760 | (source-only out))) 761 | 762 | ;; identical? -> keyword-identical? 763 | (defn concat 764 | "Takes a stream of streams, and flattens it into a single stream." 765 | [s] 766 | (let [in (stream) 767 | out (stream)] 768 | 769 | (connect-via-proxy s in out {:description {:op "concat"}}) 770 | 771 | (d/loop [] 772 | (d/chain' (take! in ::none) 773 | (fn [s'] 774 | (cond 775 | (closed? out) 776 | (close! s') 777 | 778 | (keyword-identical? ::none s') 779 | (do 780 | (close! out) 781 | s') 782 | 783 | :else 784 | (d/loop [] 785 | (d/chain' (take! s' ::none) 786 | (fn [msg] 787 | (if (keyword-identical? ::none msg) 788 | msg 789 | (put! out msg))) 790 | (fn [result] 791 | (case result 792 | false (do (close! s') (close! in)) 793 | ::none nil 794 | (d/recur))))))) 795 | (fn [result] 796 | (when-not (keyword-identical? ::none result) 797 | (d/recur))))) 798 | 799 | (source-only out))) 800 | 801 | ;;; 802 | 803 | ;; - removed type hints 804 | ;; - removed Reference (meta) impls 805 | ;; - description -> description-fn 806 | ;; - buffer-size AtomicInteger -> (atom int) 807 | ;; - last-put AtomicReference -> (atom deferred) 808 | ;; - weakHandle handle -> returns this 809 | (deftype BufferedStream 810 | [buf 811 | limit 812 | metric 813 | description-fn 814 | buffer-size 815 | last-put 816 | buf+] 817 | 818 | core/IEventStream 819 | (isSynchronous [_] 820 | false) 821 | (downstream [this] 822 | (g/downstream this)) 823 | (close [_] 824 | (core/close buf)) 825 | (description [_] 826 | (description-fn 827 | (merge 828 | (description buf) 829 | {:buffer-size @buffer-size 830 | :buffer-capacity limit}))) 831 | (weakHandle [this ref-queue] this) 832 | 833 | core/IEventSink 834 | (put [_ x blocking?] 835 | (assert (not blocking?) "Blocking puts not supported!") 836 | (let [size (metric x)] 837 | (let [val (d/chain' (core/put buf [size x] blocking?) 838 | (fn [result] 839 | (if result 840 | (do 841 | (buf+ size) 842 | @last-put) 843 | false)))] 844 | val))) 845 | (put [_ x blocking? timeout timeout-val] 846 | (assert (not blocking?) "Blocking puts not supported!") 847 | ;; TODO: this doesn't really time out, because that would 848 | ;; require consume-side filtering of messages 849 | (let [size (metric x)] 850 | (let [val (d/chain' (core/put buf [size x] blocking? timeout ::timeout) 851 | (fn [result] 852 | (cond 853 | 854 | (keyword-identical? result ::timeout) 855 | timeout-val 856 | 857 | (false? result) 858 | false 859 | 860 | :else 861 | (do 862 | (buf+ size) 863 | @last-put))))] 864 | val))) 865 | (isClosed [_] 866 | (core/isClosed buf)) 867 | (onClosed [_ callback] 868 | (core/onClosed buf callback)) 869 | 870 | core/IEventSource 871 | (take [_ default-val blocking?] 872 | (assert (not blocking?) "Blocking takes not supported!") 873 | (let [val (d/chain' (core/take buf default-val blocking?) 874 | (fn [x] 875 | (if (keyword-identical? default-val x) 876 | x 877 | (let [[size msg] x] 878 | (buf+ (- size)) 879 | msg))))] 880 | val)) 881 | (take [_ default-val blocking? timeout timeout-val] 882 | (assert (not blocking?) "Blocking takes not supported!") 883 | (let [val (d/chain' (core/take buf default-val blocking? timeout ::timeout) 884 | (fn [x] 885 | (cond 886 | 887 | (keyword-identical? ::timeout x) 888 | timeout-val 889 | 890 | (keyword-identical? default-val x) 891 | x 892 | 893 | :else 894 | (let [[size msg] x] 895 | (buf+ (- size)) 896 | msg))))] 897 | val)) 898 | (isDrained [_] 899 | (core/isDrained buf)) 900 | (onDrained [_ callback] 901 | (core/onDrained buf callback)) 902 | (connector [_ sink] 903 | (core/connector buf sink))) 904 | 905 | ;; Integer/MAX_VALUE -> u/integer-max-value 906 | ;; AtomicLong/AtomicReference -> atom 907 | (defn buffered-stream 908 | "A stream which will buffer at most `limit` data, where the size of each message 909 | is defined by `(metric message)`." 910 | ([buffer-size] 911 | (buffered-stream (constantly 1) buffer-size)) 912 | ([metric limit] 913 | (buffered-stream metric limit identity)) 914 | ([metric limit description] 915 | (let [buf (stream u/integer-max-value) 916 | buffer-size (atom 0) 917 | last-put (atom (d/success-deferred true)) 918 | buf+ (fn [^long n] 919 | (locking last-put 920 | (let [buf' (swap! buffer-size + n) 921 | buf (unchecked-subtract buf' n)] 922 | (cond 923 | (and (<= buf' limit) (< limit buf)) 924 | (-> last-put deref (d/success! true)) 925 | 926 | (and (<= buf limit) (< limit buf')) 927 | (let [last-put' @last-put] 928 | (reset! last-put (d/deferred)) 929 | (d/success! last-put' true))))))] 930 | 931 | (BufferedStream. 932 | buf 933 | limit 934 | metric 935 | description 936 | buffer-size 937 | last-put 938 | buf+)))) 939 | 940 | (defn buffer 941 | "Takes a stream, and returns a stream which is a buffered view of that stream. The buffer 942 | size may either be measured in messages, or if a `metric` is defined, by the sum of `metric` 943 | mapped over all messages currently buffered." 944 | ([limit s] 945 | (let [s' (buffered-stream limit)] 946 | (connect s s') 947 | (source-only s'))) 948 | ([metric limit s] 949 | (let [s' (buffered-stream metric limit)] 950 | (connect s s') 951 | (source-only s')))) 952 | 953 | ;; System/currentTimeMillis -> time/current-millis 954 | ;; identical? -> keyword-identical? 955 | (defn batch 956 | "Batches messages, either into groups of fixed size, or according to upper bounds on size and 957 | latency, in milliseconds. By default, each message is of size `1`, but a custom `metric` function that 958 | returns the size of each message may be defined." 959 | ([batch-size s] 960 | (batch (constantly 1) batch-size nil s)) 961 | ([max-size max-latency s] 962 | (batch (constantly 1) max-size max-latency s)) 963 | ([metric max-size max-latency s] 964 | (assert (pos? max-size)) 965 | 966 | (let [buf (stream) 967 | s' (stream)] 968 | 969 | (connect-via-proxy s buf s' {:description {:op "batch"}}) 970 | (on-closed s' #(close! buf)) 971 | 972 | (d/loop [msgs [], size 0, earliest-message -1, last-message -1] 973 | (cond 974 | (or 975 | (== size max-size) 976 | (and (< max-size size) (== (count msgs) 1))) 977 | (d/chain' (put! s' msgs) 978 | (fn [_] 979 | (d/recur [] 0 -1 -1))) 980 | 981 | (> size max-size) 982 | (let [msg (peek msgs)] 983 | (d/chain' (put! s' (pop msgs)) 984 | (fn [_] 985 | (d/recur [msg] (metric msg) last-message last-message)))) 986 | 987 | :else 988 | (d/chain' (if (or 989 | (nil? max-latency) 990 | (neg? earliest-message) 991 | (empty? msgs)) 992 | (take! buf ::empty) 993 | (try-take! buf 994 | ::empty 995 | (- max-latency (- (time/current-millis) earliest-message)) 996 | ::timeout)) 997 | (fn [msg] 998 | (condp keyword-identical? msg 999 | ::empty 1000 | (do 1001 | (when-not (empty? msgs) 1002 | (put! s' msgs)) 1003 | (close! s')) 1004 | 1005 | ::timeout 1006 | (d/chain' (when-not (empty? msgs) 1007 | (put! s' msgs)) 1008 | (fn [_] 1009 | (d/recur [] 0 -1 -1))) 1010 | 1011 | (let [time (time/current-millis)] 1012 | (d/recur 1013 | (conj msgs msg) 1014 | (+ size (metric msg)) 1015 | (if (neg? earliest-message) 1016 | time 1017 | earliest-message) 1018 | time))))))) 1019 | 1020 | (source-only s')))) 1021 | 1022 | ;; System/currentTimeMillis -> time/current-millis 1023 | ;; identical? -> keyword-identical? 1024 | (defn throttle 1025 | "Limits the `max-rate` that messages are emitted, per second. 1026 | 1027 | The `max-backlog` dictates how much \"memory\" the throttling mechanism has, or how many 1028 | messages it will emit immediately after a long interval without any messages. By default, 1029 | this is set to one second's worth." 1030 | ([max-rate s] 1031 | (throttle max-rate max-rate s)) 1032 | ([max-rate max-backlog s] 1033 | (let [buf (stream) 1034 | s' (stream) 1035 | period (double (/ 1000 max-rate))] 1036 | 1037 | (connect-via-proxy s buf s' {:description {:op "throttle"}}) 1038 | ;; TODO: why do we need this? 1039 | (on-closed s' #(close! buf)) 1040 | 1041 | (d/loop [backlog 0.0, read-start (time/current-millis)] 1042 | (d/chain (take! buf ::none) 1043 | 1044 | (fn [msg] 1045 | (if (keyword-identical? ::none msg) 1046 | (do 1047 | (close! s') 1048 | false) 1049 | (put! s' msg))) 1050 | 1051 | (fn [result] 1052 | (when result 1053 | (let [elapsed (double (- (time/current-millis) read-start)) 1054 | backlog' (min (+ backlog (- (/ elapsed period) 1)) max-backlog)] 1055 | (if (<= 1 backlog') 1056 | (- backlog' 1.0) 1057 | (d/timeout! (d/deferred) (- period elapsed) 0.0))))) 1058 | 1059 | (fn [backlog] 1060 | (if backlog 1061 | (d/recur backlog (time/current-millis)) 1062 | (close! s'))))) 1063 | 1064 | (source-only s')))) 1065 | --------------------------------------------------------------------------------