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