lib/DX/Hypothesis.pm

   1 package DX::Hypothesis;
   2
   3 use DX::ActionPolicy::LockScope;
   4 use Types::Standard qw(ArrayRef);
   5 use DX::Class;
   6
   7 has scope => (is => 'ro', isa => Scope, required => 1);
   8
   9 has resolved_propositions => (
  10   is => 'ro', isa => ResolvedPropositionSet, required => 1
  11 );
  12
  13 has outstanding_propositions => (
  14   is => 'ro', isa => ArrayRef[Proposition], required => 1
  15 );
  16
  17 has actions => (
  18   is => 'ro', isa => ArrayRef[Action], required => 1
  19 );
  20
  21 has action_policy => (is => 'ro', isa => ActionPolicy, required => 1);
  22
  23 sub head_proposition { shift->outstanding_propositions->[0] }
  24
  25 sub with_actions {
  26   my ($self, @actions) = @_;
  27   my $hyp = $self;
  28   foreach my $act (@actions) {
  29     return undef unless $self->action_policy->allows($act);
  30     ($hyp, my @events) = $act->dry_run($hyp);
  31     return undef unless $hyp;
  32     $hyp = $hyp->but_recheck_for(@events);
  33     return undef unless $hyp;
  34   }
  35   return $hyp;
  36 }
  37
  38 sub but_recheck_for {
  39   my ($self, @events) = @_;
  40   my ($still_resolved, @recheck) = $self->resolved_propositions
  41                                         ->but_expire_for(@events);
  42   return $self unless @recheck;
  43
  44   my $ap = DX::ActionPolicy::LockScope->new(
  45     lock_to_depth => $self->scope->depth,
  46     next_policy => $self->action_policy,
  47   );
  48
  49   # we should probably be doing something about pruning the scope
  50   # but that's completely pointless until we have rules
  51
  52   my $hyp = ref($self)->new(
  53     scope => $self->scope,
  54     resolved_propositions => DX::ResolvedPropositionSet->new_empty,
  55     outstanding_propositions => \@recheck,
  56     actions => [],
  57     action_policy => $ap,
  58   );
  59
  60   my $ss = DX::SearchState->new_for($hyp);
  61
  62   return undef unless my $sol_ss = $ss->find_solution;
  63
  64   my $sol_rps = $sol_ss->current_hypothesis->resolved_propositions;
  65
  66   my $rps = $still_resolved;
  67
  68   $rps = $rps->with_updated_dependencies_for(
  69     $_, $sol_rps->dependencies_for($_)
  70   ) for @recheck;
  71
  72   return $self->but(resolved_propositions => $rps);
  73 }
  74
  75 sub resolve_head_dependent_on {
  76   my ($self, $depends) = @_;
  77   my ($first, @rest) = @{$self->outstanding_propositions};
  78   $self->but(
  79     resolved_propositions => $self->resolved_propositions
  80                                   ->with_resolution_for(
  81                                       $first,
  82                                       $depends,
  83                                     ),
  84     outstanding_propositions => \@rest,
  85   );
  86 }
  87
  88 1;