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