indirect via resolve_value method

[scpubgit/DKit.git] / lib / DX / Op / Predicate.pm

package DX::Op::Predicate;

use List::Util qw(reduce);
use Moo;

has arg_names => (is => 'ro', required => 1);
has arg_cases => (is => 'ro', required => 1);

with 'DX::Role::Op::WithArgs';

sub run {
  my ($self, $state) = @_;
  my @args = @{$self->args};
  my @arg_names = @{$self->arg_names};
  my @cases = @{$self->arg_cases};
  CASE: while (my ($req, $code) = splice @cases, 0, 2) {
    local %_;
    my %map;
    my @was_bound;
    foreach my $i (0..$#arg_names) {
      if ($req->[$i] eq '+') {
        next CASE unless $args[$i]->is_bound;
        $_{$arg_names[$i]} = $state->resolve_value($args[$i]);
      } elsif ($req->[$i] eq '-') {
        next CASE if $args[$i]->is_bound;
      }
      $map{$arg_names[$i]} = $args[$i]->id;
      push @was_bound, $args[$i]->id if $args[$i]->is_bound;
    }
    my %effect = $code->();
    my @is_bound = (@was_bound, map $map{$_}, sort keys %effect);
    my @deps = map {
      my $is = $_;
      map +($is => $_), grep $is ne $_, @was_bound
    } @is_bound;
    return reduce {
      $a->${\('bind_'.$effect{$b}[0])}($map{$b}, $effect{$b}[1]);
    } $state->pop_return_stack->add_dependencies(@deps), sort keys %effect;
  }
  die "Arguments insufficiently bound";
}

1;