better naming and help command for KeyMangler

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

package DX::Op::ModifyAction;

use Safe::Isa;
use DX::ObservationRequired;
use Moo;

with 'DX::Role::Op';

has vars => (is => 'ro', required => 1);
has builder => (is => 'ro', required => 1);

has _arg_map => (is => 'lazy', builder => sub {
  my ($self) = @_;
  my $name = 'arg0';
  +{ map +($name++, $_), @{$self->vars} };
});

sub run {
  my ($self, $state) = @_;
  ($state, my %args) = $self->_expand_args($state, %{$self->_arg_map});
  my ($subject, @vars) = @args{sort keys %args};
  my $subject_fact = $state->resolve_value($subject);
  die "Subject not a fact" unless $subject_fact->$_does('DX::Role::Fact');
  die "Subject has no action" unless $subject_fact->has_required_action;
  my $orig_action = $state->actions->{$subject_fact->required_action};
  my @deps = (
    @{$orig_action->dependencies},
    $state->action_dependencies(
      map $_->id, @vars
    ),
  );
  my @builder_args = (
    $orig_action,
    map $state->resolve_value($_), @vars
  );
  my $action = $self->builder->(@builder_args)
                    ->but(dependencies => \@deps);
  my @effect = $action->expected_effect;
  my %facts = %{$state->facts};
  while (my ($fact_type, $value) = splice(@effect, 0, 2)) {
    my $final_value = $value->but(required_action => $action->id);
    $facts{$fact_type} = $facts{$fact_type}->with_value($final_value);
  }
  $state->but(
            facts => \%facts,
            actions => { %{$state->actions}, $action->id => $action },
          )
        ->then($self->next);
}

1;