lib/DX/Step/ResolveProposition.pm

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