Commit | Line | Data |
9d759b64 |
1 | package DX::Predicate::MemberAt; |
2 | |
7f385fb2 |
3 | use DX::Utils qw(:builders :dep_types); |
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 { |
1f3fa757 |
11 | my ($self, @args) = @_; |
12 | my $rspace = $self->_resolution_space_for(@args); |
13 | return () unless my @members = @{$rspace->members}; |
ba6fa299 |
14 | return map { |
1f3fa757 |
15 | $_->isa('DX::Resolution') |
16 | ? step( |
17 | actions => $_->actions, |
18 | depends_on => $_->veracity_depends_on, |
19 | ) |
20 | : do { |
21 | my ($db, @ap) = ( |
22 | $_->veracity_depends_on_builder, @{$_->action_prototypes} |
23 | ); |
24 | map { |
25 | my @cand = @{$_}; |
26 | step( |
27 | actions => [ |
28 | map { |
29 | my ($inv, $type, @args) = @{$ap[$_]}; |
30 | $inv->${\"action_for_${type}"}(@args, @{$cand[$_]}); |
31 | } 0..$#ap |
32 | ], |
33 | depends_on => $db->(@cand), |
34 | ) |
35 | } @{$_->implementation_candidates}; |
36 | } |
37 | } @members; |
9d759b64 |
38 | } |
39 | |
7f385fb2 |
40 | # member_at Dict Key Value |
41 | # |
42 | # Dict must be set to a dict (later maybe also an array and Key -> Index) |
43 | # |
44 | # Key bound -> |
45 | # |
46 | # Key exists -> |
47 | # |
48 | # Value bound -> |
49 | # |
50 | # Dict.Key = Value -> |
51 | # |
52 | # Trivial resolution |
53 | # |
54 | # Dict.Key != Value -> |
55 | # |
56 | # Failure |
57 | # |
58 | # Value unbound -> |
59 | # |
60 | # Set value to Dict.Key |
61 | # |
62 | # Key does not exist -> |
63 | # |
64 | # Dict allows add -> |
65 | # |
66 | # Value bound -> |
67 | # |
68 | # Failure on (exists Dict.Key, Value) |
69 | # |
70 | # Value unbound -> |
71 | # |
72 | # Set value to ProxySetToAdd value |
73 | # |
74 | # Dict disallows add -> |
75 | # |
76 | # Failure on (exists Dict.Key) |
77 | # |
78 | # Key unbound -> |
79 | # |
80 | # Value must also be unbound, because seriously? |
81 | # |
82 | # Set [Key, Value] to each pair in turn |
83 | |
84 | sub _resolution_space_for { |
85 | my ($self, $dict, $key, $value) = @_; |
86 | |
87 | die "Fucked" unless $dict->does('DX::Role::StructuredValue'); |
88 | |
89 | if ($key->is_set) { |
90 | |
91 | if (my $cur_val = $dict->get_member_at($key)) { |
92 | |
93 | my $deps = [ |
94 | [ CONTENTS_OF ,=> $dict, $key->string_value ], |
95 | [ CONTENTS_OF ,=> $value ], |
96 | ]; |
97 | |
98 | if ($value->is_set) { |
99 | |
100 | my @members = ( |
101 | $cur_val->equals($value) |
102 | # Trivial resolution, D.K = V |
103 | ? res( |
104 | actions => [], |
105 | veracity_depends_on => $deps, |
106 | ) |
107 | # Failure |
108 | : () |
109 | ); |
110 | |
111 | return rspace( |
112 | geometry_depends_on => $deps, |
113 | members => \@members |
114 | ); |
115 | |
116 | } |
117 | |
118 | return rspace( |
119 | geometry_depends_on => [ |
120 | [ CONTENTS_OF ,=> $dict, $key->string_value ], |
121 | [ TYPE_OF ,=> $value ], |
122 | ], |
123 | members => [ |
124 | res( |
125 | actions => [ $value->action_for_set_value($cur_val) ], |
126 | veracity_depends_on => $deps, |
127 | ), |
128 | ] |
129 | ); |
130 | |
131 | } |
132 | |
133 | if ($dict->can_add_member) { |
134 | |
135 | my $deps = [ |
136 | [ EXISTENCE_OF ,=> $dict, $key->string_value ], |
137 | [ TYPE_OF ,=> $value ], |
138 | ]; |
139 | |
140 | if ($value->is_set) { |
141 | |
142 | # If we get here, it means (currently) that we entered recheck |
143 | # due to the deletion of the key from the dict and should fail |
144 | # (or there's a bug in the compiler but let's hope not) |
145 | return rspace( |
146 | geometry_depends_on => $deps, |
147 | members => [], |
148 | ); |
149 | } |
150 | |
151 | my @path = (@{$dict->value_path}, $key->string_value); |
152 | my $ab = DX::ActionBuilder::ProxySetToAdd->new( |
153 | target_path => \@path, |
154 | proxy_to => $dict->action_builder, |
155 | ); |
156 | |
157 | return rspace( |
158 | geometry_depends_on => $deps, |
159 | members => [ |
160 | res( |
161 | actions => [ |
162 | $value->action_for_set_value( |
163 | $value->but(action_builder => $ab), |
164 | ), |
165 | ], |
166 | # Veracity only depends on EXISTENCE_OF at this stage - if the |
167 | # $value is later set, recheck will lead us down a different path |
168 | # that will update those dependencies to include CONTENTS_OF |
169 | veracity_depends_on => $deps, |
170 | ), |
171 | ], |
172 | ); |
173 | |
174 | } |
175 | |
176 | # Dict doesn't allow adding keys and key doesn't exist, so |
177 | # the contents of the value is completely irrelevant to the failure |
178 | return rspace( |
179 | geometry_depends_on => [ |
180 | [ EXISTENCE_OF ,=> $dict, $key->string_value ], |
181 | ], |
182 | members => [], |
183 | ); |
184 | |
185 | } |
186 | |
187 | die "Fucked" if $value->is_set; # +D -K +V ? seriously ? |
188 | |
189 | # Laaater we may need to look at autovivifying an additional key/index |
190 | # ala ProxySetToAdd but I'm not 100% sure how that will make sense and |
191 | # premature generalisation is the root of all eval. |
192 | |
193 | my @cand = map [ |
194 | [ $_ ], |
195 | [ $dict->get_member_at($_) ], |
196 | ], map string($_), $dict->index_list; |
197 | |
198 | return rspace( |
199 | geometry_depends_on => [ |
200 | [ INDICES_OF ,=> $dict ], |
201 | [ TYPE_OF ,=> $key ], |
202 | [ TYPE_OF ,=> $value ], |
203 | ], |
204 | members => [ |
205 | rstrat( |
206 | action_prototypes => [ |
207 | [ $key => 'set_value' ], |
208 | [ $value => 'set_value' ], |
209 | ], |
210 | veracity_depends_on_builder => sub { |
1f3fa757 |
211 | my ($this_key, $this_val) = map @$_, @_; |
7f385fb2 |
212 | return [ |
213 | [ CONTENTS_OF ,=> $dict, $this_key->string_value ], |
214 | [ CONTENTS_OF ,=> $key ], |
215 | [ CONTENTS_OF ,=> $value ], |
216 | ]; |
217 | }, |
218 | implementation_candidates => \@cand, |
219 | ), |
220 | ], |
221 | ); |
222 | } |
223 | |
9d759b64 |
224 | 1; |