first cut of rspace/rstrat code with eq semi cut over

[scpubgit/DX.git] / lib / DX / Predicate / MemberAt.pm

diff --git a/lib/DX/Predicate/MemberAt.pm b/lib/DX/Predicate/MemberAt.pm
index e01f9d4..41c398f 100644 (file)
--- 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 CONTENTS_OF string);
+use DX::Utils qw(:builders :dep_types);
 use DX::ActionBuilder::ProxySetToAdd;
 use DX::ActionBuilder::Null;
 use DX::Class;
@@ -80,4 +80,188 @@ sub selection_depends_on {
   ]
 }
 
+# member_at Dict Key Value
+#
+# Dict must be set to a dict (later maybe also an array and Key -> Index)
+#
+# Key bound ->
+#
+#   Key exists ->
+#
+#     Value bound ->
+#
+#       Dict.Key = Value ->
+# 
+#         Trivial resolution
+#
+#       Dict.Key != Value ->
+#
+#         Failure
+#
+#     Value unbound ->
+#
+#       Set value to Dict.Key
+#
+#   Key does not exist ->
+#
+#     Dict allows add ->
+#
+#       Value bound ->
+#
+#         Failure on (exists Dict.Key, Value)
+#
+#       Value unbound ->
+#
+#         Set value to ProxySetToAdd value
+#
+#     Dict disallows add ->
+#
+#       Failure on (exists Dict.Key)
+#
+# Key unbound ->
+#
+#   Value must also be unbound, because seriously?
+#
+#   Set [Key, Value] to each pair in turn
+
+sub _resolution_space_for {
+  my ($self, $dict, $key, $value) = @_;
+
+  die "Fucked" unless $dict->does('DX::Role::StructuredValue');
+
+  if ($key->is_set) {
+
+    if (my $cur_val = $dict->get_member_at($key)) {
+
+      my $deps = [
+        [ CONTENTS_OF ,=> $dict, $key->string_value ],
+        [ CONTENTS_OF ,=> $value ],
+      ];
+
+      if ($value->is_set) {
+
+        my @members = (
+          $cur_val->equals($value)
+            # Trivial resolution, D.K = V
+            ? res(
+                actions => [],
+                veracity_depends_on => $deps,
+              )
+            # Failure
+            : ()
+        );
+
+        return rspace(
+          geometry_depends_on => $deps,
+          members => \@members
+        );
+
+      }
+
+      return rspace(
+        geometry_depends_on => [
+          [ CONTENTS_OF ,=> $dict, $key->string_value ],
+          [ TYPE_OF ,=> $value ],
+        ],
+        members => [
+          res(
+            actions => [ $value->action_for_set_value($cur_val) ],
+            veracity_depends_on => $deps,
+          ),
+        ]
+      );
+
+    }
+
+    if ($dict->can_add_member) {
+
+      my $deps = [
+        [ EXISTENCE_OF ,=> $dict, $key->string_value ],
+        [ TYPE_OF ,=> $value ],
+      ];
+
+      if ($value->is_set) {
+
+        # If we get here, it means (currently) that we entered recheck
+        # due to the deletion of the key from the dict and should fail
+        # (or there's a bug in the compiler but let's hope not)
+        return rspace(
+          geometry_depends_on => $deps,
+          members => [],
+        );
+      }
+
+      my @path = (@{$dict->value_path}, $key->string_value);
+      my $ab = DX::ActionBuilder::ProxySetToAdd->new(
+        target_path => \@path,
+        proxy_to => $dict->action_builder,
+      );
+
+      return rspace(
+        geometry_depends_on => $deps,
+        members => [
+          res(
+            actions => [
+              $value->action_for_set_value(
+                $value->but(action_builder => $ab),
+              ),
+            ],
+            # Veracity only depends on EXISTENCE_OF at this stage - if the
+            # $value is later set, recheck will lead us down a different path
+            # that will update those dependencies to include CONTENTS_OF
+            veracity_depends_on => $deps,
+          ),
+        ],
+      );
+
+    }
+
+    # Dict doesn't allow adding keys and key doesn't exist, so
+    # the contents of the value is completely irrelevant to the failure
+    return rspace(
+      geometry_depends_on => [
+        [ EXISTENCE_OF ,=> $dict, $key->string_value ],
+      ],
+      members => [],
+    );
+
+  }
+
+  die "Fucked" if $value->is_set; # +D -K +V ? seriously ?
+
+  # Laaater we may need to look at autovivifying an additional key/index
+  # ala ProxySetToAdd but I'm not 100% sure how that will make sense and
+  # premature generalisation is the root of all eval.
+
+  my @cand = map [
+    [ $_ ],
+    [ $dict->get_member_at($_) ],
+  ], map string($_), $dict->index_list;
+
+  return rspace(
+    geometry_depends_on => [
+      [ INDICES_OF ,=> $dict ],
+      [ TYPE_OF ,=> $key ],
+      [ TYPE_OF ,=> $value ],
+    ],
+    members => [
+      rstrat(
+        action_prototypes => [
+          [ $key => 'set_value' ],
+          [ $value => 'set_value' ],
+        ],
+        veracity_depends_on_builder => sub {
+          my ($this_key, $this_val) = @_;
+          return [
+            [ CONTENTS_OF ,=> $dict, $this_key->string_value ],
+            [ CONTENTS_OF ,=> $key ],
+            [ CONTENTS_OF ,=> $value ],
+          ];
+        },
+        implementation_candidates => \@cand,
+      ),
+    ],
+  );
+}
+
 1;