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