format aperture in backtrack trace

[scpubgit/DX.git] / lib / DX / ActionBuilder / BoundValue.pm

package DX::ActionBuilder::BoundValue;

use DX::Action::SetBoundValue;
use DX::Action::AddBoundValue;
use DX::Utils qw(:event_types);
use DX::Class;

with 'DX::Role::ActionBuilder';

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

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

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

has inner_action_builder => (
  is => 'ro', required => 1, isa => ActionBuilder
);

sub can_set_value { shift->inner_action_builder->can_set_value }

sub aperture_for_set_value {
  my ($self) = @_;
  return [] unless $self->can_set_value;
  [
    [ VALUE_SET ,=> @{$self->target_path} ],
    @{$self->inner_action_builder->aperture_for_set_value},
  ]
}

sub action_for_set_value {
  my ($self, $value) = @_;
  my $inner_action = $self->inner_action_builder->action_for_set_value($value);
  return undef unless $inner_action;
  DX::Action::SetBoundValue->new(
    target_path => $self->target_path,
    bound_to_path => $self->bound_to_path,
    rebind_path => $self->rebind_path,
    new_value => $value,
    inner_action => $inner_action,
  )
}

sub can_add_member { shift->inner_action_builder->can_add_member }

sub aperture_for_add_member {
  my ($self, $at) = @_;
  return [] unless $self->can_add_member;
  [
    [ VALUE_SET ,=> @{$self->target_path} ],
    @{$self->inner_action_builder->aperture_for_add_member($at)},
  ]
}

sub action_for_add_member {
  my ($self, $at, $value) = @_;
  $at = $at->string_value if ref($at);
  my $inner_action = $self->inner_action_builder
                          ->action_for_add_member($at, $value);
  return undef unless $inner_action;
  DX::Action::AddBoundValue->new(
    target_path => [ @{$self->target_path}, $at ],
    bound_to_path => [ @{$self->bound_to_path}, $at ],
    rebind_path => $self->rebind_path,
    new_value => $value,
    inner_action => $inner_action
  );
}

sub apply_to_value {
  my ($self, $value, $inner_value) = @_;
  my $new_value = $value->but_set_action_builder($self);
  return $new_value unless $new_value->isa('DX::Value::Dict');
  my %m = %{$new_value->members};
  return $new_value->but(
    members => {
      map {
        my $this_inner = $inner_value->get_member_at($_);
        ($_ => $self->but(
                 target_path => [ @{$self->target_path}, $_ ],
                 bound_to_path => [ @{$self->bound_to_path}, $_ ],
                 inner_action_builder => $this_inner->action_builder,
               )->apply_to_value($m{$_}, $this_inner))
      } keys %m
    },
  );
}

1;