From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 23 Apr 2017 04:15:34 +0000 (+0000)
Subject: MemberAt cut over to rspace/rstrat
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDX.git;a=commitdiff_plain;h=1f3fa757641adc0ddd2151f2d8b6f5cdac3dfd77

MemberAt cut over to rspace/rstrat
---

diff --git a/lib/DX/ActionBuilder/BoundValue.pm b/lib/DX/ActionBuilder/BoundValue.pm
index 4961c0d..ba92ab9 100644
--- a/lib/DX/ActionBuilder/BoundValue.pm
+++ b/lib/DX/ActionBuilder/BoundValue.pm
@@ -29,6 +29,8 @@ sub action_for_set_value {
   )
 }
 
+sub can_add_member { shift->inner_action_builder->can_add_member }
+
 sub action_for_add_member {
   my ($self, $at, $value) = @_;
   $at = $at->string_value if ref($at);
diff --git a/lib/DX/ActionBuilder/Null.pm b/lib/DX/ActionBuilder/Null.pm
index 1ed847e..769903e 100644
--- a/lib/DX/ActionBuilder/Null.pm
+++ b/lib/DX/ActionBuilder/Null.pm
@@ -16,6 +16,8 @@ sub can_set_value { 0 }
 
 sub action_for_set_value { undef }
 
+sub can_add_member { 0 }
+
 sub action_for_add_member { undef }
 
 sub action_for_set_member { undef }
diff --git a/lib/DX/Predicate/MemberAt.pm b/lib/DX/Predicate/MemberAt.pm
index 41c398f..cc81135 100644
--- a/lib/DX/Predicate/MemberAt.pm
+++ b/lib/DX/Predicate/MemberAt.pm
@@ -8,76 +8,33 @@ use DX::Class;
 with 'DX::Role::Predicate';
 
 sub _possible_resolution_list {
-  my ($self, $coll, $key, $value) = @_;
-  die "First argument to member_at must be a structured value"
-    unless $coll->does('DX::Role::StructuredValue');
-  my $basic_deps = sub {
-    (depends_on => [
-      [ EXISTENCE_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
-      [ CONTENTS_OF ,=> $_[0] ],
-      [ CONTENTS_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
-      [ CONTENTS_OF ,=> $value ],
-    ])
-  };
-  if ($value->is_set) {
-    # Already set values are only supported for recheck
-    trace member_at => "+D +K +V";
-    return () unless $key->is_set and my $cur_val = $coll->get_member_at($key);
-    return () unless $cur_val->equals($value);
-    return step(
-      actions => [],
-      $basic_deps->($key),
-    );
-  }
-  die "Bizarre: member_at called with non-fresh unset value"
-    unless $value->action_builder->isa('DX::ActionBuilder::UnsetValue');
-  if ($key->is_set) { 
-    trace member_at => "+D +K -V";
-    if (my $cur_val = $coll->get_member_at($key)) {
-      my $set = $value->action_for_set_value($cur_val);
-      return step(
-        actions => [ $set ],
-        $basic_deps->($key),
-      );
-    }
-    if (my $p = $coll->value_path) {
-      my @path = (@$p, $key->string_value);
-      my $ab = DX::ActionBuilder::ProxySetToAdd->new(
-        target_path => \@path,
-        proxy_to => $coll->action_builder,
-      );
-      my $set = $value->action_for_set_value(
-                  $value->but(
-                    action_builder => $ab
-                  )
-                );
-      return step(
-        actions => [ $set ],
-        $basic_deps->($key),
-      );
-    }
-    return ();
-  }
-  die "Bizarre: member_at called with non-fresh unset key"
-    unless $key->action_builder->isa('DX::ActionBuilder::UnsetValue');
-  trace member_at => "+D -K -V";
+  my ($self, @args) = @_;
+  my $rspace = $self->_resolution_space_for(@args);
+  return () unless my @members = @{$rspace->members};
   return map {
-           my $set_key = $key->action_for_set_value(my $kstr = string($_));
-           my $set_value = $value->action_for_set_value($coll->get_member_at($kstr));
-           step(
-             actions => [ $set_key, $set_value ],
-             $basic_deps->($key, $kstr),
-           );
-         } $coll->index_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,
-  ]
+    $_->isa('DX::Resolution')
+      ? step(
+          actions => $_->actions,
+          depends_on => $_->veracity_depends_on,
+        )
+      : do {
+          my ($db, @ap) = (
+            $_->veracity_depends_on_builder, @{$_->action_prototypes}
+          );
+          map {
+            my @cand = @{$_};
+            step(
+              actions => [
+                map {
+                  my ($inv, $type, @args) = @{$ap[$_]};
+                  $inv->${\"action_for_${type}"}(@args, @{$cand[$_]});
+                } 0..$#ap
+              ],
+              depends_on => $db->(@cand),
+            )
+          } @{$_->implementation_candidates};
+        }
+  } @members;
 }
 
 # member_at Dict Key Value
@@ -251,7 +208,7 @@ sub _resolution_space_for {
           [ $value => 'set_value' ],
         ],
         veracity_depends_on_builder => sub {
-          my ($this_key, $this_val) = @_;
+          my ($this_key, $this_val) = map @$_, @_;
           return [
             [ CONTENTS_OF ,=> $dict, $this_key->string_value ],
             [ CONTENTS_OF ,=> $key ],
diff --git a/lib/DX/Role/ActionBuilder.pm b/lib/DX/Role/ActionBuilder.pm
index 0e0c531..02c0bb9 100644
--- a/lib/DX/Role/ActionBuilder.pm
+++ b/lib/DX/Role/ActionBuilder.pm
@@ -4,6 +4,8 @@ use DX::Role;
 
 sub can_set_value { 1 }
 
+sub can_add_member { !!$_[0]->can('action_for_add_member') }
+
 requires 'action_for_set_value';
 
 1;
diff --git a/lib/DX/Value/Dict.pm b/lib/DX/Value/Dict.pm
index 85decc7..13cec8d 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_remove_member
+    can_add_member action_for_add_member action_for_remove_member
   ) ]
 );