move backtracking into a stream

[scpubgit/DKit.git] / t / basic.t

use strictures 1;
use Test::More;
use aliased 'DX::Op::FromCode';
use aliased 'DX::ArrayStream';
use DX::ResultStream;
use DX::Var;
use DX::State;
use Test::Exception;

my @servers = qw(
  kitty.scsys.co.uk
  jim.example.com
  joe.example.com
  pryde.scsys.co.uk
  bob.example.com
);

my @shells = qw(csh bash);

my %shells = (
  bash => { map +($_ => 1),
             qw(joe.example.com kitty.scsys.co.uk pryde.scsys.co.uk) },
  csh => { map +($_ => 1),
             qw(jim.example.com joe.example.com bob.example.com) },
);

sub bind_array {
  my ($var, $array) = @_;
  sub {
    my ($self, $state) = @_;
    $state->bind_stream_then(
      $state->scope_var($var),
      ArrayStream->from_array(@$array),
      $self->next
    )
  }
}

my $op = FromCode->new(
  code => bind_array(S => \@servers),
  next => FromCode->new(
    code => sub {
      my ($self, $state) = @_;
      my $server = $state->scope_var('S')->bound_value;
      if ($server =~ /\.example\.com$/) {
        return $state->then($self->next);
      }
      return $state->backtrack;
    },
  )
);

my %scope = map +($_ => $_), qw(S);
my %by_id = map +($_ => DX::Var->new(id => $_)), qw(S);

my $state = DX::State->new(
  next_op => $op,
  return_stack => [],
  by_id => \%by_id,
  scope => \%scope,
  last_choice => []
);

my $stream = DX::ResultStream->new(for_state => $state);

is($stream->next->{'S'}, $_)
  for qw(jim.example.com joe.example.com bob.example.com);

dies_ok { $stream->next } 'No more';

done_testing;