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;
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),
+ my ($self, @args) = @_;
+ my $rspace = $self->_resolution_space_for(@args);
+ return () unless my @members = @{$rspace->members};
+ return map {
+ $_->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
+#
+# 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 (my $p = $coll->value_path) {
- my @path = (@$p, $key->string_value);
+
+ 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 => $coll->action_builder,
+ proxy_to => $dict->action_builder,
);
- my $set = $value->action_for_set_value(
- $value->but(
- action_builder => $ab
- )
- );
- return step(
- actions => [ $set ],
- $basic_deps->($key),
+
+ 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,
+ ),
+ ],
);
+
}
- return ();
+
+ # 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 "Bizarre: member_at called with non-fresh unset key"
- unless $key->action_builder->isa('DX::ActionBuilder::UnsetValue');
- trace member_at => "+D -K -V";
- 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,
- ]
+ 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) = map @$_, @_;
+ return [
+ [ CONTENTS_OF ,=> $dict, $this_key->string_value ],
+ [ CONTENTS_OF ,=> $key ],
+ [ CONTENTS_OF ,=> $value ],
+ ];
+ },
+ implementation_candidates => \@cand,
+ ),
+ ],
+ );
}
1;
projects / scpubgit/DX.git / blobdiff