chained rechecks
[scpubgit/DX.git] / lib / DX / Step / ResolveProposition.pm
CommitLineData
a3104d41 1package DX::Step::ResolveProposition;
9d759b64 2
614f3d93 3use DX::Step::EnterRecheck;
4
3e465d5d 5use Types::Standard qw(ArrayRef);
4016201b 6use DX::Utils qw(deparse);
614f3d93 7
9d759b64 8use DX::Class;
9
3e465d5d 10with 'DX::Role::Step';
9d759b64 11
3e465d5d 12has actions => (is => 'ro', isa => ArrayRef[Action], required => 1);
9d759b64 13
3e465d5d 14has depends_on => (is => 'ro', isa => DependencyGroupList, required => 1);
15
ccf0d4fe 16has resolves => (is => 'ro', isa => Proposition);
17
3e465d5d 18has alternative_step => (is => 'ro', isa => Step);
9d759b64 19
4aeeab1e 20sub but_first {
21 my ($self, @actions) = @_;
22 $self->but(actions => [ @actions, @{$self->actions} ]);
23}
24
0498469a 25sub but_with_dependencies_on {
26 my ($self, @deps) = @_;
27 $self->but(depends_on => [ @{$self->depends_on}, @deps ]);
28}
29
9d759b64 30sub apply_to {
110fd002 31 my ($self, $ss) = @_;
389ebbbb 32 trace 'step.apply.old_hyp '.$self => $ss->current_hypothesis;
173a11ea 33 trace 'step.apply.actions '.$self => $self->actions;
2ac94761 34 my $new_ss = $self->_apply_to_ss($ss);
35 return $ss->but(next_step => DX::Step::Backtrack->new) unless $new_ss;
389ebbbb 36 trace 'step.apply.new_hyp '.$self => $new_ss->current_hypothesis;
1dcbfaf8 37 my $ns = do {
389ebbbb 38 if (my $prop = $new_ss->next_proposition) {
86dbedb6 39 DX::Step::ConsiderProposition->new(
1dcbfaf8 40 proposition => $prop
41 )
42 } else {
389ebbbb 43 $new_ss->on_solution_step
1dcbfaf8 44 }
45 };
96e5344d 46 my $alt_step = $self->alternative_step;
f696251f 47 return (
389ebbbb 48 $new_ss->but(
f696251f 49 next_step => $ns,
96e5344d 50 ($alt_step
389ebbbb 51 ? (alternatives => [
52 [ $ss->current_hypothesis, $alt_step ],
53 @{$ss->alternatives}
54 ])
96e5344d 55 : ()
56 ),
f696251f 57 ),
f696251f 58 );
9d759b64 59}
60
2ac94761 61sub _apply_to_ss {
62 my ($self, $old_ss) = @_;
63 my $old_hyp = $old_ss->current_hypothesis;
77065529 64 (my $hyp, my @recheck) = $old_hyp->with_resolution(
cdca8723 65 $self->resolves, $self->depends_on, $self->actions
66 );
2ac94761 67 return undef unless $hyp;
68 return $self->_recheck_for(
69 $old_ss->but(current_hypothesis => $hyp),
70 @recheck
71 );
04844099 72}
73
2ac94761 74sub _recheck_for {
75 my ($self, $old_ss, @recheck) = @_;
49e9aea0 76
31753090 77 return $old_ss unless @recheck;
2ac94761 78
614f3d93 79 my $ss = $old_ss->but(
80 next_step => DX::Step::EnterRecheck->new(
31753090 81 proposition_list => \@recheck,
91543b62 82 on_completion_step => DX::Step::MarkAsSolution->new,
614f3d93 83 ),
310662b5 84 );
85
86 my $sp = DX::SearchProcess->new(
87 current_search_state => $ss,
88 );
04844099 89
310662b5 90 my $sol_sp = $sp->find_solution;
04844099 91
310662b5 92 unless ($sol_sp) {
04844099 93 trace 'step.recheck.fail' => 'argh';
94 return undef;
77065529 95 }
04844099 96
251177ea 97 return $sol_sp->current_search_state->but(is_solution_state => 0);
9d759b64 98}
99
1001;