From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 12 Mar 2016 11:33:07 +0000 (+0000)
Subject: AddBoundValue action
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5b066a1c421a3793de66a4a37ff1073255a0aee0;p=scpubgit%2FDX.git

AddBoundValue action
---

diff --git a/fragments/bind b/fragments/bind
index 88f77c5..de424d3 100644
--- a/fragments/bind
+++ b/fragments/bind
@@ -5,3 +5,11 @@ qact
 eq Y {{ foo 1 }}
 qact
 .
+?
+dict ?X {{ foo {{ bar 1 }} }}
+member_at X 'foo' ?Y
+member_at Y 'bar' ?Z
+eq Z 2
+member_at Y 'baz' 4
+qact
+.
diff --git a/lib/DX/Action/AddBoundValue.pm b/lib/DX/Action/AddBoundValue.pm
new file mode 100644
index 0000000..54cd5fd
--- /dev/null
+++ b/lib/DX/Action/AddBoundValue.pm
@@ -0,0 +1,10 @@
+package DX::Action::AddBoundValue;
+
+use DX::Update::AddValue;
+use DX::Class;
+
+with 'DX::Role::BoundValueAction';
+
+sub update_class { 'DX::Update::AddValue' }
+
+1;
diff --git a/lib/DX/Action/SetBoundValue.pm b/lib/DX/Action/SetBoundValue.pm
index 614ec36..cd7dca2 100644
--- a/lib/DX/Action/SetBoundValue.pm
+++ b/lib/DX/Action/SetBoundValue.pm
@@ -3,67 +3,8 @@ package DX::Action::SetBoundValue;
 use DX::Update::SetValue;
 use DX::Class;
 
-with 'DX::Role::Action';
+with 'DX::Role::BoundValueAction';
 
-has target_path => (is => 'ro', required => 1);
-
-has bound_to_path => (is => 'ro', required => 1);
-
-has rebind_path => (is => 'ro', required => 1);
-
-has new_value => (is => 'ro', required => 1);
-
-has inner_action => (is => 'ro', required => 1);
-
-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(
-                           DX::Update::SetValue->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 }
+sub update_class { 'DX::Update::SetValue' }
 
 1;
diff --git a/lib/DX/ActionBuilder/BoundValue.pm b/lib/DX/ActionBuilder/BoundValue.pm
index 9138dbe..35e4232 100644
--- a/lib/DX/ActionBuilder/BoundValue.pm
+++ b/lib/DX/ActionBuilder/BoundValue.pm
@@ -1,7 +1,7 @@
 package DX::ActionBuilder::BoundValue;
 
 use DX::Action::SetBoundValue;
-#use DX::Action::AddBoundValue;
+use DX::Action::AddBoundValue;
 use DX::Class;
 
 with 'DX::Role::ActionBuilder';
@@ -27,6 +27,21 @@ sub action_for_set_value {
   )
 }
 
+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)
diff --git a/lib/DX/Deparse.pm b/lib/DX/Deparse.pm
index 8edfffd..2d3b2ac 100644
--- a/lib/DX/Deparse.pm
+++ b/lib/DX/Deparse.pm
@@ -122,6 +122,11 @@ sub _fmt_action_bindvalue {
   join ' ', BindValue => $path, $bound_path;
 }
 
+sub _fmt_action_addboundvalue {
+  my ($self, $action, $meta) = @_;
+  $self->_fmt_action_generic(AddBoundValue => $action, $meta);
+}
+
 sub _fmt_action_setboundvalue {
   my ($self, $action, $meta) = @_;
   $self->_fmt_action_generic(SetBoundValue => $action, $meta);
diff --git a/lib/DX/Role/BoundValueAction.pm b/lib/DX/Role/BoundValueAction.pm
new file mode 100644
index 0000000..37b317b
--- /dev/null
+++ b/lib/DX/Role/BoundValueAction.pm
@@ -0,0 +1,70 @@
+package DX::Role::BoundValueAction;
+
+use DX::Role;
+
+with 'DX::Role::Action';
+
+has target_path => (is => 'ro', required => 1);
+
+has bound_to_path => (is => 'ro', required => 1);
+
+has rebind_path => (is => 'ro', required => 1);
+
+has new_value => (is => 'ro', required => 1);
+
+has inner_action => (is => 'ro', required => 1);
+
+requires 'update_class';
+
+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;