lib/DX/Predicate/MemberAt.pm

   1 package DX::Predicate::MemberAt;
   2
   3 use DX::Utils qw(step INDICES_OF EXISTENCE_OF CONTENTS_OF string);
   4 use DX::ActionBuilder::ProxySetToAdd;
   5 use DX::ActionBuilder::Null;
   6 use DX::Class;
   7
   8 with 'DX::Role::Predicate';
   9
  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');
  14   return (
  15     ($key->is_set
  16       ? map $_->but_with_dependencies_on(
  17           [ undef ,=>
  18             [ EXISTENCE_OF ,=> $coll, $key->string_value ],
  19             [ CONTENTS_OF ,=> $key ],
  20           ]
  21         ), do {
  22           if (my $cur_val = $coll->get_member_at($key)) {
  23             $self->_make_equal($cur_val, $value);
  24           } elsif (
  25             $value->is_set
  26             and my $add = $coll->action_for_add_member($key, $value)
  27           ) {
  28             step(
  29               actions => [ $add ],
  30               depends_on => [
  31                 [ $value =>
  32                   [ CONTENTS_OF ,=> $coll, $key->string_value ],
  33                   [ CONTENTS_OF ,=> $value ],
  34                 ],
  35               ],
  36             );
  37           } elsif (
  38             !$value->is_set
  39             and $value->action_builder->isa('DX::ActionBuilder::UnsetValue')
  40             and my $p = $coll->identity_path
  41           ) {
  42             my @path = (@$p, $key->string_value);
  43             my $ab = DX::ActionBuilder::ProxySetToAdd->new(
  44               target_path => \@path,
  45               proxy_to => $coll->action_builder,
  46             );
  47             my $set = $value->action_for_set_value(
  48                         $value->but(
  49                           identity_path => \@path,
  50                           action_builder => $ab
  51                         )
  52                       );
  53             step(
  54               actions => [ $set ],
  55               depends_on => [
  56                 [ $value =>
  57                   [ CONTENTS_OF ,=> $coll, $key->string_value ],
  58                   [ CONTENTS_OF ,=> $value ],
  59                 ],
  60               ],
  61             );
  62           } else {
  63             ()
  64           }
  65         }
  66       : ()
  67     ),
  68     (!$key->is_set
  69      && $key->action_builder->isa('DX::ActionBuilder::UnsetValue')
  70       ? map {
  71           my $set_key = DX::Action::SetValue->new(
  72             target_path => $key->action_builder->target_path,
  73             new_value => DX::ActionBuilder::Null->new(
  74                            target_path => $key->action_builder->target_path,
  75                          )->apply_to_value(string(my $kstr = $_))
  76           );
  77           map $_->but_first($set_key)
  78                 ->but_with_dependencies_on(
  79                     [ undef ,=>
  80                       [ EXISTENCE_OF ,=> $coll, $kstr ],
  81                       [ CONTENTS_OF ,=> $key ],
  82                     ]
  83                   ),
  84             $self->_make_equal($coll->get_member_at($_), $value);
  85         } $coll->index_list
  86       : ()
  87     ),
  88   );
  89 }
  90
  91 sub selection_depends_on {
  92   my ($self, $coll, $key, $value) = @_;
  93   die "NEEDS REDOING";
  94   [ [ $coll => ($key->can_set_value ? INDICES_OF : (EXISTENCE_OF ,=> $key)) ],
  95     $key,
  96     $value,
  97   ]
  98 }
  99
 100 1;