excise non-functioning depency group system
[scpubgit/DX.git] / lib / DX / Predicate / MemberAt.pm
CommitLineData
9d759b64 1package DX::Predicate::MemberAt;
2
4aeeab1e 3use DX::Utils qw(step INDICES_OF EXISTENCE_OF CONTENTS_OF string);
dcf2adc7 4use DX::ActionBuilder::ProxySetToAdd;
c35c4f36 5use DX::ActionBuilder::Null;
9d759b64 6use DX::Class;
7
8with 'DX::Role::Predicate';
9
9d759b64 10sub _possible_resolution_list {
11 my ($self, $coll, $key, $value) = @_;
12 die "First argument to member_at must be a structured value"
13 unless $coll->does('DX::Role::StructuredValue');
ba6fa299 14 my $basic_deps = sub {
15 (depends_on => [
8c6c9551 16 [ EXISTENCE_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
17 [ CONTENTS_OF ,=> $_[0] ],
18 [ CONTENTS_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
19 [ CONTENTS_OF ,=> $value ],
ba6fa299 20 ])
21 };
22 if ($value->is_set) {
23 # Already set values are only supported for recheck
24 trace member_at => "+D +K +V";
25 return () unless $key->is_set and my $cur_val = $coll->get_member_at($key);
26 return () unless $cur_val->equals($value);
27 return step(
28 actions => [],
29 $basic_deps->($key),
30 );
31 }
32 die "Bizarre: member_at called with non-fresh unset value"
33 unless $value->action_builder->isa('DX::ActionBuilder::UnsetValue');
34 if ($key->is_set) {
35 trace member_at => "+D +K -V";
36 if (my $cur_val = $coll->get_member_at($key)) {
37 my $set = $value->action_for_set_value($cur_val);
38 return step(
39 actions => [ $set ],
40 $basic_deps->($key),
41 );
42 }
43 if (my $p = $coll->value_path) {
44 my @path = (@$p, $key->string_value);
45 my $ab = DX::ActionBuilder::ProxySetToAdd->new(
46 target_path => \@path,
47 proxy_to => $coll->action_builder,
48 );
49 my $set = $value->action_for_set_value(
50 $value->but(
51 action_builder => $ab
52 )
53 );
54 return step(
55 actions => [ $set ],
56 $basic_deps->($key),
57 );
58 }
59 return ();
60 }
61 die "Bizarre: member_at called with non-fresh unset key"
62 unless $key->action_builder->isa('DX::ActionBuilder::UnsetValue');
63 trace member_at => "+D -K -V";
64 return map {
65 my $set_key = $key->action_for_set_value(my $kstr = string($_));
66 my $set_value = $value->action_for_set_value($coll->get_member_at($kstr));
67 step(
68 actions => [ $set_key, $set_value ],
69 $basic_deps->($key, $kstr),
70 );
71 } $coll->index_list;
9d759b64 72}
73
74sub selection_depends_on {
75 my ($self, $coll, $key, $value) = @_;
0498469a 76 die "NEEDS REDOING";
efad53c4 77 [ [ $coll => ($key->can_set_value ? INDICES_OF : (EXISTENCE_OF ,=> $key)) ],
9d759b64 78 $key,
79 $value,
80 ]
81}
82
831;