add member proxy for new key + unset value

[scpubgit/DX.git] / lib / DX / Predicate / MemberAt.pm

package DX::Predicate::MemberAt;

use DX::Utils qw(step INDICES_OF EXISTENCE_OF CONTENTS_OF string);
use DX::ActionBuilder::ProxySetToAdd;
use DX::Class;

with 'DX::Role::Predicate';

# Thing I've ignored for the moment: set key, unset value
# which for an add should result in an _make_equal style
# bind-with-add-action I suspect, but I don't have a current use
# case so punting while I get everything-the-fuck-else done

sub _possible_resolution_list {
  my ($self, $coll, $key, $value) = @_;
  die "First argument to member_at must be a structured value"
    unless $coll->does('DX::Role::StructuredValue');
  return (
    ($key->is_set
      ? map $_->but_with_dependencies_on(
          [ undef ,=>
            [ EXISTENCE_OF ,=> $coll, $key->string_value ],
            [ CONTENTS_OF ,=> $key ],
          ]
        ), do {
          if (my $cur_val = $coll->get_member_at($key)) {
            $self->_make_equal($cur_val, $value);
          } elsif (
            $value->is_set
            and my $add = $coll->action_for_add_member($key, $value)
          ) {
            step(
              actions => [ $add ],
              depends_on => [
                [ $value =>
                  [ CONTENTS_OF ,=> $coll, $key->string_value ],
                  [ CONTENTS_OF ,=> $value ],
                ],
              ],
            );
          } elsif (
            !$value->is_set
            and $value->action_builder->isa('DX::ActionBuilder::UnsetValue')
            and my $p = $coll->identity_path
          ) {
            my @path = (@$p, $key->string_value);
            my $ab = DX::ActionBuilder::ProxySetToAdd->new(
              target_path => \@path,
              proxy_to => $coll->action_builder,
            );
            my $set = $value->action_for_set_value(
                        $value->but(
                          identity_path => \@path,
                          action_builder => $ab
                        )
                      );
            step(
              actions => [ $set ],
              depends_on => [
                [ $value =>
                  [ CONTENTS_OF ,=> $coll, $key->string_value ],
                  [ CONTENTS_OF ,=> $value ],
                ],
              ],
            );
          } else {
            ()
          }
        }
      : ()
    ),
    ($key->can_set_value
      ? map {
          my $set_key = $key->action_for_set_value(string(my $kstr = $_));
          map $_->but_first($set_key)
                ->but_with_dependencies_on(
                    [ undef ,=>
                      [ EXISTENCE_OF ,=> $coll, $kstr ]
                    ]
                  ),
            $self->_make_equal($coll->get_member_at($_), $value);
        } $coll->index_list
      : ()
    ),
  );
}

sub selection_depends_on {
  my ($self, $coll, $key, $value) = @_;
  die "NEEDS REDOING";
  [ [ $coll => ($key->can_set_value ? INDICES_OF : (EXISTENCE_OF ,=> $key)) ],
    $key,
    $value,
  ]
}

1;