├── deps.edn ├── .travis.yml ├── .gitignore ├── LICENSE ├── project.clj ├── src └── manifold │ ├── lifecycle │ └── timing.clj │ └── lifecycle.clj ├── README.md └── test └── manifold └── lifecycle_test.clj /deps.edn: -------------------------------------------------------------------------------- 1 | {:deps {org.clojure/clojure {:mvn/version "1.10.1"} 2 | manifold {:mvn/version "0.1.8"}} 3 | :paths ["src"]} 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | dist: trusty 2 | sudo: false 3 | language: clojure 4 | jdk: 5 | - openjdk8 6 | - openjdk11 7 | branches: 8 | except: 9 | - gh-pages 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | profiles.clj 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | /.lein-* 10 | /.nrepl-port 11 | .hgignore 12 | .hg/ 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2019 Pierre-Yves Ritschard 2 | 3 | Permission to use, copy, modify, and distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (let [cfg (clojure.edn/read-string (slurp "deps.edn")) 2 | deps (for [[k {:keys [mvn/version exclusions]}] (:deps cfg)] 3 | [k version :exclusions exclusions]) 4 | paths (:paths cfg)] 5 | 6 | (defproject spootnik/maniflow "0.1.9-SNAPSHOT" 7 | :description "Additional utilies on top of manifold" 8 | :url "https://github.com/pyr/maniflow" 9 | :license {:name "MIT/ISC License" 10 | :url "https://github.com/pyr/maniflow/tree/master/LICENSE"} 11 | :codox {:source-uri "https://github.com/pyr/maniflow/blob/{version}/{filepath}#L{line}" 12 | :metadata {:doc/format :markdown} 13 | :doc-files ["README.md"]} 14 | :aliases {"kaocha" ["with-profile" "+dev" "run" "-m" "kaocha.runner"]} 15 | :dependencies ~deps 16 | :source-paths ~paths 17 | :deploy-repositories [["snapshots" :clojars] ["releases" :clojars]] 18 | :profiles {:dev {:dependencies [[lambdaisland/kaocha "0.0-529"]] 19 | :plugins [[lein-codox "0.10.7"]]}} 20 | :pendantic? :abort)) 21 | -------------------------------------------------------------------------------- /src/manifold/lifecycle/timing.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.lifecycle.timing 2 | "Lifecycle wrapper for timing steps") 3 | 4 | (defn initializer 5 | 6 | [clock] 7 | (fn [init] 8 | (let [timestamp (clock)] 9 | (-> {:timing {:created-at timestamp 10 | :updated-at timestamp 11 | :index 0 12 | :output []}} 13 | (merge init))))) 14 | 15 | (defn augmenter 16 | [clock] 17 | (fn [context {:keys [id] :as step}] 18 | (let [timestamp (clock) 19 | timing (- timestamp (get-in context [:timing :updated-at]))] 20 | (-> context 21 | (update-in [:timing :index] inc) 22 | (assoc-in [:timing :updated-at] timestamp) 23 | (update-in [:timing :output] conj {:id id :timing timing}))))) 24 | 25 | (def wall-clock 26 | "Default clock for timing" 27 | #(System/currentTimeMillis)) 28 | 29 | (defn make 30 | [clock] 31 | {:initialize (initializer clock) 32 | :augment (augmenter clock)}) 33 | 34 | (def milliseconds 35 | "A timing helper at millisecond resolution" 36 | (make wall-clock)) 37 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | maniflow: utilities on top of manifold 2 | ====================================== 3 | 4 | [![Build Status](https://secure.travis-ci.org/pyr/maniflow.png)](http://travis-ci.org/pyr/maniflow) 5 | 6 | ```clojure 7 | [spootnik/maniflow "0.1.5"] 8 | ``` 9 | 10 | ## Lifecycle management 11 | 12 | The `manifold.lifecycle` namespace provides a lightweight take on a 13 | mechanism similar to [interceptors](http://pedestal.io/reference/interceptors) 14 | or [sieppari](https://github.com/metosin/sieppari). A key difference with 15 | interceptors is that individual handlers have no access to the step chain 16 | and thus cannot interact with it. Guards and early termination are still 17 | provided. 18 | 19 | A lifecycle is nothing more than a collection of handlers through 20 | which a value is passed. 21 | 22 | In essence: 23 | 24 | ```clojure 25 | @(run 0 [(step inc) (step inc) (step inc)]) 26 | ``` 27 | 28 | Is thus directly equivalent to: 29 | 30 | ```clojure 31 | (-> 0 inc inc inc) 32 | ``` 33 | 34 | ### Lifecycle steps 35 | 36 | As shown above, each step in a lifecycle is a handler to run on a value. 37 | Steps can be provided in several forms, all coerced to a map. 38 | 39 | ```clojure 40 | {:id :doubler 41 | :enter (fn [input] (* input 2)) 42 | :guard (fn [context] ...)} 43 | ``` 44 | 45 | #### Function steps 46 | 47 | When a step is a plain function, as in `(run 0 [inc])`, the 48 | resulting map will be of the following shape: 49 | 50 | ```clojure 51 | {:id :step12345 52 | :enter inc} 53 | ``` 54 | 55 | If the function is provided as a var, the qualified name of the var 56 | is used as the id, so for `(run 0 [#'inc])` we would have instead: 57 | 58 | ```clojure 59 | {:id :inc 60 | :enter inc} 61 | ``` 62 | 63 | #### Accessing parts of the input 64 | 65 | Often times, the payload being threaded between lifecycle steps will 66 | be a map. As with interceptors, it might be useful to hold on to 67 | information accumulated during the chain processing. To help with 68 | this, maniflow provides three parameters for steps: 69 | 70 | - `:in`: specifies a path that will be extracted from the payload and 71 | fed as input to the handler 72 | - `:out`: specifies where in the payload to assoc the result of the 73 | handler 74 | - `:lens`: when present, supersedes the previous two parameters and 75 | acts as though both `:in` and `:out` where provided 76 | 77 | ```clojure 78 | {:id :determine-deserialize 79 | :enter (partial = :post) 80 | :in [:request :request-method] 81 | :out [::need-deserialize?]) 82 | ``` 83 | 84 | #### Step guards 85 | 86 | Based on the current state of processing, it might be useful to guard 87 | execution of a step against a predicate, keeping with the last example: 88 | 89 | ```clojure 90 | {:id :deserialize 91 | :enter deserialize 92 | :lens [:request :body] 93 | :guard ::need-deserialize?} 94 | ``` 95 | 96 | #### Discarding results 97 | 98 | Sometimes, 99 | 100 | ```clojure 101 | {:id :debug 102 | :enter prn 103 | :discard? true} 104 | ``` 105 | 106 | #### Building steps with `step` 107 | 108 | The `manifold.lifecycle/step` function is provided to build steps 109 | easily, the above can thus be rewritten: 110 | 111 | ```clojure 112 | (enter-step :determine-deserialize (partial = :post) :in [:request :request-method] :out ::need-deserialize?) 113 | (enter-step :debug prn :discard? true) 114 | (enter-step :deserialize deserialize :guard ::need-deserialize?) 115 | (enter-step :handler run-handler) 116 | ``` 117 | 118 | ### Global options 119 | 120 | When running a lifecycle, an options map can be passed in to further 121 | modify the behavior: 122 | 123 | ```clojure 124 | {:augment (fn [context step] ...) 125 | :initialize (fn [value] ...) 126 | :executor ...} 127 | ``` 128 | 129 | - `augment`: A function of context and current step called for each step 130 | in the lifecycle. 131 | - `initialize`: A function of init value to prepare the payload. 132 | - `executor`: An executor to defer execution on. 133 | 134 | 135 | ### Error handling 136 | 137 | There are intentionally no facilities to interact with the sequence of 138 | steps in this library. Exceptions thrown will break the sequence of 139 | steps, users of the library are encouraged to use 140 | `manifold.deferred/catch` to handle errors raised during execution. 141 | 142 | All errors contain the underlying thrown exception as a cause and 143 | contain the last known context in their `ex-data` 144 | 145 | ```clojure 146 | (-> (d/run 0 [(step inc) (step #(d/future (/ % 0))) (step inc)]) 147 | (d/catch (fn [e] 148 | (type (.getCause e)) ;; ArithmeticException 149 | (:context (ex-data e)) ;; last context))) 150 | ``` 151 | 152 | ### Timing wrapper 153 | 154 | Assuming a map payload, timing can be recorded for each step 155 | with the `initialize` and `augment` implementations provided 156 | in `manifold.lifecycle.timing`: 157 | 158 | ```clojure 159 | 160 | @(run 161 | {:x 0} 162 | [(step :inc inc :lens :x) (step :inc inc :lens :x)] 163 | timing/milliseconds) 164 | 165 | {:timing 166 | {:created-at 1569080525132, 167 | :updated-at 1569080525133, 168 | :index 2, 169 | :output [{:id :inc, :timing 0} {:id :inc, :timing 1}]}, 170 | :x 2} 171 | ``` 172 | -------------------------------------------------------------------------------- /test/manifold/lifecycle_test.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.lifecycle-test 2 | (:require [clojure.test :refer :all] 3 | [manifold.lifecycle :refer :all] 4 | [manifold.lifecycle.timing :as timing] 5 | [manifold.deferred :as d])) 6 | 7 | (deftest minimal-lifecycle 8 | (is (= 1 @(run 0 [(step inc)])))) 9 | 10 | (deftest simple-lifecycles 11 | (is (= 3 @(run 0 [(step inc) 12 | (step inc) 13 | (step inc)]))) 14 | 15 | (is (= 4 @(run 0 [(step inc) 16 | (step inc) 17 | (step (partial * 2))]))) 18 | 19 | (is (= 0 @(run {:a 0} [(step :a)]))) 20 | 21 | (is (= {:a 1} 22 | @(run {} [(step #(assoc % :a 0)) 23 | (step #(d/future (update % :a inc)))])))) 24 | 25 | (deftest lifecycles-with-parmeters 26 | (is (= {:x 3} 27 | @(run {:x 0} [(step :inc inc :lens :x) 28 | (step :inc inc :lens :x) 29 | (step :inc inc :lens :x)]))) 30 | 31 | (is (= {:x 3} 32 | @(run {:x 0} [(step :inc inc 33 | :lens :x 34 | :guard (constantly true)) 35 | (step :inc inc 36 | :lens :x 37 | :guard (constantly true)) 38 | (step :inc inc 39 | :lens :x 40 | :guard (constantly true))]))) 41 | 42 | (is (= 3 43 | @(run {:x 0} [(step :inc inc 44 | :lens :x 45 | :guard (constantly true)) 46 | (step :inc inc 47 | :lens :x 48 | :guard (constantly true)) 49 | (step :inc inc 50 | :in :x 51 | :guard (constantly true))]))) 52 | 53 | (is (= {:x 0} 54 | @(run {:x 0} [(step :inc inc 55 | :lens :x 56 | :guard (constantly true) 57 | :discard? true) 58 | (step :inc inc 59 | :lens :x 60 | :guard (constantly true) 61 | :discard? true) 62 | (step :inc inc 63 | :in :x 64 | :guard (constantly true) 65 | :discard? true)]))) 66 | 67 | (is (= {:status 200 68 | :headers {:content-type "text/plain"} 69 | :body "hello"} 70 | @(run {:request {:uri "/"}} 71 | [(step :handler (constantly {:body "hello"}) 72 | :in :request 73 | :out :response) 74 | (step :status (constantly 200) 75 | :in :response 76 | :out [:response :status]) 77 | (step :content-type #(assoc-in % [:headers :content-type] 78 | "text/plain") 79 | :in :response)]))) 80 | 81 | (is (= 1 @(run 0 {:stop-on odd?} [(step inc) 82 | (step inc) 83 | (step inc) 84 | (step inc)]))) 85 | 86 | (is (= {:x 1} @(run {:x 0} [(step :inc inc :lens :x)]))) 87 | 88 | (is (= {:x 0} @(run {:x 0} [(step :inc inc :lens :x :guard (constantly false))]))) 89 | 90 | (is (= {:x 0} 91 | @(run {:x 0} [(step :inc inc 92 | :lens :x 93 | :guard (constantly false)) 94 | (step :inc inc 95 | :lens :x 96 | :guard (constantly false)) 97 | (step :inc inc 98 | :lens :x 99 | :guard (constantly false))])))) 100 | 101 | (deftest errors-in-lifecycles 102 | (is (thrown? clojure.lang.ExceptionInfo 103 | @(run 0 [(step (partial / 0))]))) 104 | 105 | (let [e (try @(run 0 [(step (partial / 0))]) 106 | (catch Exception e e))] 107 | (is (= ArithmeticException (class (.getCause e)))))) 108 | 109 | (deftest timings-test 110 | (let [clock (let [state (atom 0)] (fn [] (first (swap-vals! state inc))))] 111 | (is (= @(run 112 | {:x 0} 113 | (timing/make clock) 114 | [(step :inc inc :lens :x) 115 | (step :inc inc :lens :x)]) 116 | {:x 2 117 | :timing {:created-at 0 118 | :updated-at 2 119 | :index 2 120 | :output [{:id :inc :timing 1} 121 | {:id :inc :timing 1}]}})))) 122 | 123 | (deftest out-value-test 124 | 125 | (is (= 2 @(run {:x 0} 126 | {:out [:x]} 127 | [(step :inc inc :lens :x) 128 | (step :inc inc :lens :x)])))) 129 | 130 | 131 | (deftest build-stages-test 132 | 133 | (is (= 134 | (build-stages {:stop-on :stop! :augment 'augment} 135 | [{:id :format :enter 'deserialize :leave 'serialize :error :eformat} 136 | {:id :normalize :enter 'normalize-in :leave 'normalize-out} 137 | {:id :validate :enter 'validate :error :evalidate} 138 | {:id :handler :enter 'runcmd :error :ehandler}]) 139 | '[{:id :format, 140 | :error (:eformat), 141 | :stage :enter, 142 | :handler deserialize, 143 | :augment augment, 144 | :stop-on :stop!} 145 | {:id :normalize, 146 | :stage :enter, 147 | :handler normalize-in, 148 | :error (:eformat), 149 | :augment augment, 150 | :stop-on :stop!} 151 | {:id :validate, 152 | :error (:evalidate :eformat), 153 | :stage :enter, 154 | :handler validate, 155 | :augment augment, 156 | :stop-on :stop!} 157 | {:id :handler, 158 | :error (:ehandler :evalidate :eformat), 159 | :stage :enter, 160 | :handler runcmd, 161 | :augment augment, 162 | :stop-on :stop!} 163 | {:id :normalize, 164 | :stage :leave, 165 | :handler normalize-out, 166 | :error (:eformat), 167 | :augment augment, 168 | :stop-on :stop!} 169 | {:id :format, 170 | :error (:eformat), 171 | :stage :leave, 172 | :handler serialize, 173 | :augment augment, 174 | :stop-on :stop!}])) 175 | (is (= 176 | (build-stages {:stop-on :stop! :augment 'augment} 177 | [{:id :request-id :enter 'add-request} 178 | {:id :route :enter 'route} 179 | {:id :format :enter 'deserialize :leave 'serialize} 180 | {:id :normalize :enter 'normalize-in :leave 'normalize-out} 181 | {:id :validate :enter 'validate} 182 | {:id :handler :enter 'runcmd}]) 183 | '[{:id :request-id, 184 | :stage :enter, 185 | :handler add-request, 186 | :error [] 187 | :stop-on :stop!, 188 | :augment augment} 189 | {:id :route, 190 | :stage :enter, 191 | :handler route, 192 | :error [] 193 | :stop-on :stop!, 194 | :augment augment} 195 | {:id :format, 196 | :stage :enter, 197 | :handler deserialize, 198 | :error [] 199 | :stop-on :stop!, 200 | :augment augment} 201 | {:id :normalize, 202 | :stage :enter, 203 | :handler normalize-in, 204 | :error [] 205 | :stop-on :stop!, 206 | :augment augment} 207 | {:id :validate, 208 | :stage :enter, 209 | :handler validate, 210 | :stop-on :stop!, 211 | :error [] 212 | :augment augment} 213 | {:id :handler, 214 | :stage :enter, 215 | :handler runcmd, 216 | :error [] 217 | :stop-on :stop!, 218 | :augment augment} 219 | {:id :normalize, 220 | :stage :leave, 221 | :error [] 222 | :handler normalize-out, 223 | :stop-on :stop!, 224 | :augment augment} 225 | {:id :format, 226 | :stage :leave, 227 | :handler serialize, 228 | :error [] 229 | :stop-on :stop!, 230 | :augment augment}]))) 231 | 232 | 233 | (defn fail! 234 | [& _] 235 | (throw (ex-info "blah" {}))) 236 | 237 | (deftest stage-error-handling 238 | 239 | (testing "basic-error-handling" 240 | (let [error-handler (constantly 1000)] 241 | (is (= [{:id :a :stage :enter :handler fail! :error [error-handler] :stop-on :stop! :augment nil} 242 | {:id :a :stage :leave :handler inc :error [error-handler] :stop-on :stop! :augment nil} ] 243 | (build-stages {:stop-on :stop!} [(step :a [fail! inc] :error error-handler)])))) 244 | 245 | (is (= @(run 0 [(step :a [fail! inc] :error (constantly 1000))]) 1001)) 246 | (is (= @(run 0 [(step :a [inc fail!] :error (constantly 1000))]) 1000)) 247 | 248 | ) 249 | ) 250 | -------------------------------------------------------------------------------- /src/manifold/lifecycle.clj: -------------------------------------------------------------------------------- 1 | (ns manifold.lifecycle 2 | " 3 | Convention based lifecycle management of asynchronous chains. 4 | This implements a lightweight take on the ideas behind interceptors 5 | and similar libraries. 6 | 7 | Notable differences are: 8 | 9 | - Manifold is the sole provided execution model for chains 10 | - No chain manipulation can occur 11 | - Guards and finalizer for steps are optional 12 | - Exceptions during lifecycle steps stop the execution 13 | " 14 | (:require [clojure.spec.alpha :as s] 15 | [manifold.deferred :as d] 16 | [manifold.executor :as pool])) 17 | 18 | (def stages 19 | "Fixed list of stages to run through" 20 | [:enter :leave]) 21 | 22 | (defn step* 23 | "Convenience function to build a step map. 24 | Requires and ID and handler, and can be fed 25 | additional options" 26 | [id handlers {:keys [in out lens guard discard? error]}] 27 | (let [as-vector #(cond-> % (not (sequential? %)) vector) 28 | [enter leave] (as-vector handlers)] 29 | (cond-> {:id id} 30 | (some? enter) (assoc :enter enter) 31 | (some? leave) (assoc :leave leave) 32 | (some? in) (assoc :in (as-vector in)) 33 | (some? out) (assoc :out (as-vector out)) 34 | (some? lens) (assoc :lens (as-vector lens)) 35 | (some? guard) (assoc :guard guard) 36 | (some? error) (assoc :error error) 37 | (some? discard?) (assoc :discard? discard?)))) 38 | 39 | (defn step 40 | "Convenience function to build a step map. 41 | Requires and ID and handler, and can be fed 42 | additional options" 43 | ([enter] 44 | (step (keyword (gensym "handler")) [enter])) 45 | ([id handlers & {:as params}] 46 | (step* id handlers params))) 47 | 48 | (defn ^:no-doc rethrow-exception-fn 49 | "When chains fail, augment the thrown exception with the current 50 | context state" 51 | [context step] 52 | (fn thrower [e] 53 | (throw (ex-info (.getMessage e) 54 | {:type (or (:type (ex-data e)) :error/fault) 55 | :context context 56 | :step step} 57 | e)))) 58 | 59 | (defn ^:no-doc assoc-result-fn 60 | "When applicable, yield a function of a result which 61 | sets the output in the expected position, as per the 62 | step definition" 63 | [{:keys [lens out discard?]} context] 64 | (cond 65 | discard? (constantly context) 66 | (some? lens) (partial assoc-in context lens) 67 | (some? out) (partial assoc-in context out) 68 | :else identity)) 69 | 70 | (defn ^:no-doc extract-input 71 | "Fetches the expected part of a threaded context" 72 | [{:keys [lens in]} context] 73 | (cond 74 | (some? lens) (get-in context lens) 75 | (some? in) (get-in context in) 76 | :else context)) 77 | 78 | (defn ^:no-doc run-step 79 | "Run a single step in a lifecycle. Takes care of honoring `augment`, 80 | `stop-on`, `guard`, and position (`in`, `out`, or `lens`) specifications." 81 | [{:keys [handler guard in out lens discard? augment stop-on] :as step} context] 82 | (let [context (cond-> context (some? augment) (augment step)) 83 | rethrow (rethrow-exception-fn context step)] 84 | (when (nil? handler) 85 | (throw (ex-info (str "corrupt step: " (pr-str step)) {:step step}))) 86 | (try 87 | (if (or (nil? guard) (guard context)) 88 | (-> (d/chain (extract-input step context) 89 | handler 90 | (assoc-result-fn step context)) 91 | (d/catch rethrow)) 92 | context) 93 | (catch Exception e (rethrow e))))) 94 | 95 | (defn- validate-args! 96 | "Throw early on invalid configuration" 97 | [opts steps] 98 | (when-not (s/valid? ::args [opts steps]) 99 | (let [msg (s/explain-str ::args [opts steps])] 100 | (throw (ex-info msg {:type :error/incorrect :message msg}))))) 101 | 102 | (defn error-handlers-for 103 | "A list of error handlers to try in sequence for a specific stage" 104 | [id handlers] 105 | (->> (reverse handlers) 106 | (drop-while #(not= id (:id %))) 107 | (map :error) 108 | (filter some?))) 109 | 110 | (defn prepare-stage 111 | "Prepare a single stage, discard steps which do not have a handler 112 | for a specific stage." 113 | [stage opts steps error-handlers] 114 | (let [clean-stages #(apply dissoc % stages) 115 | extra {:augment (:augment opts) 116 | :stop-on (or (:stop-on opts) 117 | (:terminate-when opts) 118 | (constantly false))}] 119 | (vec (for [step steps 120 | :let [handler (get step stage) 121 | id (:id step)] 122 | :when (some? handler)] 123 | (-> step 124 | (assoc :stage stage 125 | :handler handler 126 | :error (error-handlers-for id error-handlers)) 127 | (dissoc stage) 128 | (clean-stages) 129 | (merge extra)))))) 130 | 131 | (defn ^:no-doc build-stages 132 | "Given a list of steps, prepare a flat vector of actions 133 | to take in sequence. If options do not specify a stage, 134 | assume `:enter` and `:leave`" 135 | [opts steps] 136 | (let [error-handlers (map #(select-keys % [:id :error]) steps) 137 | [stage & stages] stages 138 | steps steps 139 | prepared []] 140 | (vec 141 | (concat (prepare-stage :enter opts steps error-handlers) 142 | (prepare-stage :leave opts (reverse steps) error-handlers))))) 143 | 144 | (defprotocol ^:no-doc Restarter 145 | "A protocol to allow restarts" 146 | (restart-step [this step] 147 | "Run an asynchronous operation") 148 | (restart-success [this value] 149 | "Success callback") 150 | (forward-failure [this e] 151 | "Failure callback, walks back the chain of stages to 152 | find a potential handler")) 153 | 154 | (defrecord DeferredRestarter [executor steps stop-on out result value error-chain] 155 | Restarter 156 | (restart-step [this value] 157 | (let [[step & steps] steps] 158 | (d/on-realized (d/chain (d/future-with executor (run-step step value))) 159 | (partial restart-success 160 | (assoc this :steps steps)) 161 | (partial forward-failure 162 | (assoc this 163 | :steps steps 164 | :error-chain (:error step) 165 | :value value))))) 166 | (forward-failure [this e] 167 | (let [[handler & handlers] error-chain 168 | last? (nil? (first steps)) 169 | success? (not (instance? Exception e))] 170 | (cond 171 | success? 172 | (restart-success this e) 173 | 174 | (nil? handler) 175 | (d/error! result e) 176 | 177 | :else 178 | (d/chain (handler step value e) 179 | (partial forward-failure 180 | (assoc this :error-chain handlers)))))) 181 | 182 | (restart-success [this value] 183 | (let [step (first steps) 184 | stop? (when (some? stop-on) (stop-on value)) 185 | exit (cond-> value (some? out) (get-in out))] 186 | (cond 187 | (nil? step) (d/success! result exit) 188 | stop? (d/success! result exit) 189 | :else (restart-step this value))))) 190 | 191 | (defn ^:no-doc make-restarter 192 | "Build a restarter" 193 | [opts steps] 194 | (map->DeferredRestarter 195 | {:executor (or (:executor opts) (pool/execute-pool)) 196 | :steps (build-stages opts steps) 197 | :stop-on (:stop-on opts) 198 | :out (:out opts) 199 | :result (d/deferred)})) 200 | 201 | (defn run 202 | " 203 | Run a series of potentially asynchronous steps in sequence 204 | on an initial value (`init`0, threading each step's result to 205 | the next step as input. 206 | 207 | Steps are maps or the following keys: 208 | 209 | [:id :enter :leave :in :out :discard? :guard] 210 | 211 | - `id` is the unique ID for a step 212 | - `enter` is the function of the previous result in the enter stage 213 | - `leave` is the function of the previous result in the leave stage 214 | - `in` when present determines which path in the context will 215 | be fed to the handler. The handler is considered a function 216 | of the contex 217 | - `out` when present determines which path in the context to 218 | associate the result to, otherwise replaces the full context 219 | - `discard?` when present, runs the handler but pass the context 220 | untouched to the next step 221 | - `guard` is an optional predicate of the current context and previous 222 | preventing execution of the step when yielding false 223 | 224 | In the three-arity version, an extra options maps can 225 | be provided, with the following keys: 226 | 227 | [:augment :executor :initialize :stop-on] 228 | 229 | - `augment` is a function called on the context for each step, 230 | expected to yield an updated context. This can useful to 231 | perform timing tasks 232 | - `executor` a manifold executor to execute deferreds on 233 | - `initialize` is a function called on the context before 234 | running the lifecycle. 235 | - `out` a path in the context to retrieve as the final 236 | value out of the lifecycle 237 | - `stop-on` predicate which determines whether an early stop is 238 | mandated, for compatibility with interceptors `terminate-when` 239 | is synonymous." 240 | ([init steps] 241 | (run init {} steps)) 242 | ([init opts steps] 243 | (validate-args! opts steps) 244 | (let [initialize (or (:initialize opts) identity) 245 | restarter (make-restarter opts steps)] 246 | (restart-step restarter (initialize init)) 247 | (:result restarter)))) 248 | 249 | ;; Specs 250 | ;; ===== 251 | 252 | (s/def ::id keyword?) 253 | (s/def ::handler (partial instance? clojure.lang.IFn)) 254 | (s/def ::enter (partial instance? clojure.lang.IFn)) 255 | (s/def ::leave (partial instance? clojure.lang.IFn)) 256 | (s/def ::guard (partial instance? clojure.lang.IFn)) 257 | (s/def ::initialize (partial instance? clojure.lang.IFn)) 258 | (s/def ::augment (partial instance? clojure.lang.IFn)) 259 | (s/def ::stop-on (partial instance? clojure.lang.IFn)) 260 | (s/def ::stages (s/coll-of keyword?)) 261 | (s/def ::in vector?) 262 | (s/def ::out vector?) 263 | (s/def ::lens vector?) 264 | (s/def ::step (s/keys :req-un [::id] 265 | :opt-un [::enter ::leave ::in ::out ::lens 266 | ::guard ::discard?])) 267 | (s/def ::steps (s/coll-of ::step)) 268 | (s/def ::opts (s/keys :opt-un [::stop-on ::initialize 269 | ::augment ::executor ::out])) 270 | (s/def ::args (s/cat :opts ::opts :steps ::steps)) 271 | --------------------------------------------------------------------------------