Commit | Line | Data |
a3104d41 |
1 | package DX::Step::ResolveProposition; |
9d759b64 |
2 | |
614f3d93 |
3 | use DX::Step::EnterRecheck; |
7af7ed1e |
4 | use DX::Step::Backtrack; |
614f3d93 |
5 | |
3e465d5d |
6 | use Types::Standard qw(ArrayRef); |
4016201b |
7 | use DX::Utils qw(deparse); |
614f3d93 |
8 | |
9d759b64 |
9 | use DX::Class; |
10 | |
3e465d5d |
11 | with 'DX::Role::Step'; |
9d759b64 |
12 | |
3e465d5d |
13 | has actions => (is => 'ro', isa => ArrayRef[Action], required => 1); |
9d759b64 |
14 | |
b413e0b9 |
15 | #has depends_on => (is => 'ro', isa => DependencyGroupList, required => 1); |
16 | |
17 | has depends_on => (is => 'ro', required => 1, coerce => sub { |
18 | my ($dep_groups) = @_; |
19 | my @exp; |
20 | assert_DependencyGroupList $dep_groups; |
21 | [ map { |
22 | my ($on, @deps) = @$_; |
23 | my @exp; |
24 | DEP: foreach my $dep (@deps) { |
25 | my ($type, @path) = @$dep; |
26 | push @exp, [ |
27 | $type, |
28 | map { ref() ? @{$_->identity_path or next DEP} : $_ } @path |
29 | ]; |
30 | } |
31 | (@exp ? [ $on, @exp ] : ()); |
32 | } @$dep_groups ]; |
33 | }); |
3e465d5d |
34 | |
ccf0d4fe |
35 | has resolves => (is => 'ro', isa => Proposition); |
36 | |
3e465d5d |
37 | has alternative_step => (is => 'ro', isa => Step); |
9d759b64 |
38 | |
4aeeab1e |
39 | sub but_first { |
40 | my ($self, @actions) = @_; |
41 | $self->but(actions => [ @actions, @{$self->actions} ]); |
42 | } |
43 | |
0498469a |
44 | sub but_with_dependencies_on { |
45 | my ($self, @deps) = @_; |
46 | $self->but(depends_on => [ @{$self->depends_on}, @deps ]); |
47 | } |
48 | |
9d759b64 |
49 | sub apply_to { |
7af7ed1e |
50 | my ($self, $old_ss) = @_; |
1dcbfaf8 |
51 | my $ns = do { |
7af7ed1e |
52 | if (my $prop = $old_ss->next_proposition) { |
86dbedb6 |
53 | DX::Step::ConsiderProposition->new( |
1dcbfaf8 |
54 | proposition => $prop |
55 | ) |
56 | } else { |
7af7ed1e |
57 | $old_ss->on_solution_step |
1dcbfaf8 |
58 | } |
59 | }; |
96e5344d |
60 | my $alt_step = $self->alternative_step; |
7af7ed1e |
61 | my $ss = $old_ss->but( |
62 | next_step => $ns, |
63 | ($alt_step |
64 | ? (alternatives => [ |
65 | [ $old_ss->current_hypothesis, $alt_step ], |
66 | @{$old_ss->alternatives} |
67 | ]) |
68 | : () |
f696251f |
69 | ), |
f696251f |
70 | ); |
7af7ed1e |
71 | my $new_ss = $self->_apply_to_ss($ss); |
72 | return $ss->but(next_step => DX::Step::Backtrack->new) unless $new_ss; |
73 | return $new_ss; |
9d759b64 |
74 | } |
75 | |
2ac94761 |
76 | sub _apply_to_ss { |
77 | my ($self, $old_ss) = @_; |
78 | my $old_hyp = $old_ss->current_hypothesis; |
77065529 |
79 | (my $hyp, my @recheck) = $old_hyp->with_resolution( |
cdca8723 |
80 | $self->resolves, $self->depends_on, $self->actions |
81 | ); |
2ac94761 |
82 | return undef unless $hyp; |
83 | return $self->_recheck_for( |
84 | $old_ss->but(current_hypothesis => $hyp), |
85 | @recheck |
86 | ); |
04844099 |
87 | } |
88 | |
2ac94761 |
89 | sub _recheck_for { |
90 | my ($self, $old_ss, @recheck) = @_; |
49e9aea0 |
91 | |
31753090 |
92 | return $old_ss unless @recheck; |
2ac94761 |
93 | |
614f3d93 |
94 | my $ss = $old_ss->but( |
95 | next_step => DX::Step::EnterRecheck->new( |
31753090 |
96 | proposition_list => \@recheck, |
7af7ed1e |
97 | on_completion_step => $old_ss->next_step, |
98 | on_failure_step => DX::Step::Backtrack->new, |
614f3d93 |
99 | ), |
310662b5 |
100 | ); |
101 | |
7af7ed1e |
102 | return $ss; |
9d759b64 |
103 | } |
104 | |
105 | 1; |