From f6efe289ea9d3a0359bde5be4efcd96fcdf35bd1 Mon Sep 17 00:00:00 2001 From: Oleksandr Yakushev Date: Wed, 7 Aug 2024 18:28:25 +0300 Subject: [PATCH] Reimplement threaded combinator with explicit first/last separation --- src/methodical/impl/combo/threaded.clj | 135 ++++++++----------- test/methodical/impl/combo/threaded_test.clj | 27 ---- 2 files changed, 59 insertions(+), 103 deletions(-) diff --git a/src/methodical/impl/combo/threaded.clj b/src/methodical/impl/combo/threaded.clj index 396e2b7..62ee8ba 100644 --- a/src/methodical/impl/combo/threaded.clj +++ b/src/methodical/impl/combo/threaded.clj @@ -14,80 +14,61 @@ (comment methodical.interface/keep-me) -(defn reducer-fn - "Reduces a series of before/combined-primary/after methods, threading the resulting values to the next method by - calling the `invoke` function, which is generated by `threaded-invoker`." - [before-primary-after-methods] - (fn [[initial-value invoke]] - (reduce - (fn [last-result method] - (invoke method last-result)) - initial-value - before-primary-after-methods))) - -(defn combine-with-threader - "Combine primary and auxiliary methods using a threading invoker, i.e. something you'd get by calling - `threading-invoker`. The way these methods are combined/reduced is the same, regardless of how args are threaded; - thus, various strategies such as `:thread-first` and `:thread-last` can both share the same `reducer-fn`." - ([threader before-primary-afters] - (comp (reducer-fn before-primary-afters) threader)) - - ([threader primary-methods {:keys [before after around]}] - (when-let [primary (combo.common/combine-primary-methods primary-methods)] - (let [methods (concat before [primary] (reverse after)) - threaded-fn (combine-with-threader threader methods) - optimized-one-arg-fn (apply comp (reverse methods))] - (combo.common/apply-around-methods - (-> (fn - ([] (optimized-one-arg-fn)) - ([a] (optimized-one-arg-fn a)) - ([a b] (threaded-fn a b)) - ([a b c] (threaded-fn a b c)) - ([a b c d] (threaded-fn a b c d)) - ([a b c d e] (threaded-fn a b c d e)) - ([a b c d e f] (threaded-fn a b c d e f)) - ([a b c d e f g] (threaded-fn a b c d e f g)) - ([a b c d e f g & more] (apply threaded-fn a b c d e f g more))) - (u/fn-vary-meta assoc :methodical/combined-method? true)) - around))))) - -(defmulti threading-invoker - "Define a new 'threading invoker', which define how before/combined-primary/after methods should thread values to - subsequent methods. These methods take the initial values used to invoke a multifn, then return a pair like - `[initial-value threading-fn]`. The threading function is used to invoke any subsequent methods using only q single - value, the result of the previous method; if effectively partially binds subsequent methods so that they are always - invoked with the initial values of this invocation, excluding the threaded value." - {:arglists '([threading-type])} - keyword) - -(defmethod threading-invoker :thread-first - [_] - (fn - ([a b] [a (fn [method a*] (method a* b))]) - ([a b c] [a (fn [method a*] (method a* b c))]) - ([a b c d] [a (fn [method a*] (method a* b c d))]) - ([a b c d e] [a (fn [method a*] (method a* b c d e))]) - ([a b c d e f] [a (fn [method a*] (method a* b c d e f))]) - ([a b c d e f g] [a (fn [method a*] (method a* b c d e f g))]) - ([a b c d e f g & more] [a (fn [method a*] (apply method a* b c d e f g more))]))) - -(defmethod threading-invoker :thread-last - [_] - (fn - ([a b] [b (fn [method b*] (method a b*))]) - ([a b c] [c (fn [method c*] (method a b c*))]) - ([a b c d] [d (fn [method d*] (method a b c d*))]) - ([a b c d e] [e (fn [method e*] (method a b c d e*))]) - ([a b c d e f] [f (fn [method f*] (method a b c d e f*))]) - ([a b c d e f g] [g (fn [method g*] (method a b c d e f g*))]) - - ([a b c d e f g & more] - (let [last-val (last more) - butlast* (vec (concat [a b c d e f g] (butlast more)))] - [last-val - (fn [method last*] - (apply method (conj butlast* last*)))])))) - +(defn combine-methods-thread-first + "Combine primary and auxiliary methods using a thread-first threading type." + [primary-methods {:keys [before after around]}] + (when-let [primary (combo.common/combine-primary-methods primary-methods)] + (combo.common/apply-around-methods + (if (and (empty? before) (empty? after)) + ;; If there is only the combined primary method, skip the wrapping dance and just return it. + primary + + (let [methods (concat before [primary] (reverse after))] + (-> (reduce + (fn [current next] + (let [next (u/unwrap-fn-with-meta next)] + (fn combined-method-thread-first + ([] (current) (next)) + ([a] (next (current a))) + ([a b] (next (current a b) b)) + ([a b c] (next (current a b c) b c)) + ([a b c d] (next (current a b c d) b c d)) + ([a b c d e] (next (current a b c d e) b c d e)) + ([a b c d e f] (next (current a b c d e f) b c d e f)) + ([a b c d e f g] (next (current a b c d e f g) b c d e f g)) + ([a b c d e f g & more] (apply next (apply current a b c d e f g more) b c d e f g more))))) + (u/unwrap-fn-with-meta (first methods)) + (rest methods)) + (u/fn-vary-meta assoc :methodical/combined-method? true)))) + around))) + +(defn combine-methods-thread-last + "Combine primary and auxiliary methods using a thread-last threading type." + [primary-methods {:keys [before after around]}] + (when-let [primary (combo.common/combine-primary-methods primary-methods)] + (combo.common/apply-around-methods + (if (and (empty? before) (empty? after)) + ;; If there is only the combined primary method, skip the wrapping dance and just return it. + primary + + (let [methods (concat before [primary] (reverse after))] + (-> (reduce + (fn [current next] + (let [next (u/unwrap-fn-with-meta next)] + (fn combined-method-thread-last + ([] (current) (next)) + ([a] (next (current a))) + ([a b] (next a (current a b))) + ([a b c] (next a b (current a b c))) + ([a b c d] (next a b c (current a b c d))) + ([a b c d e] (next a b c d (current a b c d e))) + ([a b c d e f] (next a b c d e (current a b c d e f))) + ([a b c d e f g] (next a b c d e f (current a b c d e f g))) + ([a b c d e f g & more] (apply next a b c d e f g (concat (butlast more) [(apply current a b c d e f g more)])))))) + (u/unwrap-fn-with-meta (first methods)) + (rest methods)) + (u/fn-vary-meta assoc :methodical/combined-method? true)))) + around))) (deftype ThreadingMethodCombination [threading-type] pretty/PrettyPrintable @@ -105,7 +86,9 @@ #{nil :before :after :around}) (combine-methods [_ primary-methods aux-methods] - (combine-with-threader (threading-invoker threading-type) primary-methods aux-methods)) + (case threading-type + :thread-first (combine-methods-thread-first primary-methods aux-methods) + :thread-last (combine-methods-thread-last primary-methods aux-methods))) (transform-fn-tail [_ qualifier fn-tail] (combo.common/add-implicit-next-method-args qualifier fn-tail)) @@ -125,5 +108,5 @@ "Create a new `ThreadingMethodCombination` using the keyword `threading-type` strategy, e.g. `:thread-first` or `:thread-last`." [threading-type] - {:pre [(get-method threading-invoker threading-type)]} + {:pre [(#{:thread-first :thread-last} threading-type)]} (ThreadingMethodCombination. threading-type)) diff --git a/test/methodical/impl/combo/threaded_test.clj b/test/methodical/impl/combo/threaded_test.clj index 7a2b709..0420667 100644 --- a/test/methodical/impl/combo/threaded_test.clj +++ b/test/methodical/impl/combo/threaded_test.clj @@ -3,33 +3,6 @@ [methodical.impl.combo.threaded :as combo.threaded] [methodical.interface :as i])) -(t/deftest threading-invoker-test - (t/are [threading expected-2 expected-3 expected-4 expected-5] - (let [invoker (comp second (combo.threaded/threading-invoker threading))] - (t/is (= expected-2 - ((invoker :a :b) list 'acc))) - - (t/is (= expected-3 - ((invoker :a :b :c) list 'acc))) - - (t/is (= expected-4 - ((invoker :a :b :c :d) list 'acc))) - - (t/is (= expected-5 - ((invoker :a :b :c :d :e) list 'acc)))) - - :thread-first - ['acc :b] - ['acc :b :c] - ['acc :b :c :d] - ['acc :b :c :d :e] - - :thread-last - [:a 'acc] - [:a :b 'acc] - [:a :b :c 'acc] - [:a :b :c :d 'acc])) - (defn- combine-methods [threading-type primary-methods aux-methods] (i/combine-methods (combo.threaded/threading-method-combination threading-type) primary-methods aux-methods))