pervasive type constraints

[scpubgit/DX.git] / lib / DX / Role / BoundValueAction.pm

package DX::Role::BoundValueAction;

use DX::Role;

with 'DX::Role::Action';

has target_path => (is => 'ro', required => 1, isa => ValuePath);

has bound_to_path => (is => 'ro', required => 1, isa => ValuePath);

has rebind_path => (is => 'ro', required => 1, isa => ValuePath);

has new_value => (is => 'ro', required => 1, isa => Value);

has inner_action => (is => 'ro', required => 1, isa => Action);

requires 'update_class';

sub for_deparse {
  my ($self) = @_;
  [ statement => [
    [ symbol => (split('::',ref($self)))[-1] ],
    [ value_path => $self->target_path ],
    $self->new_value,
  ] ];
}

sub dry_run {
  my ($self, $hyp) = @_;
  my ($outer_hyp, @inner_events) = $self->inner_action->dry_run(
    $hyp->but(
      action_applications => [ @{$hyp->action_applications}, $self ],
    ),
  );
  my $new_bound_to = do {
    my $targ = $outer_hyp->scope;
    $targ = $targ->get_member_at($_) for @{$self->bound_to_path};
    $targ;
  };
  my $new_ab = DX::ActionBuilder::BoundValue->new(
    target_path => $self->target_path,
    rebind_path => $self->rebind_path,
    bound_to_path => $self->bound_to_path,
    inner_action_builder => $new_bound_to->action_builder
  );
  my $value_with_ab = $new_ab->apply_to_value($self->new_value, $new_bound_to);
  my ($scope, @events) = $outer_hyp->scope->apply_updates(
                           $self->update_class->new(
                             target_path => $self->target_path,
                             new_value => $value_with_ab,
                           )
                         );
  my $new_bound = do {
    my $targ = $scope;
    $targ = $targ->get_member_at($_) for @{$self->rebind_path};
    $targ;
  };
  my @actions = @{$outer_hyp->actions};
  foreach my $idx (0.. $#actions) {
    my $act = $actions[$idx];
    if (
      $act->isa('DX::Action::BindValue')
        and join("\0", @{$act->target_path})
              eq join("\0", @{$self->rebind_path})
    ) {
      my $bind = splice @actions, $idx, 1;
      push @actions, $bind->but(new_value => $new_bound);
      last;
    }
  }
  return (
    $outer_hyp->but(scope => $scope, actions => \@actions),
    @inner_events, @events
  );
}

sub run { die }

1;