lib/DX/ResolutionStrategy.pm

   1 package DX::ResolutionStrategy;
   2
   3 use DX::Resolution;
   4 use Types::Standard qw(CodeRef Tuple slurpy);
   5 use DX::Class;
   6
   7 has action_prototypes => (
   8   is => 'ro', required => 1,
   9   isa => ArrayRef[Tuple[Value, Str, slurpy ArrayRef[Value]]]
  10 );
  11
  12 has veracity_depends_on_builder => (
  13   is => 'ro', required => 1, isa => CodeRef
  14 );
  15
  16 has implementation_candidates => (
  17   is => 'ro', required => 1, isa => ArrayRef[ArrayRef[ArrayRef[Value]]]
  18 );
  19
  20 has aperture => (is => 'lazy', builder => sub {
  21   my ($self) = @_;
  22   return [
  23     # [ $thing, 'set_value' ] -> $thing->aperture_for_set_value
  24     map @{$_->[0]->${\'aperture_for_'.$_[1]}()},
  25       @{$self->action_prototypes}
  26   ];
  27 });
  28
  29 sub next_resolution {
  30   my ($self) = @_;
  31   return undef unless my ($first) = @{$self->implementation_candidates};
  32   my @ap = @{$self->action_prototypes};
  33   my @cand = @$first;
  34   return DX::Resolution->new(
  35     actions => [
  36       map {
  37         my ($inv, $type, @args) = @{$ap[$_]};
  38         $inv->${\"action_for_${type}"}(@args, @{$cand[$_]});
  39       } 0..$#ap
  40     ],
  41     veracity_depends_on => $self->veracity_depends_on_builder->(@cand),
  42   );
  43 }
  44
  45 sub remainder {
  46   my ($self) = @_;
  47   my ($first, @rest) = @{$self->implementation_candidates};
  48   return () unless @rest;
  49   return $self->but(implementation_candidates => \@rest);
  50 }
  51
  52 sub for_deparse {
  53   my ($self) = @_;
  54   [ word_and_body => [
  55     'resolution_strategy',
  56     [ pairs => [
  57       [ action_prototypes => [ block => [
  58         map {
  59           my ($inv, $type, @args) = @$_;
  60           [ statement => [
  61             [ symbol => $type ],
  62             [ value_path => $inv->value_path ],
  63             @args
  64           ] ]
  65         } @{$self->action_prototypes}
  66       ] ] ],
  67       [ implementation_candidates => [ list => [
  68         map [ list => [
  69           map [ list => [
  70             map +($_->value_path ? [ value_path => $_->value_path ] : $_), @$_
  71           ] ], @$_
  72         ] ], @{$self->implementation_candidates}
  73       ] ] ]
  74     ] ],
  75   ] ];
  76 }
  77
  78 1;