From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 10 Oct 2015 06:13:47 +0000 (+0000)
Subject: member_at starting to work
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0498469a8299e06cc983edb90de11d5f352ab369;p=scpubgit%2FDX.git

member_at starting to work
---

diff --git a/lib/DX/Action/AddValue.pm b/lib/DX/Action/AddValue.pm
new file mode 100644
index 0000000..b9c8c69
--- /dev/null
+++ b/lib/DX/Action/AddValue.pm
@@ -0,0 +1,18 @@
+package DX::Action::AddValue;
+
+use DX::Update::AddValue;
+use DX::Class;
+
+with 'DX::Role::SimpleAction';
+
+has new_value => (is => 'ro', required => 1);
+
+sub _build__updates {
+  my ($self) = @_;
+  DX::Update::AddValue->new(
+    target_path => $self->target_path,
+    new_value => $self->new_value,
+  );
+}
+
+1;
diff --git a/lib/DX/Action/SetValue.pm b/lib/DX/Action/SetValue.pm
index 7b40168..d31ed58 100644
--- a/lib/DX/Action/SetValue.pm
+++ b/lib/DX/Action/SetValue.pm
@@ -3,25 +3,11 @@ package DX::Action::SetValue;
 use DX::Update::SetValue;
 use DX::Class;
 
-has target_path => (is => 'ro', required => 1);
+with 'DX::Role::SimpleAction';
 
 has new_value => (is => 'ro', required => 1);
 
