add propositions method to searchstate
[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 outstanding_propositions => (
15   is => 'ro', isa => ArrayRef[Proposition], required => 1
16 );
17
18 has actions => (
19   is => 'ro', isa => ArrayRef[Action], required => 1
20 );
21
22 has action_applications => (
23   is => 'ro', isa => ArrayRef[Action], required => 1
24 );
25
26 has action_policy => (is => 'ro', isa => ActionPolicy, required => 1);
27
28 sub head_proposition { shift->outstanding_propositions->[0] }
29
30 sub with_actions {
31   my ($self, @actions) = @_;
32   my $hyp = $self;
33   foreach my $act (@actions) {
34     return undef unless $self->action_policy->allows($act);
35     ($hyp, my @events) = $act->dry_run($hyp);
36     return undef unless $hyp;
37     $hyp = $hyp->but_recheck_for(@events);
38     return undef unless $hyp;
39   }
40   return $hyp;
41 }
42
43 sub but_recheck_for {
44   my ($self, @events) = @_;
45   my ($still_resolved, @recheck) = $self->resolved_propositions
46                                         ->but_expire_for(@events);
47   return $self unless @recheck;
48
49   my $ap = DX::ActionPolicy::LockScope->new(
50     lock_to_depth => $self->scope->depth,
51     next_policy => $self->action_policy,
52   );
53
54   # we should probably be doing something about pruning the scope
55   # but that's completely pointless until we have rules
56
57   my $hyp = ref($self)->new(
58     scope => $self->scope,
59     resolved_propositions => DX::ResolvedPropositionSet->new_empty,
60     outstanding_propositions => \@recheck,
61     actions => [],
62     action_applications => [],
63     action_policy => $ap,
64   );
65
66   my $pseq = DX::PropositionSequence->new(
67     members => \@recheck,
68     external_names => {},
69     internal_names => {},
70   );
71
72   trace 'step.recheck.hyp' => $hyp;
73
74   my $ss = DX::SearchState->new_for($hyp, $pseq);
75
76   my $sol_ss = $ss->find_solution;
77
78   unless ($sol_ss) {
79     trace 'step.recheck.fail' => 'argh';
80     return undef;
81   }
82
83   my $sol_rps = $sol_ss->current_hypothesis->resolved_propositions;
84
85   my $rps = $still_resolved;
86
87   $rps = $rps->with_updated_dependencies_for(
88     $_, $sol_rps->dependencies_for($_)
89   ) for @recheck;
90
91   trace 'step.recheck.done' => 'yay';
92
93   return $self->but(resolved_propositions => $rps);
94 }
95
96 sub resolve_head_dependent_on {
97   my ($self, $depends) = @_;
98   my ($first, @rest) = @{$self->outstanding_propositions};
99   $self->but(
100     resolved_propositions => $self->resolved_propositions
101                                   ->with_resolution_for(
102                                       $first,
103                                       $depends,
104                                     ),
105     outstanding_propositions => \@rest,
106   );
107 }
108
109 1;