From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 18 Feb 2014 13:30:00 +0000 (+0000)
Subject: findall
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=138613a80580c7ce9808a16591ec7c9c7ea6578e;p=scpubgit%2FDKit.git

findall
---

diff --git a/lib/DX/Op/FindAll.pm b/lib/DX/Op/FindAll.pm
new file mode 100644
index 0000000..74caead
--- /dev/null
+++ b/lib/DX/Op/FindAll.pm
@@ -0,0 +1,60 @@
+package DX::Op::FindAll;
+
+use DX::Op::FromCode;
+use DX::Op::FindAllCollect;
+use DX::Var;
+use DX::OrderedSet;
+use DX::Op::Return;
+use Moo;
+
+with 'DX::Role::Op';
+
+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(
+    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 $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
+    )
+  );
+  $state->assign_vars($self->var_name => {})
+        ->push_return_then($ret, $invoke)->mark_choice($var);
+}
+
+1;
diff --git a/lib/DX/Op/FindAllCollect.pm b/lib/DX/Op/FindAllCollect.pm
new file mode 100644
index 0000000..297a880
--- /dev/null
+++ b/lib/DX/Op/FindAllCollect.pm
@@ -0,0 +1,18 @@
+package DX::Op::FindAllCollect;
+
+use Moo;
+
+with 'DX::Role::Op';
+
+has var_name => (is => 'ro', required => 1);
+
+has into => (is => 'ro', required => 1);
+
+sub run {
+  my ($self, $state) = @_;
+  my $current = $state->resolve_value($state->scope_var($self->var_name));
+  push @{$self->into}, $current;
+  return $state->backtrack;
+}
+
+1;
diff --git a/lib/DX/OrderedSet.pm b/lib/DX/OrderedSet.pm
index f3a860e..06af0e8 100644
--- a/lib/DX/OrderedSet.pm
+++ b/lib/DX/OrderedSet.pm
@@ -9,4 +9,8 @@ sub all { @{$_[0]->values} }
 
 sub to_stream { DX::ArrayStream->from_array($_[0]->all) }
 
+sub key_list { 0..$#{$_[0]->values} }
+
+sub get { $_[0]->values->[$_[1]] }
+
 1;
diff --git a/lib/DX/RuleSet.pm b/lib/DX/RuleSet.pm
index 1559d49..1fbb924 100644
--- a/lib/DX/RuleSet.pm
+++ b/lib/DX/RuleSet.pm
@@ -17,6 +17,7 @@ use DX::Op::Prop;
 use DX::Op::Exists;
 use DX::Op::Predicate;
 use DX::Op::HasAction;
+use DX::Op::FindAll;
 use List::Util qw(reduce);
 
 has rules => (is => 'ro', default => sub { {} });
@@ -78,6 +79,15 @@ sub _expand_op_not {
   );
 }
 
+sub _expand_op_findall {
+  my ($self, $coll_name, $var_name, @contents) = @_;
+  my $findall = 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_member_of {
   my ($self, $member_var, $coll_var) = @_;
   DX::Op::MemberOf->new(
diff --git a/t/findall.t b/t/findall.t
new file mode 100644
index 0000000..5302bbe
--- /dev/null
+++ b/t/findall.t
@@ -0,0 +1,47 @@
+use strictures 1;
+use Test::More;
+use DX::Solver;
+use DX::OrderedSet;
+
+my $solver = DX::Solver->new;
+
+{ package My::Server;
+  use Moo;
+  has name => (is => 'ro', required => 1);
+
+  package My::ShellInstalled;
+  use Moo;
+  has server => (is => 'ro', required => 1);
+  has shell => (is => 'ro', required => 1);
+}
+
+$solver->facts->{server} = DX::OrderedSet->new(
+  values => [ map My::Server->new(name => $_), qw(one two three four five) ]
+);
+$solver->facts->{shell_installed} = DX::OrderedSet->new(
+  values => [
+    (map My::ShellInstalled->new(server => $_, shell => 'bash'),
+       qw(one three four)),
+    (map My::ShellInstalled->new(server => $_, shell => 'csh'),
+       qw(two three five)),
+  ],
+);
+
+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' ]
+    ],
+  ]
+)->results;
+
+is_deeply(
+  [ map $_->name, $r[0]->value_for('X')->all ],
+  [ qw(one three four) ]
+);
+
+done_testing;