provide and preserve aperture information

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

diff --git a/lib/DX/ActionBuilder/BoundValue.pm b/lib/DX/ActionBuilder/BoundValue.pm
index 8454992..7c06e1c 100644 (file)
--- a/lib/DX/ActionBuilder/BoundValue.pm
+++ b/lib/DX/ActionBuilder/BoundValue.pm
@@ -1,7 +1,8 @@
 package DX::ActionBuilder::BoundValue;
 
 use DX::Action::SetBoundValue;
-#use DX::Action::AddBoundValue;
+use DX::Action::AddBoundValue;
+use DX::Utils qw(:event_types);
 use DX::Class;
 
 with 'DX::Role::ActionBuilder';
@@ -14,17 +15,73 @@ has bound_to_path => (is => 'ro', required => 1);
 
 has inner_action_builder => (is => 'ro', required => 1);
 
+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->but_set_action_builder($self)
-                       ->but_set_identity_path($self->bound_to_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;