Commit | Line | Data |
9d759b64 |
1 | package DX::Predicate::MemberAt; |
2 | |
4aeeab1e |
3 | use DX::Utils qw(step INDICES_OF EXISTENCE_OF CONTENTS_OF string); |
9d759b64 |
4 | use DX::Class; |
5 | |
6 | with 'DX::Role::Predicate'; |
7 | |
8 | # Thing I've ignored for the moment: set key, unset value |
9 | # which for an add should result in an _make_equal style |
10 | # bind-with-add-action I suspect, but I don't have a current use |
11 | # case so punting while I get everything-the-fuck-else done |
12 | |
13 | sub _possible_resolution_list { |
14 | my ($self, $coll, $key, $value) = @_; |
15 | die "First argument to member_at must be a structured value" |
16 | unless $coll->does('DX::Role::StructuredValue'); |
17 | return ( |
18 | ($key->is_set |
19 | ? map $_->but_with_dependencies_on( |
0498469a |
20 | [ undef ,=> |
21 | [ EXISTENCE_OF ,=> $coll, $key->string_value ], |
22 | [ CONTENTS_OF ,=> $key ], |
23 | ] |
9d759b64 |
24 | ), do { |
25 | if (my $cur_val = $coll->get_member_at($key)) { |
26 | $self->_make_equal($cur_val, $value); |
27 | } elsif ( |
28 | $value->is_set |
0498469a |
29 | and my $add = $coll->action_for_add_member($key, $value) |
9d759b64 |
30 | ) { |
31 | step( |
32 | actions => [ $add ], |
33 | depends_on => [ |
0498469a |
34 | [ $value => |
35 | [ CONTENTS_OF ,=> $coll, $key->string_value ], |
36 | [ CONTENTS_OF ,=> $value ], |
37 | ], |
9d759b64 |
38 | ], |
39 | ); |
40 | } else { |
41 | () |
42 | } |
43 | } |
44 | : () |
45 | ), |
46 | ($key->can_set_value |
47 | ? map { |
4aeeab1e |
48 | my $set_key = $key->action_for_set_value(string(my $kstr = $_)); |
9d759b64 |
49 | map $_->but_first($set_key) |
50 | ->but_with_dependencies_on( |
0498469a |
51 | [ undef ,=> |
4aeeab1e |
52 | [ EXISTENCE_OF ,=> $coll, $kstr ] |
0498469a |
53 | ] |
9d759b64 |
54 | ), |
55 | $self->_make_equal($coll->get_member_at($_), $value); |
56 | } $coll->index_list |
57 | : () |
58 | ), |
59 | ); |
60 | } |
61 | |
62 | sub selection_depends_on { |
63 | my ($self, $coll, $key, $value) = @_; |
0498469a |
64 | die "NEEDS REDOING"; |
efad53c4 |
65 | [ [ $coll => ($key->can_set_value ? INDICES_OF : (EXISTENCE_OF ,=> $key)) ], |
9d759b64 |
66 | $key, |
67 | $value, |
68 | ] |
69 | } |
70 | |
71 | 1; |