not and action infrastructure

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

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

my %observe_path = (
  '/home/me/.ssh' => { is_directory => 1 },
  '/home/me/.ssh/authorized_keys' => { is_file => 1 },
);
my %paths = %observe_path;

my $set_dot_ssh = FromCode->new(
  code => sub {
    my ($self, $state) = @_;
    $state->bind_var_then($state->scope_var('P'), '/home/me/.ssh', $self->next);
  }
);

my $path_status = FromCode->new(
  code => sub {
    my ($self, $state) = @_;
    if (my $p = $paths{$state->scope_var('P')->bound_value}) {
      return $state->bind_var_then($state->scope_var('PS'), $p, $self->next);
    }
    return $state->backtrack;
  }
);

my $check_dir = FromCode->new(
  code => sub {
    my ($self, $state) = @_;
    if ($state->scope_var('PS')->bound_value->{is_directory}) {
      return $state->then($self->next);
    }
    return $state->backtrack;
  }
);

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 $state = make_state([ 'P', 'PS' ],
  $set_dot_ssh->but(
    next => $path_status->but(next => $check_dir)
  )
);

{
  my $res = $state->run;
  is($res->scope_var('PS')->bound_value, $paths{'/home/me/.ssh'});
}

%paths = ();

is($state->run, undef);

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

my $ps_pop = $path_status->but(then => $pop_stack);

my @path_status = (
  $ps_pop,
  FromCode->new(
    code => sub {
      my ($self, $state) = @_;
      my $path = $state->scope_var('P')->bound_value;
      $state->return_from_run(
        DX::ObservationRequired->new(
          observer => sub { $paths{$path} = $observe_path{$path} },
          resume => $state->then($self->next),
        )
      );
    },
    next => $ps_pop
  )
);

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

  $state->push_return_then($self->next, $inner_or)
        ->mark_choice($var);
};

my $or_state = make_state([ 'P', 'PS' ],
  $set_dot_ssh->but(
    next => FromCode->new(
      code => $or_code,
      next => $check_dir
    )
  )
);

my $ob_req = $or_state->run;

$ob_req->observer->();

{
  my $res = $ob_req->resume->run;
  is($res->scope_var('PS')->bound_value, $paths{'/home/me/.ssh'});
}

done_testing;