From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 18 Feb 2014 15:40:36 +0000 (+0000)
Subject: factor out FindIsh, implement ForEach
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDKit.git;a=commitdiff_plain;h=f5a02c91b10ef340dce1e1dacee0a761254f4d80

factor out FindIsh, implement ForEach
---

diff --git a/lib/DX/Op/FindAll.pm b/lib/DX/Op/FindAll.pm
index 74caead..f8770fb 100644
--- a/lib/DX/Op/FindAll.pm
+++ b/lib/DX/Op/FindAll.pm
@@ -7,54 +7,21 @@ use DX::OrderedSet;
 use DX::Op::Return;
 use Moo;
 
-with 'DX::Role::Op';
+with 'DX::Role::Op::FindIsh';
 
 has coll_name => (is => 'ro', required => 1);
 
-has var_name => (is => 'ro', required => 1);
-
-has body => (is => 'ro', required => 1);
-
-sub run {
-  my ($self, $state) = @_;
-  my $values = [];
-  my $coll = DX::OrderedSet->new(values => $values);
-  my $collect = DX::Op::FindAllCollect->new(
-    var_name => $self->var_name,
-    into => $values
-  );
-  my $do_body = DX::Op::FromCode->new(
+sub make_result_handler {
+  my ($self, $coll) = @_;
+  my $coll_name = $self->coll_name;
+  DX::Op::FromCode->new(
     code => sub {
       my ($self, $state) = @_;
-      $state->push_return_then($collect, $self->next);
+      $state->bind_value($state->scope->{$coll_name} => $coll)
+            ->then($self->next);
     },
-    next => $self->body
-  );
-  my $var = DX::Var->new(id => "rule:findall")
-                   ->with_stream(DX::ArrayStream->from_array(
-                       $do_body, DX::Op::Return->new
-                     ));
-  my $invoke = DX::Op::FromCode->new(
-    code => sub {
-      my ($self, $state) = @_;
-      my $op = $state->resolve_value($var);
-      $state->then($op);
-    }
-  );
-  my $coll_name = $self->coll_name;
-  my $ret = DX::Op::SetScope->new(
-    scope => $state->scope,
-    next => DX::Op::FromCode->new(
-      code => sub {
-        my ($self, $state) = @_;
-        $state->bind_value($state->scope->{$coll_name} => $coll)
-              ->then($self->next);
-      },
-      next => $self->next
-    )
+    next => $self->next
   );
-  $state->assign_vars($self->var_name => {})
-        ->push_return_then($ret, $invoke)->mark_choice($var);
 }
 
 1;
diff --git a/lib/DX/Op/ForEach.pm b/lib/DX/Op/ForEach.pm
new file mode 100644
index 0000000..c32561c
--- /dev/null
+++ b/lib/DX/Op/ForEach.pm
@@ -0,0 +1,20 @@
+package DX::Op::ForEach;
+
+use DX::Op::OneEach;
+use Moo;
+
+with 'DX::Role::Op::FindIsh';
+
+has each_body => (is => 'ro', required => 1);
+
+sub make_result_handler {
+  my ($self, $coll) = @_;
+  DX::Op::OneEach->new(
+    var_name => $self->var_name,
+    each_of => $coll->values,
+    each_body => $self->each_body,
+    next => $self->next
+  );
+}
+
+1;
diff --git a/lib/DX/Op/OneEach.pm b/lib/DX/Op/OneEach.pm
new file mode 100644
index 0000000..02f8b04
--- /dev/null
+++ b/lib/DX/Op/OneEach.pm
@@ -0,0 +1,25 @@
+package DX::Op::OneEach;
+
+use DX::Op::FromCode;
+use Moo;
+
+with 'DX::Role::Op';
+
+has var_name => (is => 'ro', required => 1);
+
+has each_of => (is => 'ro', required => 1);
+
+has each_body => (is => 'ro', required => 1);
+
+sub run {
+  my ($self, $state) = @_;
+  my ($this, @rest) = @{$self->each_of};
+  my $next_op = (@rest ? $self->but(each_of => \@rest) : $self->next);
+  my $ret_op = DX::Op::SetScope->new(
+    scope => $state->scope, next => $next_op
+  );
+  $state->assign_vars($self->var_name => { bound_value => $this })
+        ->push_return_then($ret_op, $self->each_body);
+}
+
+1;
diff --git a/lib/DX/Role/Op/FindIsh.pm b/lib/DX/Role/Op/FindIsh.pm
new file mode 100644
index 0000000..758070b
--- /dev/null
+++ b/lib/DX/Role/Op/FindIsh.pm
@@ -0,0 +1,52 @@
+package DX::Role::Op::FindIsh;
+
+use DX::Op::FromCode;
+use DX::Op::FindAllCollect;
+use DX::Var;
+use DX::OrderedSet;
+use DX::Op::Return;
+use Moo::Role;
+
+with 'DX::Role::Op';
+
+has var_name => (is => 'ro', required => 1);
+
+has body => (is => 'ro', required => 1);
+
+requires 'make_result_handler';
+
+sub run {
+  my ($self, $state) = @_;
+  my $values = [];
+  my $coll = DX::OrderedSet->new(values => $values);
+  my $collect = DX::Op::FindAllCollect->new(
+    var_name => $self->var_name,
+    into => $values
+  );
+  my $do_body = DX::Op::FromCode->new(
+    code => sub {
+      my ($self, $state) = @_;
+      $state->push_return_then($collect, $self->next);
+    },
+    next => $self->body
+  );
+  my $var = DX::Var->new(id => "rule:findall")
+                   ->with_stream(DX::ArrayStream->from_array(
+                       $do_body, DX::Op::Return->new
+                     ));
+  my $invoke = DX::Op::FromCode->new(
+    code => sub {
+      my ($self, $state) = @_;
+      my $op = $state->resolve_value($var);
+      $state->then($op);
+    }
+  );
+  my $ret = DX::Op::SetScope->new(
+    scope => $state->scope,
+    next => $self->make_result_handler($coll),
+  );
+  $state->assign_vars($self->var_name => {})
+        ->push_return_then($ret, $invoke)->mark_choice($var);
+}
+
+1;
diff --git a/lib/DX/RuleSet.pm b/lib/DX/RuleSet.pm
index 1fbb924..9449f92 100644
--- a/lib/DX/RuleSet.pm
+++ b/lib/DX/RuleSet.pm
@@ -18,6 +18,7 @@ use DX::Op::Exists;
 use DX::Op::Predicate;
 use DX::Op::HasAction;
 use DX::Op::FindAll;
+use DX::Op::ForEach;
 use List::Util qw(reduce);
 
 has rules => (is => 'ro', default => sub { {} });
@@ -81,13 +82,22 @@ sub _expand_op_not {
 
 sub _expand_op_findall {
   my ($self, $coll_name, $var_name, @contents) = @_;
-  my $findall = DX::Op::FindAll->new(
+  DX::Op::FindAll->new(
     coll_name => $coll_name,
     var_name => $var_name,
     body => $self->expand_and_link(DX::Op::Return->new, @contents),
   );
 }
 
+sub _expand_op_foreach {
+  my ($self, $var_name, $body, $each_body) = @_;
+  DX::Op::ForEach->new(
+    var_name => $var_name,
+    body => $self->expand_and_link(DX::Op::Return->new, @$body),
+    each_body => $self->expand_and_link(DX::Op::Return->new, @$each_body),
+  );
+}
+
 sub _expand_op_member_of {
   my ($self, $member_var, $coll_var) = @_;
   DX::Op::MemberOf->new(
diff --git a/t/findall.t b/t/findall.t
index 5302bbe..df84bfe 100644
--- a/t/findall.t
+++ b/t/findall.t
@@ -27,15 +27,19 @@ $solver->facts->{shell_installed} = DX::OrderedSet->new(
   ],
 );
 
+$solver->add_rule(has_shell => [ 'Srv', 'Shell' ],
+  [ exists => [ qw(Name SI) ] =>
+    [ member_of => 'SI', \'shell_installed' ],
+    [ prop => 'SI' => \'server' => 'Name' ],
+    [ prop => 'Srv' => \'name' => 'Name' ],
+    [ prop => 'SI' => \'shell' => 'Shell' ]
+  ],
+);
+
 my @r = $solver->query([ 'X' ],
   [ findall => X => S =>
     [ member_of => 'S', \'server' ],
-    [ exists => [ qw(Name SI) ] =>
-      [ member_of => 'SI', \'shell_installed' ],
-      [ prop => 'SI' => \'server' => 'Name' ],
-      [ prop => 'S' => \'name' => 'Name' ],
-      [ prop => 'SI' => \'shell' => \'bash' ]
-    ],
+    [ has_shell => 'S', \'bash' ],
   ]
 )->results;
 
@@ -44,4 +48,23 @@ is_deeply(
   [ qw(one three four) ]
 );
 
+@r = $solver->query([],
+  [ foreach => S => [ [ member_of => 'S', \'server' ] ],
+    [ [ has_shell => 'S' => \'bash' ] ] ]
+)->results;
+
+ok(!@r, 'No results for only bash');
+
+$solver->add_rule(has_any_shell => [ 'S' ] => [ has_shell => 'S' => \'bash' ]);
+$solver->add_rule(has_any_shell => [ 'S' ] => [ has_shell => 'S' => \'csh' ]);
+
+@r = $solver->query([],
+  [ foreach => S => [ [ member_of => 'S', \'server' ] ],
+    [ [ has_any_shell => 'S' ] ] ]
+)->results;
+
+# only three matches both legs of has_any_shell
+
+is(scalar(@r), 2, 'Two solutions for any shell');
+
 done_testing;