have with_actions return the recheck list
[scpubgit/DX.git] / lib / DX / Hypothesis.pm
1 package DX::Hypothesis;
2
3 use DX::ActionPolicy::LockScope;
4 use Types::Standard qw(ArrayRef);
5 use DX::Utils qw(deparse);
6 use DX::Class;
7
8 has scope => (is => 'ro', isa => Scope, required => 1);
9
10 has resolved_propositions => (
11   is => 'ro', isa => ResolvedPropositionSet, required => 1
12 );
13
14 has actions => (
15   is => 'ro', isa => ArrayRef[Action], required => 1
16 );
17
18 has action_applications => (
19   is => 'ro', isa => ArrayRef[Action], required => 1
20 );
21
22 has action_policy => (is => 'ro', isa => ActionPolicy, required => 1);
23
24 sub with_actions {
25   my ($self, @actions) = @_;
26   my $hyp = $self;
27   my @events;
28   foreach my $act (@actions) {
29     return undef unless $self->action_policy->allows($act);
30     ($hyp, my @these_events) = $act->dry_run($hyp);
31     return undef unless $hyp;
32     push @events, @these_events;
33   }
34   my ($still_resolved, @recheck) = $hyp->resolved_propositions
35                                        ->but_expire_for(@events);
36   return (
37     $hyp->but(resolved_propositions => $still_resolved),
38     @recheck
39   );
40 }
41
42 sub but_recheck_for {
43   my ($self, @recheck) = @_;
44
45   my $ap = DX::ActionPolicy::LockScope->new(
46     lock_to_depth => $self->scope->depth,
47     next_policy => $self->action_policy,
48   );
49
50   # we should probably be doing something about pruning the scope
51   # but that's completely pointless until we have rules
52
53   my $hyp = ref($self)->new(
54     scope => $self->scope,
55     resolved_propositions => DX::ResolvedPropositionSet->new_empty,
56     actions => [],
57     action_applications => [],
58     action_policy => $ap,
59   );
60
61   my $pseq = DX::PropositionSequence->new(
62     members => \@recheck,
63     external_names => {},
64     internal_names => {},
65   );
66
67   trace 'step.recheck.hyp' => $hyp;
68
69   my $ss = DX::SearchProcess->new_for($hyp, $pseq);
70
71   my $sol_ss = $ss->find_solution;
72
73   unless ($sol_ss) {
74     trace 'step.recheck.fail' => 'argh';
75     return undef;
76   }
77
78   my $sol_rps = $sol_ss->current_hypothesis->resolved_propositions;
79
80   my $rps = $self->resolved_propositions;
81
82   $rps = $rps->with_updated_dependencies_for(
83     $_, $sol_rps->dependencies_for($_)
84   ) for @recheck;
85
86   trace 'step.recheck.done' => 'yay';
87
88   return $self->but(resolved_propositions => $rps);
89 }
90
91 sub with_resolution {
92   my ($self, $prop, $depends, $actions) = @_;
93   (my $hyp, my @recheck) = $self->with_actions(@$actions);
94   return undef unless $hyp;
95   if (@recheck) {
96     $hyp = $hyp->but_recheck_for(@recheck);
97     return undef unless $hyp;
98   }
99   $hyp->but(
100     resolved_propositions => $self->resolved_propositions
101                                   ->with_resolution_for(
102                                       $prop,
103                                       $depends,
104                                     ),
105   );
106 }
107
108 1;