not and action infrastructure
[scpubgit/DKit.git] / lib / DX / Op / CallRule.pm
CommitLineData
b40e416a 1package DX::Op::CallRule;
2
3use DX::Op::SetScope;
4use DX::Op::FromCode;
5use DX::Var;
6use DX::ArrayStream;
7use Moo;
8
9with 'DX::Role::Op';
10
11has rule_name => (is => 'ro', required => 1);
12has rule_args => (is => 'ro', required => 1);
13has full_name => (is => 'lazy', builder => sub {
14 my ($self) = @_;
15 join('/', $self->rule_name, scalar @{$self->rule_args});
16});
17
18sub run {
19 my ($self, $state) = @_;
71217e42 20#warn "Call: ".$self->full_name;
385fa954 21 my @args = map $self->_expand_argspec($state, $_), @{$self->rule_args};
b40e416a 22 my @rules = @{$state->rule_set->rules->{$self->full_name}||[]};
23 die "No rules for ${\$self->full_name}" unless @rules;
734376d9 24 my $var = DX::Var->new(id => "rule:".$self->full_name)
b40e416a 25 ->with_stream(DX::ArrayStream->from_array(@rules));
26 my $invoke = DX::Op::FromCode->new(
27 code => sub {
28 my ($self, $state) = @_;
29 my ($names, $body) = @{$var->bound_value};
30 my %new; @new{@$names} = @args;
31 $state->but(scope => {})->assign_vars(%new)->then($body);
32 }
33 );
34 my $ret_op = DX::Op::SetScope->new(
35 scope => $state->scope, next => $self->next
36 );
37 $state->push_return_then($ret_op, $invoke)->mark_choice($var);
38}
39
401;