add set_value API

[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) },
  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
    )
  }
}

sub test_values {
  my ($vars, $test) = @_;
  sub {
    my ($self, $state) = @_;
    my @values = map $state->scope_var($_)->bound_value, @$vars;
    if ($test->(@values)) {
      return $state->then($self->next);
    }
    return $state->backtrack;
  }
}

sub make_op {
  my ($inner) = @_;
  FromCode->new(
    code => bind_array(S => \@servers),
    next => FromCode->new(
      code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
      next => $inner,
    )
  );
}

my $op = make_op;

sub make_state {
  my ($vars, $op) = @_;

  my %scope = map +($_ => $_), @{$vars};
  my %by_id = map +($_ => DX::Var->new(id => $_)), @{$vars};

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

my $stream = DX::ResultStream->new(for_state => make_state([ 'S' ], $op));

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

is($stream->next, undef, 'No more');

my $complex_op = FromCode->new(
  code => bind_array(S => \@servers),
  next => FromCode->new(
    code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
    next => FromCode->new(
      code => bind_array(P => \@shells),
      next => FromCode->new(
        code => test_values([ qw(S P) ], sub { $shells{$_[1]}{$_[0]} }),
      )
    )
  )
);

my $cstream = DX::ResultStream->new(
  for_state => make_state([ qw(S P) ], $complex_op)
);

is_deeply(
  [ $cstream->results ],
  [
    { P => 'csh', S => 'jim.example.com' },
    { P => 'csh', S => 'joe.example.com' },
    { P => 'bash', S => 'joe.example.com' },
    { P => 'csh', S => 'bob.example.com' },
  ],
  'Complex stream'
);

my $pop_stack = FromCode->new(
  code => sub { $_[1]->pop_return_stack }
);

my $inner_op = make_op($pop_stack);

my $call_op = FromCode->new(
  code => sub {
    my ($self, $state) = @_;
    my @rst = @{$state->return_stack};
    my $save_scope = $state->scope;
    my %scope = (S => $save_scope->{S});
    my $ret_op = FromCode->new(
      code => sub { $_[1]->but(scope => $save_scope, next_op => $_[0]->next) },
      next => $self->next,
    );
    $state->but(
      scope => \%scope,
      return_stack => [ @rst, $ret_op ],
      next_op => $inner_op
    );
  },
  next => FromCode->new(
    code => bind_array(P => \@shells),
    next => FromCode->new(
      code => test_values([ qw(S P) ], sub { $shells{$_[1]}{$_[0]} }),
    )
  )
);

my $callstream = DX::ResultStream->new(
  for_state => make_state([ qw(S P) ], $call_op)
);

is_deeply(
  [ $callstream->results ],
  [
    { P => 'csh', S => 'jim.example.com' },
    { P => 'csh', S => 'joe.example.com' },
    { P => 'bash', S => 'joe.example.com' },
    { P => 'csh', S => 'bob.example.com' },
  ],
  'Call stream'
);

my $has_csh = FromCode->new(
  code => test_values([ 'S' ], sub { $shells{csh}{$_[0]} }),
  next => $pop_stack
);
my $has_bash = FromCode->new(
  code => test_values([ 'S' ], sub { $shells{bash}{$_[0]} }),
  next => $pop_stack
);

my $or_code = sub {
  my ($self, $state) = @_;
  my $var = DX::Var->new(id => 'OR')->with_stream(
    my $stream = ArrayStream->from_array($has_csh, $has_bash)
  );
  my $inner_or = FromCode->new(
    code => sub { $_[1]->then($var->bound_value) }
  );
  $state->but(
    return_stack => [ @{$state->return_stack}, $self->next ],
    next_op => $inner_or
  )->mark_choice($var);
};

my $top_or = FromCode->new(
  code => bind_array(S => \@servers),
  next => FromCode->new(code => $or_code),
);

my $orstream = DX::ResultStream->new(
  for_state => make_state([ qw(S) ], $top_or)
);

is_deeply(
  [ $orstream->results ],
  [
    {
      S => "kitty.scsys.co.uk"
    },
    {
      S => "jim.example.com"
    },
    {
      S => "joe.example.com"
    },
    {
      S => "joe.example.com"
    },
    {
      S => "bob.example.com"
    }
  ],
  'Or stream'
);

my $top_or_2 = FromCode->new(
  code => bind_array(S => \@servers),
  next => FromCode->new(
    code => $or_code,
    next => FromCode->new(
      code => test_values([ 'S' ], sub { $_[0] =~ /\.example\.com$/ }),
    ),
  ),
);

my $orstream_2 = DX::ResultStream->new(
  for_state => make_state([ qw(S) ], $top_or_2)
);

is_deeply(
  [ $orstream_2->results ],
  [
    {
      S => "jim.example.com"
    },
    {
      S => "joe.example.com"
    },
    {
      S => "joe.example.com"
    },
    {
      S => "bob.example.com"
    }
  ],
  'Or stream'
);

done_testing;