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 ($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() ? @{$_->value_path or next DEP} : $_ } @path
  29       ];
  30     }
  31     (@exp ? [ $on, @exp ] : ());
  32   } @$dep_groups ];
  33 });
  34
  35 has resolves => (is => 'ro', isa => Proposition);
  36
  37 has alternative_step => (is => 'ro', isa => Step);
  38
  39 sub but_first {
  40   my ($self, @actions) = @_;
  41   $self->but(actions => [ @actions, @{$self->actions} ]);
  42 }
  43
  44 sub but_with_dependencies_on {
  45   my ($self, @deps) = @_;
  46   $self->but(depends_on => [ @{$self->depends_on}, @deps ]);
  47 }
  48
  49 sub apply_to {
  50   my ($self, $old_ss) = @_;
  51   my $ns = do {
  52     if (my $prop = $old_ss->next_proposition) {
  53       DX::Step::ConsiderProposition->new(
  54         proposition => $prop
  55       )
  56     } else {
  57       $old_ss->on_solution_step
  58     }
  59   };
  60   my $alt_step = $self->alternative_step;
  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       : ()
  69     ),
  70   );
  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;
  74 }
  75
  76 sub _apply_to_ss {
  77   my ($self, $old_ss) = @_;
  78   my $old_hyp = $old_ss->current_hypothesis;
  79   (my $hyp, my @recheck) = $old_hyp->with_resolution(
  80     $self->resolves, $self->depends_on, $self->actions
  81   );
  82   return undef unless $hyp;
  83   return $self->_recheck_for(
  84     $old_ss->but(current_hypothesis => $hyp),
  85     @recheck
  86   );
  87 }
  88
  89 sub _recheck_for {
  90   my ($self, $old_ss, @recheck) = @_;
  91
  92   return $old_ss unless @recheck;
  93
  94   my $ss = $old_ss->but(
  95     next_step => DX::Step::EnterRecheck->new(
  96       proposition_list => \@recheck,
  97       on_completion_step => $old_ss->next_step,
  98       on_failure_step => DX::Step::Backtrack->new,
  99     ),
 100   );
 101
 102   return $ss;
 103 }
 104
 105 1;