From 5fcd525331fa31a8806c297edaa1b77a755c5f00 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Peter=20Str=C3=B6mberg?= <pez@pezius.com>
Date: Thu, 7 Dec 2023 10:35:46 +0100
Subject: [PATCH] Adding `reductions` (#421)

* Port `clojure.core/reductions`

* Fixes #418

* Add tests for reductions

* Add test that you can compose with reductions

* Update changelog
---
 CHANGELOG.md                   |  1 +
 resources/squint/core.edn      |  1 +
 src/squint/core.js             | 26 ++++++++++++
 test/squint/compiler_test.cljs | 76 ++++++++++++++++++++++++++++++++++
 4 files changed, 104 insertions(+)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 6ab7b4b0..b63632b3 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -8,6 +8,7 @@
 - Fix `reduce` without initial value + empty coll, it should call `f()`
 - Add serve-playground bb task
 - Update playground with button for creating a blank AOC playground
+- [#418](): Add `reductions`
 
 ## 0.4.73 (2023-12-05)
 
diff --git a/resources/squint/core.edn b/resources/squint/core.edn
index efd9df59..0896605f 100644
--- a/resources/squint/core.edn
+++ b/resources/squint/core.edn
@@ -142,6 +142,7 @@
   reduce_kv
   reduced
   reduced_QMARK_
+  reductions
   regexp_QMARK_
   remove
   remove_watch
diff --git a/src/squint/core.js b/src/squint/core.js
index 4a187aa4..b94284a3 100644
--- a/src/squint/core.js
+++ b/src/squint/core.js
@@ -582,6 +582,32 @@ export function reduce(f, arg1, arg2) {
   return val;
 }
 
+function _reductions(f, arg1, arg2) {
+  const [init, coll] = arg2 === undefined ? [undefined, arg1]: [arg1, arg2];
+  const s = seq(coll);
+  if (init === undefined) {
+    // (reductions f coll)
+    return new LazySeq(function () {
+      return s ? _reductions(f, first(s), rest(s)) : list(f());
+    });
+  } else {
+    // (reductions f val coll)
+    if (reduced_QMARK_(init)) {
+      return list(init.value);
+    }
+    return cons(init, new LazySeq(function () {
+      if (s) {
+        return _reductions(f, f(init, first(s)), rest(s));
+      }
+    }));
+  }
+}
+
+export function reductions(f, arg1, arg2) {
+  f = toFn(f);
+  return _reductions(f, arg1, arg2);
+}
+
 var tolr = false;
 export function warn_on_lazy_reusage_BANG_() {
   tolr = true;
diff --git a/test/squint/compiler_test.cljs b/test/squint/compiler_test.cljs
index 31103e34..88fd6034 100644
--- a/test/squint/compiler_test.cljs
+++ b/test/squint/compiler_test.cljs
@@ -945,6 +945,82 @@
   (is (jsv! '(reduced? (reduced 5))))
   (is (= 4 (jsv! '(deref (reduced 4))))))
 
+(deftest reductions-test
+  (testing "lazy"
+    (is (eq (vec (take 10 (reductions + (range))))
+            (jsv! `(vec (take 10 (reductions + (range))))))
+        "Returns a lazy sequence"))
+  (testing "no val"
+    (is (eq (vec (reductions + [1 1 1 1])) (jsv! '(vec (reductions + [1 1 1 1])))))
+    (is (eq (vec (reductions #(if (< %2 3)
+                                (+ %1 %2)
+                                (reduced %1))
+                             (range 5)))
+            (jsv! '(vec (reductions #(if (< %2 3)
+                                       (+ %1 %2)
+                                       (reduced %1))
+                                    (range 5)))))
+        "reduced early")
+    (is (eq (reduce #(if (< %2 4)
+                       (+ %1 %2)
+                       (reduced %1))
+                    (range 5))
+            (jsv! '(reduce #(if (< %2 4)
+                              (+ %1 %2)
+                              (reduced %1))
+                           (range 5))))
+        "reduced last el")
+    (is (eq (vec (reductions (fn [x _] (reduced x))
+                             (range 5)))
+            (jsv! '(vec (reductions (fn [x _] (reduced x))
+                                    (range 5)))))
+        "reduced first el"))
+  (testing "val"
+    (is (eq (vec (reductions conj [] '(1 2 3)))
+            (jsv! '(vec (reductions conj [] '(1 2 3)))))))
+  (testing "sets"
+    (is (eq (vec (reductions #(+ %1 %2) #{1 2 3 4}))
+            (jsv! '(vec (reductions #(+ %1 %2) #{1 2 3 4}))))))
+  (testing "maps"
+    (is (eq (vec (reductions #(+ %1 (second %2))
+                             0
+                             {:a 1, :b 2, :c 3, :d 4}))
+            (jsv! '(vec (reductions #(+ %1 (second %2))
+                                    0
+                                    (js/Map. [[:a 1] [:b 2] [:c 3] [:d 4]])))))))
+  (testing "objects"
+    (is (eq (vec (reductions #(+ %1 (second %2))
+                             0
+                             {:a 1, :b 2, :c 3, :d 4}))
+            (jsv! '(vec (reductions #(+ %1 (second %2))
+                                    0
+                                    (js/Object.entries {:a 1, :b 2, :c 3, :d 4}))))))
+    (is (eq (vec (reductions #(+ %1 %2)
+                             0
+                             (vals {:a 1 :b 2 :c 3 :d 4})))
+            (jsv! '(vec (reductions #(+ %1 %2)
+                                    0
+                                    (js/Object.values {:a 1 :b 2 :c 3 :d 4}))))))
+    (is (eq (vec (reductions #(+ %1 (second %2))
+                             0
+                             {:a 1, :b 2, :c 3, :d 4}))
+            (jsv! '(vec (reductions #(+ %1 (second %2))
+                                    0
+                                    {:a 1 :b 2 :c 3 :d 4}))))))
+  (testing "empty coll"
+    (is (eq (vec (reductions + '())) (jsv! '(vec (reductions + '())))))
+    (is (eq (vec (reductions + [])) (jsv! '(vec (reductions + []))))))
+  (testing "composability"
+    ;; https://clojuredocs.org/clojure.core/reductions#example-58bdd686e4b01f4add58fe6b
+    (is (eq (vec (take 3 (as-> (repeat {:height 50}) posts
+                           (map #(assoc %1 :offset %2)
+                                posts
+                                (reductions + 0 (map :height posts))))))
+            (jsv! '(vec (take 3 (as-> (repeat {:height 50}) posts
+                                  (map #(assoc %1 :offset %2)
+                                       posts
+                                       (reductions + 0 (map :height posts)))))))))))
+
 (deftest seq-test
   (is (= "abc" (jsv! '(seq "abc"))))
   (is (eq '(1 2 3) (jsv! '(seq [1 2 3]))))