Commit | Line | Data |
7f385fb2 |
1 | package DX::ResolutionStrategy; |
2 | |
113f21b9 |
3 | use DX::Resolution; |
22d29594 |
4 | use Types::Standard qw(CodeRef Tuple slurpy); |
7f385fb2 |
5 | use DX::Class; |
6 | |
22d29594 |
7 | has action_prototypes => ( |
8 | is => 'ro', required => 1, |
9 | isa => ArrayRef[Tuple[Value, Str, slurpy ArrayRef[Value]]] |
10 | ); |
7f385fb2 |
11 | |
22d29594 |
12 | has veracity_depends_on_builder => ( |
13 | is => 'ro', required => 1, isa => CodeRef |
14 | ); |
7f385fb2 |
15 | |
22d29594 |
16 | has implementation_candidates => ( |
17 | is => 'ro', required => 1, isa => ArrayRef[ArrayRef[ArrayRef[Value]]] |
18 | ); |
7f385fb2 |
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 | |
113f21b9 |
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 | |
c99dbb05 |
52 | sub 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 |
78 | 1; |