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