-has _update => (is => 'lazy');
-
-sub dry_run {
-  my ($self, $hyp) = @_;
-  my ($scope, @events) = $self->_update->apply_to($hyp->scope);
-  return (
-    $hyp->but(
-      actions => [ @{$hyp->actions}, $self ],
-      scope => $scope
-    ),
-    @events,
-  );
-}
-
-sub _build__update {
+sub _build__updates {
   my ($self) = @_;
   DX::Update::SetValue->new(
     target_path => $self->target_path,
diff --git a/lib/DX/ActionBuilder/Normal.pm b/lib/DX/ActionBuilder/Normal.pm
index 5aeca56..cd5a7a0 100644
--- a/lib/DX/ActionBuilder/Normal.pm
+++ b/lib/DX/ActionBuilder/Normal.pm
@@ -1,5 +1,7 @@
 package DX::ActionBuilder::Normal;
 
+use DX::Action::SetValue;
+use DX::Action::AddValue;
 use DX::Class;
 
 with 'DX::Role::ActionBuilder';
@@ -14,4 +16,17 @@ sub action_for_set_value {
   );
 }
 
+sub action_for_add_member {
+  my ($self, $at, $value) = @_;
+  my @add_path = (@{$self->target_path}, ref($at) ? $at->string_value : $at);
+  DX::Action::AddValue->new(
+    target_path => \@add_path,
+    new_value => $value->but_set_action_builder(
+                   $self->but(target_path => \@add_path)
+                 )
+  );
+}
+
+sub action_for_remove_member { die 'WHUT' }
+
 1;
diff --git a/lib/DX/ActionBuilder/UnsetValue.pm b/lib/DX/ActionBuilder/UnsetValue.pm
index 6db2efd..c00a7fb 100644
--- a/lib/DX/ActionBuilder/UnsetValue.pm
+++ b/lib/DX/ActionBuilder/UnsetValue.pm
@@ -18,7 +18,8 @@ sub action_for_set_value {
   );
   DX::Action::SetValue->new(
     target_path => $self->target_path,
-    new_value => $value->but_set_action_builder($ab),
+    new_value => $value->but_set_action_builder($ab)
+                       ->but_set_identity_path($self->target_path),
   );
 }
 
diff --git a/lib/DX/DependencyMap.pm b/lib/DX/DependencyMap.pm
index 1b55b93..1d58d1a 100644
--- a/lib/DX/DependencyMap.pm
+++ b/lib/DX/DependencyMap.pm
@@ -78,7 +78,7 @@ sub _mangle_deps {
 sub _expand_deps {
   my ($self, $deps) = @_;
   my @exp;
-  DEP: foreach my $dep (@$deps) {
+  DEP: foreach my $dep (map @{$_}[1..$#$_], @$deps) {
     my ($type, @path) = @$dep;
     push @exp, [
       $type,
diff --git a/lib/DX/Predicate/IsDict.pm b/lib/DX/Predicate/IsDict.pm
index d30df47..ce2278d 100644
--- a/lib/DX/Predicate/IsDict.pm
+++ b/lib/DX/Predicate/IsDict.pm
@@ -12,13 +12,13 @@ sub _possible_resolution_list {
       unless $arg->isa('DX::Value::Dict');
     return step(
       actions => [],
-      depends_on => [ [ TYPE_OF ,=> $arg ] ]
+      depends_on => [ [ undef ,=> [ TYPE_OF ,=> $arg ] ] ]
     );
   }
   my $set = $arg->action_for_set_value(dict());
   return step(
     actions => [ $set ],
-    depends_on => [ [ TYPE_OF ,=> $arg ] ]
+    depends_on => [ [ undef ,=> [ TYPE_OF ,=> $arg ] ] ]
   );
 }
 
diff --git a/lib/DX/Predicate/MemberAt.pm b/lib/DX/Predicate/MemberAt.pm
index 6dfc141..3874cb8 100644
--- a/lib/DX/Predicate/MemberAt.pm
+++ b/lib/DX/Predicate/MemberAt.pm
@@ -1,6 +1,6 @@
 package DX::Predicate::MemberAt;
 
-use DX::Utils qw(step INDICES_OF EXISTENCE_OF);
+use DX::Utils qw(step INDICES_OF EXISTENCE_OF CONTENTS_OF);
 use DX::Class;
 
 with 'DX::Role::Predicate';
@@ -17,18 +17,24 @@ sub _possible_resolution_list {
   return (
     ($key->is_set
       ? map $_->but_with_dependencies_on(
-          [ undef ,=> [ $coll, EXISTENCE_OF ,=> $key ], $key ]
+          [ undef ,=>
+            [ EXISTENCE_OF ,=> $coll, $key->string_value ],
+            [ CONTENTS_OF ,=> $key ],
+          ]
         ), do {
           if (my $cur_val = $coll->get_member_at($key)) {
             $self->_make_equal($cur_val, $value);
           } elsif (
             $value->is_set
-            and my $add = $coll->action_for_add_value($key, $value)
+            and my $add = $coll->action_for_add_member($key, $value)
           ) {
             step(
               actions => [ $add ],
               depends_on => [
-                [ $coll => [ $coll, $key ], $value ]
+                [ $value =>
+                  [ CONTENTS_OF ,=> $coll, $key->string_value ],
+                  [ CONTENTS_OF ,=> $value ],
+                ],
               ],
             );
           } else {
@@ -42,7 +48,9 @@ sub _possible_resolution_list {
           my $set_key = $key->action_for_set_value($_);
           map $_->but_first($set_key)
                 ->but_with_dependencies_on(
-                    [ undef ,=> [ $coll, EXISTENCE_OF ,=> $key ] ]
+                    [ undef ,=>
+                      [ EXISTENCE_OF ,=> $coll, $key->string_value ]
+                    ]
                   ),
             $self->_make_equal($coll->get_member_at($_), $value);
         } $coll->index_list
@@ -53,6 +61,7 @@ sub _possible_resolution_list {
 
 sub selection_depends_on {
   my ($self, $coll, $key, $value) = @_;
+  die "NEEDS REDOING";
   [ [ $coll => ($key->can_set_value ? INDICES_OF : (EXISTENCE_OF ,=> $key)) ],
     $key,
     $value,
diff --git a/lib/DX/Role/Predicate.pm b/lib/DX/Role/Predicate.pm
index ffd903a..c1bcc0b 100644
--- a/lib/DX/Role/Predicate.pm
+++ b/lib/DX/Role/Predicate.pm
@@ -26,7 +26,11 @@ sub _make_equal {
       if ($left->is_set and my $set = $right->action_for_set_value($left)) {
         step(
           actions => [ $set ],
-          depends_on => [ [ $right => [ $left, $right ] ] ],
+          depends_on => [
+            [ $right =>
+              [ $left ], [ $right ]
+            ]
+          ]
         )
       } else {
         ()
@@ -36,7 +40,11 @@ sub _make_equal {
       if ($right->is_set and my $set = $left->action_for_set_value($right)) {
         step(
           actions => [ $set ],
-          depends_on => [ [ $left => [ $left, $right ] ] ],
+          depends_on => [
+            [ $left =>
+              [ $left ], [ $right ]
+            ]
+          ]
         )
       } else {
         ()
diff --git a/lib/DX/Role/SimpleAction.pm b/lib/DX/Role/SimpleAction.pm
index dd76714..f4b1d76 100644
--- a/lib/DX/Role/SimpleAction.pm
+++ b/lib/DX/Role/SimpleAction.pm
@@ -2,13 +2,15 @@ package DX::Role::SimpleAction;
 
 use DX::Role;
 
-has updates => (is => 'lazy');
+has target_path => (is => 'ro', required => 1);
 
-requires '_build_updates';
+has _updates => (is => 'lazy');
 
-sub dry_run_against {
+requires '_build__updates';
+
+sub dry_run {
   my ($self, $hyp) = @_;
-  my ($scope, @events) = $hyp->scope->apply_updates($self->updates);
+  my ($scope, @events) = $hyp->scope->apply_updates($self->_updates);
   return (
     $hyp->but(
       scope => $scope,
diff --git a/lib/DX/Role/Value.pm b/lib/DX/Role/Value.pm
index 9aae493..a5fc4a0 100644
--- a/lib/DX/Role/Value.pm
+++ b/lib/DX/Role/Value.pm
@@ -18,4 +18,9 @@ sub but_set_action_builder {
   $self->but(action_builder => $ab);
 }
 
+sub but_set_identity_path {
+  my ($self, $path) = @_;
+  $self->but(identity_path => $path);
+}
+
 1;
diff --git a/lib/DX/Scope.pm b/lib/DX/Scope.pm
index 95fb3e3..b41a5ce 100644
--- a/lib/DX/Scope.pm
+++ b/lib/DX/Scope.pm
@@ -51,4 +51,12 @@ sub with_member_at {
   );
 }
 
+sub apply_updates {
+  my ($self, @updates) = @_;
+  my @events;
+  my $scope = $self;
+  ($scope, @events) = ($_->apply_to($scope), @events) for @updates;
+  return ($scope, @events);
+}
+
 1;
diff --git a/lib/DX/Step/Normal.pm b/lib/DX/Step/Normal.pm
index c7cfbeb..6a1e589 100644
--- a/lib/DX/Step/Normal.pm
+++ b/lib/DX/Step/Normal.pm
@@ -8,6 +8,11 @@ has depends_on => (is => 'ro', required => 1);
 
 has alternative_step => (is => 'ro');
 
+sub but_with_dependencies_on {
+  my ($self, @deps) = @_;
+  $self->but(depends_on => [ @{$self->depends_on}, @deps ]);
+}
+
 sub but_with_alternative_step {
   my ($self, $step) = @_;
   bless { %$self, alternative_step => $step }, ref($self);
diff --git a/lib/DX/Update/AddValue.pm b/lib/DX/Update/AddValue.pm
index 9d8ed9d..1b9ee1c 100644
--- a/lib/DX/Update/AddValue.pm
+++ b/lib/DX/Update/AddValue.pm
@@ -8,7 +8,7 @@ with 'DX::Role::Update';
 has new_value => (is => 'ro', required => 1);
 
 sub apply_to {
-  my ($self, $scope) = @-;
+  my ($self, $scope) = @_;
   my @path = my @whole_path = @{$self->target_path};
   my $target = pop @path;
   my $new_value = $self->new_value;
diff --git a/lib/DX/Value/Dict.pm b/lib/DX/Value/Dict.pm
index 0eca21c..bc568a4 100644
--- a/lib/DX/Value/Dict.pm
+++ b/lib/DX/Value/Dict.pm
@@ -8,7 +8,7 @@ with 'DX::Role::StructuredValue';
 has '+action_builder' => (
   handles => [ qw(
     can_set_value action_for_set_value
-    action_for_add_member action_for_set_member action_for_remove_member
+    action_for_add_member action_for_remove_member
   ) ]
 );
 
diff --git a/need b/need
index 1c358e5..1edc217 100644
--- a/need
+++ b/need
@@ -1,5 +1,4 @@
-Action::AddValue
-        RemoveValue
+Action::RemoveValue
         BindValue
         SetBoundValue
         AddBoundValue
diff --git a/t/01basics.t b/t/01basics.t
index d75d00b..545a0de 100644
--- a/t/01basics.t
+++ b/t/01basics.t
@@ -29,6 +29,7 @@ my $hyp = use_module('DX::Hypothesis')->new(
   resolved_propositions => use_module('DX::ResolvedPropositionSet')->new_empty,
   outstanding_propositions => [
     proposition(is_dict => 'X'),
+    proposition(member_at => 'X', string('a'), string('b')),
   ],
   actions => [],
 );
@@ -38,4 +39,4 @@ my $ss = use_module('DX::SearchState')->new(
   alternatives => [],
 );
 
-::Dwarn($ss->with_one_step);
+::Dwarn($ss->with_one_step->with_one_step);