lib/DX/Op/ModifyAction.pm

   1 package DX::Op::ModifyAction;
   2
   3 use Safe::Isa;
   4 use DX::ObservationRequired;
   5 use Moo;
   6
   7 with 'DX::Role::Op';
   8
   9 has vars => (is => 'ro', required => 1);
  10 has builder => (is => 'ro', required => 1);
  11
  12 has _arg_map => (is => 'lazy', builder => sub {
  13   my ($self) = @_;
  14   my $name = 'arg0';
  15   +{ map +($name++, $_), @{$self->vars} };
  16 });
  17
  18 sub run {
  19   my ($self, $state) = @_;
  20   ($state, my %args) = $self->_expand_args($state, %{$self->_arg_map});
  21   my ($subject, @vars) = @args{sort keys %args};
  22   my $subject_fact = $state->resolve_value($subject);
  23   die "Subject not a fact" unless $subject_fact->$_does('DX::Role::Fact');
  24   die "Subject has no action" unless $subject_fact->has_required_action;
  25   my $orig_action = $state->actions->{$subject_fact->required_action};
  26   my @deps = (
  27     @{$orig_action->dependencies},
  28     $state->action_dependencies(
  29       map $_->id, @vars
  30     ),
  31   );
  32   my @builder_args = (
  33     $orig_action,
  34     map $state->resolve_value($_), @vars
  35   );
  36   my $action = $self->builder->(@builder_args)
  37                     ->but(dependencies => \@deps);
  38   my @effect = $action->expected_effect;
  39   my %facts = %{$state->facts};
  40   while (my ($fact_type, $value) = splice(@effect, 0, 2)) {
  41     my $final_value = $value->but(required_action => $action->id);
  42     $facts{$fact_type} = $facts{$fact_type}->with_value($final_value);
  43   }
  44   $state->but(
  45             facts => \%facts,
  46             actions => { %{$state->actions}, $action->id => $action },
  47           )
  48         ->then($self->next);
  49 }
  50
  51 1;