better action debug info

[scpubgit/DKit.git] / lib / DX / Solver.pm

package DX::Solver;

use DX::RuleSet;
use DX::State;
use DX::ResultStream;
use List::Util qw(reduce);
use Moo;

has rule_set => (
  is => 'lazy',
  handles => [ qw(add_predicate add_rule) ],
  builder => sub {
    DX::RuleSet->new
  },
);

has facts => (is => 'ro', default => sub { {} });

has observation_policy => (is => 'rw');

has action_callback => (is => 'rw');

sub query {
  my ($self, @terms) = @_;
  $self->_solve({ allow_actions => 0 }, @terms);
}

sub solve {
  my ($self, @terms) = @_;
  $self->_solve({ allow_actions => 1 }, @terms);
}

sub ensure {
  my ($self, @terms) = @_;
  my $rs = $self->_solve({ allow_actions => 1 }, @terms);
  my $r = $rs->next;
  while ($r and $r->actions and my @ind = $r->independent_actions) {
    $self->run_action($_) for @ind;
    $rs = $self->_solve({ allow_actions => 1 }, @terms);
    $r = $rs->next;
  }
  return $r;
}

sub _solve {
  my ($self, $attrs, @terms) = @_;
  my $rule_set = $self->rule_set;
  my $head = $rule_set->expand_and_link(undef, @terms, [ 'materialize' ]);
  my $state = DX::State->new(
    next_op => $head,
    return_stack => [],
    by_id => {},
    scope => {},
    last_choice => [],
    facts => $self->facts,
    rule_set => $rule_set,
    %$attrs
  );
  return DX::ResultStream->new(
    for_state => $state,
    ($self->observation_policy
      ? (observation_policy => $self->observation_policy)
      : ()),
  );
}

sub run_action {
  my ($self, $action) = @_;
  if (my $cb = $self->action_callback) {
    $cb->($action);
  }
  my @invalidate = $action->run;
  while (my ($type, $value) = splice @invalidate, 0, 2) {
    $self->facts->{$type}->remove_value($value);
  }
}

1;