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