Skip to content

Commit

Permalink
Reimplement threaded combinator with explicit first/last separation
Browse files Browse the repository at this point in the history
  • Loading branch information
@alexander-yakushev
alexander-yakushev committed Aug 2, 2024
1 parent 4093795 commit 5ab004c
Show file tree
Hide file tree
Showing 2 changed files with 65 additions and 94 deletions.
132 changes: 65 additions & 67 deletions src/methodical/impl/combo/threaded.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,71 +14,67 @@

(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 & more] (apply threaded-fn a b c d 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 & more] [a (fn [method a*] (apply method a* b c d 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 & more]
(let [last-val (last more)
butlast* (vec (concat [a b c d] (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]
(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 & more] (apply next (apply current a b c more) b c more))))
(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))
threaded-fn-0 (reduce (fn [current wrapping]
(fn threaded-fn-0 [] (current) (wrapping)))
methods)
threaded-fn-1 (reduce (fn [current wrapping]
(fn threaded-fn-1 [a] (wrapping (current a))))
methods)
threaded-fn-2 (reduce (fn [current wrapping]
(fn threaded-fn-2 [a b] (wrapping a (current a b))))
methods)
threaded-fn-3 (reduce (fn [current wrapping]
(fn threaded-fn-3 [a b c] (wrapping a b (current a b c))))
methods)
threaded-fn-n (reduce (fn [current wrapping]
(fn threaded-fn-n [a b c & more]
(apply wrapping a b c (concat (butlast more) [(apply current a b c more)]))))
methods)]
(-> (reduce
(fn [current 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 & more] (apply next a b c (concat (butlast more) [(apply current a b c more)])))))
(first methods)
(rest methods))
(u/fn-vary-meta assoc :methodical/combined-method? true))))
around)))

(deftype ThreadingMethodCombination [threading-type]
pretty/PrettyPrintable
Expand All @@ -96,7 +92,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))
Expand All @@ -116,5 +114,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))
27 changes: 0 additions & 27 deletions test/methodical/impl/combo/threaded_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))

Expand Down

0 comments on commit 5ab004c

Please sign in to comment.