wheeeeeeeeee
[scpubgit/DKit.git] / lib / DX / Op / CallRule.pm
1 package DX::Op::CallRule;
2
3 use DX::Op::SetScope;
4 use DX::Op::FromCode;
5 use DX::Var;
6 use DX::ArrayStream;
7 use Moo;
8
9 with 'DX::Role::Op';
10
11 has rule_name => (is => 'ro', required => 1);
12 has rule_args => (is => 'ro', required => 1);
13 has full_name => (is => 'lazy', builder => sub {
14   my ($self) = @_;
15   join('/', $self->rule_name, scalar @{$self->rule_args});
16 });
17
18 sub run {
19   my ($self, $state) = @_;
20   my @args = map {
21     if (!ref($_)) {
22       $state->scope_var($_)
23     } elsif (ref($_) eq 'ARRAY') {
24       if ($_->[0] eq 'value') {
25         +{ bound_value => $_->[1] };
26       } else {
27         die "Arrayref in argspec is not value";
28       }
29     } else {
30       die "Argspec incomprehensible";
31     }
32   } @{$self->rule_args};
33   my @rules = @{$state->rule_set->rules->{$self->full_name}||[]};
34   die "No rules for ${\$self->full_name}" unless @rules;
35   my $var = DX::Var->new(id => 'OR')
36                    ->with_stream(DX::ArrayStream->from_array(@rules));
37   my $invoke = DX::Op::FromCode->new(
38     code => sub {
39       my ($self, $state) = @_;
40       my ($names, $body) = @{$var->bound_value};
41       my %new; @new{@$names} = @args;
42       $state->but(scope => {})->assign_vars(%new)->then($body);
43     }
44   );
45   my $ret_op = DX::Op::SetScope->new(
46     scope => $state->scope, next => $self->next
47   );
48   $state->push_return_then($ret_op, $invoke)->mark_choice($var);
49 }
50
51 1;