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 7, 2024
1 parent 72d33d3 commit 02b8b3b
Show file tree
Hide file tree
Showing 2 changed files with 59 additions and 103 deletions.
135 changes: 59 additions & 76 deletions src/methodical/impl/combo/threaded.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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))
Expand All @@ -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))
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 02b8b3b

Please sign in to comment.