correct list foldr behaviour

CHANGELOG.md

@@ -12,6 +12,7 @@ and this project adheres to [Semantic versioning](http://semver.org/).
 - do not flip arguments on `ListL/ConcatenationMonoid`
 - introduce `Alt` and `Plus` typeclasses
 - define `ConstantSemigroup`
+- fix `foldr` behavior for lists
 
 ## [2.0.0] - 2023-03-21
 

spec/ConcatenateListsWithFoldMapSpec.php

@@ -0,0 +1,17 @@
+<?php
+
+declare(strict_types=1);
+
+use Marcosh\LamPHPda\Instances\ListL\ConcatenationMonoid;
+use Marcosh\LamPHPda\Instances\ListL\ListFoldable;
+use Marcosh\LamPHPda\ListL;
+use Marcosh\LamPHPda\Typeclass\Extra\ExtraFoldable;
+
+describe('ConcatenateListsWithFoldMap', function () {
+    it('preserves the order when concatenating lists', function () {
+        expect((new ExtraFoldable(new ListFoldable()))->fold(
+            new ConcatenationMonoid(),
+            new ListL([[1, 2], [3, 4], [5, 6]])
+        ))->toBe([1, 2, 3, 4, 5, 6]);
+    });
+});

src/Instances/ListL/ConcatenationMonoid.php

@@ -27,7 +27,7 @@ public function mempty(): array
      * @param list<A> $b
      * @return list<A>
      */
-    public function append($a, $b)
+    public function append(mixed $a, mixed $b): mixed
     {
         return [...$a, ...$b];
     }

src/Instances/ListL/ListFoldable.php

@@ -28,14 +28,25 @@ final class ListFoldable implements Foldable
      */
     public function foldr(callable $f, mixed $b, HK1 $a): mixed
     {
-        $aList = ListL::fromBrand($a);
+        $aList = ListL::fromBrand($a)->asNativeList();
 
-        /** @psalm-suppress ImpureMethodCall */
-        foreach ($aList as $aElement) {
-            /** @psalm-suppress ImpureFunctionCall */
-            $b = $f($aElement, $b);
+        if ([] === $aList) {
+            return $b;
         }
 
-        return $b;
+        $head = array_shift($aList);
+
+        /**
+         * @psalm-suppress ImpureFunctionCall
+         * @psalm-suppress ImpureVariable
+         */
+        return $f(
+            $head,
+            $this->foldr(
+                $f,
+                $b,
+                new ListL($aList)
+            )
+        );
     }
 }

src/Typeclass/Extra/ExtraFoldable.php

@@ -0,0 +1,66 @@
+<?php
+
+declare(strict_types=1);
+
+namespace Marcosh\LamPHPda\Typeclass\Extra;
+
+use Marcosh\LamPHPda\Brand\Brand;
+use Marcosh\LamPHPda\HK\HK1;
+use Marcosh\LamPHPda\Typeclass\Foldable;
+use Marcosh\LamPHPda\Typeclass\Monoid;
+
+/**
+ * @template T of Brand
+ *
+ * @psalm-immutable
+ */
+final class ExtraFoldable
+{
+    /**
+     * @param Foldable<T> $foldable
+     */
+    public function __construct(private readonly Foldable $foldable)
+    {
+    }
+
+    /**
+     * @template A
+     * @template M
+     * @param Monoid<M> $mMonoid
+     * @param callable(A): M $f
+     * @param HK1<T, A> $hk
+     * @return M
+     */
+    public function foldMap(Monoid $mMonoid, callable $f, $hk)
+    {
+        return $this->foldable->foldr(
+            /**
+             * @param A $a
+             * @param M $m
+             * @return M
+             */
+            static fn ($a, $m) => $mMonoid->append($f($a), $m),
+            $mMonoid->mempty(),
+            $hk
+        );
+    }
+
+    /**
+     * @template M
+     * @param Monoid<M> $mMonoid
+     * @param HK1<T, M> $hk
+     * @return M
+     */
+    public function fold(Monoid $mMonoid, $hk)
+    {
+        return $this->foldMap(
+            $mMonoid,
+            /**
+             * @param M $m
+             * @return M
+             */
+            static fn ($m) => $m,
+            $hk
+        );
+    }
+}