Working implementation of Haskell do notation in PHP

diff --git a/example/FreeDooDSLTest.php b/example/FreeDooDSLTest.php
index 8412f0b..a77ee47 100644 (file)
--- a/example/FreeDooDSLTest.php
+++ b/example/FreeDooDSLTest.php
@@ -15,7 +15,7 @@ class FreeDooDSLTest extends \PHPUnit\Framework\TestCase
     {
         $result = doo(
             let('a', Identity::of(1)),
-            let('b', Identity::of(2)),
+            let('b', Identity::of(3)),
             let('c', in(['a', 'b'], function (int $a, int $b): Identity {
                 return Identity::of($a + $b);
             })),
@@ -24,6 +24,6 @@ class FreeDooDSLTest extends \PHPUnit\Framework\TestCase
             })
         );
 
-        $this->assertEquals(Identity::of(9), $result);
+        $this->assertEquals(Identity::of(16), $result);
     }
 }

diff --git a/src/Monad/Control/Doo/Algebra/DooF.php b/src/Monad/Control/Doo/Algebra/DooF.php
index 9702dfc..cc054b3 100644 (file)
--- a/src/Monad/Control/Doo/Algebra/DooF.php
+++ b/src/Monad/Control/Doo/Algebra/DooF.php
@@ -8,7 +8,7 @@ use Widmogrod\Useful\PatternMatcher;
 
 /**
  *  DooF next = Let name m next
- *            | In [name] fn
+ *            | In [name] fn (m -> next)
  */
 interface DooF extends Functor, PatternMatcher
 {

diff --git a/src/Monad/Control/Doo/Algebra/In.php b/src/Monad/Control/Doo/Algebra/In.php
index 019b49a..ad9de04 100644 (file)
--- a/src/Monad/Control/Doo/Algebra/In.php
+++ b/src/Monad/Control/Doo/Algebra/In.php
@@ -1,19 +1,23 @@
 <?php
 
 declare(strict_types=1);
+
 namespace Widmogrod\Monad\Control\Doo\Algebra;
 
 use Widmogrod\FantasyLand\Functor;
+use function Widmogrod\Functional\compose;
 
 class In implements DooF
 {
     private $names;
     private $fn;
+    private $next;
 
-    public function __construct(array $names, callable $fn)
+    public function __construct(array $names, callable $fn, callable $next)
     {
         $this->names = $names;
         $this->fn = $fn;
+        $this->next = $next;
     }
 
     /**
@@ -23,7 +27,8 @@ class In implements DooF
     {
         return new self(
             $this->names,
-            $this->fn
+            $this->fn,
+            compose($function, $this->next)
         );
     }
 
@@ -32,6 +37,6 @@ class In implements DooF
      */
     public function patternMatched(callable $fn)
     {
-        return $fn($this->names, $this->fn);
+        return $fn($this->names, $this->fn, $this->next);
     }
 }

diff --git a/src/Monad/Control/Doo/actions.php b/src/Monad/Control/Doo/actions.php
index dcd0bb2..6324877 100644 (file)
--- a/src/Monad/Control/Doo/actions.php
+++ b/src/Monad/Control/Doo/actions.php
@@ -1,6 +1,7 @@
 <?php
 
 declare(strict_types=1);
+
 namespace Widmogrod\Monad\Control\Doo;
 
 use Widmogrod\FantasyLand\Monad;
@@ -19,5 +20,5 @@ function let(string $name, Monad $m): MonadFree
 
 function in(array $names, callable $fn): MonadFree
 {
-    return liftF(new Algebra\In($names, $fn));
+    return liftF(new Algebra\In($names, $fn, Pure::of));
 }

diff --git a/src/Monad/Control/Doo/interpretation.php b/src/Monad/Control/Doo/interpretation.php
index 41bfee1..34d1ba6 100644 (file)
--- a/src/Monad/Control/Doo/interpretation.php
+++ b/src/Monad/Control/Doo/interpretation.php
@@ -42,13 +42,13 @@ function interpretation(DooF $f)
                 });
             });
         },
-        In::class => function (array $names, callable $fn): Reader {
-            return Reader::of(function (Registry $registry) use ($names, $fn) {
+        In::class => function (array $names, callable $fn, callable $next): Reader {
+            return Reader::of(function (Registry $registry) use ($names, $fn, $next) {
                 $args = array_map(function ($name) use ($registry) {
                     return $registry->get($name);
                 }, $names);
 
-                return Pure::of($fn(...$args));
+                return $next($fn(...$args));
             });
         },
     ], $f);