fully type Resolution* classes
[scpubgit/DX.git] / lib / DX / ResolutionStrategy.pm
CommitLineData
7f385fb2 1package DX::ResolutionStrategy;
2
113f21b9 3use DX::Resolution;
22d29594 4use Types::Standard qw(CodeRef Tuple slurpy);
7f385fb2 5use DX::Class;
6
22d29594 7has action_prototypes => (
8 is => 'ro', required => 1,
9 isa => ArrayRef[Tuple[Value, Str, slurpy ArrayRef[Value]]]
10);
7f385fb2 11
22d29594 12has veracity_depends_on_builder => (
13 is => 'ro', required => 1, isa => CodeRef
14);
7f385fb2 15
22d29594 16has implementation_candidates => (
17 is => 'ro', required => 1, isa => ArrayRef[ArrayRef[ArrayRef[Value]]]
18);
7f385fb2 19
20has 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
113f21b9 29sub 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
45sub remainder {
46 my ($self) = @_;
47 my ($first, @rest) = @{$self->implementation_candidates};
48 return () unless @rest;
49 return $self->but(implementation_candidates => \@rest);
50}
51
c99dbb05 52sub for_deparse {
53 my ($self) = @_;
6162b001 54 [ word_and_body => [
55 'resolution_strategy',
c99dbb05 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 ] ] ],
6162b001 67 [ implementation_candidates => [ list => [
68 map [ list => [
69 map [ list => [
c99dbb05 70 map +($_->value_path ? [ value_path => $_->value_path ] : $_), @$_
71 ] ], @$_
72 ] ], @{$self->implementation_candidates}
73 ] ] ]
74 ] ],
75 ] ];
76}
77
7f385fb2 781;