trace step actions as well as old/new hyp
[scpubgit/DX.git] / lib / DX / Step / Normal.pm
1 package DX::Step::Normal;
2
3 use Types::Standard qw(ArrayRef);
4 use DX::Utils qw(deparse);
5 use DX::Class;
6
7 with 'DX::Role::Step';
8
9 has actions => (is => 'ro', isa => ArrayRef[Action], required => 1);
10
11 has depends_on => (is => 'ro', isa => DependencyGroupList, required => 1);
12
13 has alternative_step => (is => 'ro', isa => Step);
14
15 sub but_first {
16   my ($self, @actions) = @_;
17   $self->but(actions => [ @actions, @{$self->actions} ]);
18 }
19
20 sub but_with_dependencies_on {
21   my ($self, @deps) = @_;
22   $self->but(depends_on => [ @{$self->depends_on}, @deps ]);
23 }
24
25 sub but_with_alternative_step {
26   my ($self, $step) = @_;
27   bless { %$self, alternative_step => $step }, ref($self);
28 }
29
30 sub apply_to {
31   my ($self, $old_hyp) = @_;
32   trace 'step.apply.old_hyp '.$self => $old_hyp;
33   trace 'step.apply.actions '.$self => $self->actions;
34   my $new_hyp = $self->_apply_to_hyp($old_hyp);
35   return (undef, $self->alternative_step) unless $new_hyp;
36   trace 'step.apply.new_hyp '.$self => $new_hyp;
37   return ($new_hyp, $self->alternative_step);
38 }
39
40 sub _apply_to_hyp {
41   my ($self, $old_hyp) = @_;
42   return undef unless my $hyp = $old_hyp->with_actions(@{$self->actions});
43   return $hyp->resolve_head_dependent_on($self->depends_on);
44 }
45
46 1;