lib/DX/Predicate/MemberAt.pm

   1 package DX::Predicate::MemberAt;
   2
   3 use DX::Utils qw(:builders :dep_types);
   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   my $basic_deps = sub {
  15     (depends_on => [
  16       [ EXISTENCE_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
  17       [ CONTENTS_OF ,=> $_[0] ],
  18       [ CONTENTS_OF ,=> $coll, ($_[1]||$_[0])->string_value ],
  19       [ CONTENTS_OF ,=> $value ],
  20     ])
  21   };
  22   if ($value->is_set) {
  23     # Already set values are only supported for recheck
  24     trace member_at => "+D +K +V";
  25     return () unless $key->is_set and my $cur_val = $coll->get_member_at($key);
  26     return () unless $cur_val->equals($value);
  27     return step(
  28       actions => [],
  29       $basic_deps->($key),
  30     );
  31   }
  32   die "Bizarre: member_at called with non-fresh unset value"
  33     unless $value->action_builder->isa('DX::ActionBuilder::UnsetValue');
  34   if ($key->is_set) {
  35     trace member_at => "+D +K -V";
  36     if (my $cur_val = $coll->get_member_at($key)) {
  37       my $set = $value->action_for_set_value($cur_val);
  38       return step(
  39         actions => [ $set ],
  40         $basic_deps->($key),
  41       );
  42     }
  43     if (my $p = $coll->value_path) {
  44       my @path = (@$p, $key->string_value);
  45       my $ab = DX::ActionBuilder::ProxySetToAdd->new(
  46         target_path => \@path,
  47         proxy_to => $coll->action_builder,
  48       );
  49       my $set = $value->action_for_set_value(
  50                   $value->but(
  51                     action_builder => $ab
  52                   )
  53                 );
  54       return step(
  55         actions => [ $set ],
  56         $basic_deps->($key),
  57       );
  58     }
  59     return ();
  60   }
  61   die "Bizarre: member_at called with non-fresh unset key"
  62     unless $key->action_builder->isa('DX::ActionBuilder::UnsetValue');
  63   trace member_at => "+D -K -V";
  64   return map {
  65            my $set_key = $key->action_for_set_value(my $kstr = string($_));
  66            my $set_value = $value->action_for_set_value($coll->get_member_at($kstr));
  67            step(
  68              actions => [ $set_key, $set_value ],
  69              $basic_deps->($key, $kstr),
  70            );
  71          } $coll->index_list;
  72 }
  73
  74 sub selection_depends_on {
  75   my ($self, $coll, $key, $value) = @_;
  76   die "NEEDS REDOING";
  77   [ [ $coll => ($key->can_set_value ? INDICES_OF : (EXISTENCE_OF ,=> $key)) ],
  78     $key,
  79     $value,
  80   ]
  81 }
  82
  83 # member_at Dict Key Value
  84 #
  85 # Dict must be set to a dict (later maybe also an array and Key -> Index)
  86 #
  87 # Key bound ->
  88 #
  89 #   Key exists ->
  90 #
  91 #     Value bound ->
  92 #
  93 #       Dict.Key = Value ->
  94 #
  95 #         Trivial resolution
  96 #
  97 #       Dict.Key != Value ->
  98 #
  99 #         Failure
 100 #
 101 #     Value unbound ->
 102 #
 103 #       Set value to Dict.Key
 104 #
 105 #   Key does not exist ->
 106 #
 107 #     Dict allows add ->
 108 #
 109 #       Value bound ->
 110 #
 111 #         Failure on (exists Dict.Key, Value)
 112 #
 113 #       Value unbound ->
 114 #
 115 #         Set value to ProxySetToAdd value
 116 #
 117 #     Dict disallows add ->
 118 #
 119 #       Failure on (exists Dict.Key)
 120 #
 121 # Key unbound ->
 122 #
 123 #   Value must also be unbound, because seriously?
 124 #
 125 #   Set [Key, Value] to each pair in turn
 126
 127 sub _resolution_space_for {
 128   my ($self, $dict, $key, $value) = @_;
 129
 130   die "Fucked" unless $dict->does('DX::Role::StructuredValue');
 131
 132   if ($key->is_set) {
 133
 134     if (my $cur_val = $dict->get_member_at($key)) {
 135
 136       my $deps = [
 137         [ CONTENTS_OF ,=> $dict, $key->string_value ],
 138         [ CONTENTS_OF ,=> $value ],
 139       ];
 140
 141       if ($value->is_set) {
 142
 143         my @members = (
 144           $cur_val->equals($value)
 145             # Trivial resolution, D.K = V
 146             ? res(
 147                 actions => [],
 148                 veracity_depends_on => $deps,
 149               )
 150             # Failure
 151             : ()
 152         );
 153
 154         return rspace(
 155           geometry_depends_on => $deps,
 156           members => \@members
 157         );
 158
 159       }
 160
 161       return rspace(
 162         geometry_depends_on => [
 163           [ CONTENTS_OF ,=> $dict, $key->string_value ],
 164           [ TYPE_OF ,=> $value ],
 165         ],
 166         members => [
 167           res(
 168             actions => [ $value->action_for_set_value($cur_val) ],
 169             veracity_depends_on => $deps,
 170           ),
 171         ]
 172       );
 173
 174     }
 175
 176     if ($dict->can_add_member) {
 177
 178       my $deps = [
 179         [ EXISTENCE_OF ,=> $dict, $key->string_value ],
 180         [ TYPE_OF ,=> $value ],
 181       ];
 182
 183       if ($value->is_set) {
 184
 185         # If we get here, it means (currently) that we entered recheck
 186         # due to the deletion of the key from the dict and should fail
 187         # (or there's a bug in the compiler but let's hope not)
 188         return rspace(
 189           geometry_depends_on => $deps,
 190           members => [],
 191         );
 192       }
 193
 194       my @path = (@{$dict->value_path}, $key->string_value);
 195       my $ab = DX::ActionBuilder::ProxySetToAdd->new(
 196         target_path => \@path,
 197         proxy_to => $dict->action_builder,
 198       );
 199
 200       return rspace(
 201         geometry_depends_on => $deps,
 202         members => [
 203           res(
 204             actions => [
 205               $value->action_for_set_value(
 206                 $value->but(action_builder => $ab),
 207               ),
 208             ],
 209             # Veracity only depends on EXISTENCE_OF at this stage - if the
 210             # $value is later set, recheck will lead us down a different path
 211             # that will update those dependencies to include CONTENTS_OF
 212             veracity_depends_on => $deps,
 213           ),
 214         ],
 215       );
 216
 217     }
 218
 219     # Dict doesn't allow adding keys and key doesn't exist, so
 220     # the contents of the value is completely irrelevant to the failure
 221     return rspace(
 222       geometry_depends_on => [
 223         [ EXISTENCE_OF ,=> $dict, $key->string_value ],
 224       ],
 225       members => [],
 226     );
 227
 228   }
 229
 230   die "Fucked" if $value->is_set; # +D -K +V ? seriously ?
 231
 232   # Laaater we may need to look at autovivifying an additional key/index
 233   # ala ProxySetToAdd but I'm not 100% sure how that will make sense and
 234   # premature generalisation is the root of all eval.
 235
 236   my @cand = map [
 237     [ $_ ],
 238     [ $dict->get_member_at($_) ],
 239   ], map string($_), $dict->index_list;
 240
 241   return rspace(
 242     geometry_depends_on => [
 243       [ INDICES_OF ,=> $dict ],
 244       [ TYPE_OF ,=> $key ],
 245       [ TYPE_OF ,=> $value ],
 246     ],
 247     members => [
 248       rstrat(
 249         action_prototypes => [
 250           [ $key => 'set_value' ],
 251           [ $value => 'set_value' ],
 252         ],
 253         veracity_depends_on_builder => sub {
 254           my ($this_key, $this_val) = @_;
 255           return [
 256             [ CONTENTS_OF ,=> $dict, $this_key->string_value ],
 257             [ CONTENTS_OF ,=> $key ],
 258             [ CONTENTS_OF ,=> $value ],
 259           ];
 260         },
 261         implementation_candidates => \@cand,
 262       ),
 263     ],
 264   );
 265 }
 266
 267 1;