t/observe.t

   1 use strictures 1;
   2 use Test::More;
   3 use aliased 'DX::Op::FromCode';
   4 use aliased 'DX::ArrayStream';
   5 use DX::ResultStream;
   6 use DX::Var;
   7 use DX::State;
   8 use DX::ObservationRequired;
   9
  10 my %observe_path = (
  11   '/home/me/.ssh' => { is_directory => 1 },
  12   '/home/me/.ssh/authorized_keys' => { is_file => 1 },
  13 );
  14 my %paths = %observe_path;
  15
  16 my $set_dot_ssh = FromCode->new(
  17   code => sub {
  18     my ($self, $state) = @_;
  19     $state->bind_var_then($state->scope_var('P'), '/home/me/.ssh', $self->next);
  20   }
  21 );
  22
  23 my $path_status = FromCode->new(
  24   code => sub {
  25     my ($self, $state) = @_;
  26     if (my $p = $paths{$state->scope_var('P')->bound_value}) {
  27       return $state->bind_var_then($state->scope_var('PS'), $p, $self->next);
  28     }
  29     return $state->backtrack;
  30   }
  31 );
  32
  33 my $check_dir = FromCode->new(
  34   code => sub {
  35     my ($self, $state) = @_;
  36     if ($state->scope_var('PS')->bound_value->{is_directory}) {
  37       return $state->then($self->next);
  38     }
  39     return $state->backtrack;
  40   }
  41 );
  42
  43 sub make_state {
  44   my ($vars, $op) = @_;
  45
  46   my %scope = map +($_ => $_), @{$vars};
  47   my %by_id = map +($_ => DX::Var->new(id => $_)), @{$vars};
  48
  49   DX::State->new(
  50     next_op => $op,
  51     return_stack => [],
  52     by_id => \%by_id,
  53     scope => \%scope,
  54     last_choice => []
  55   );
  56 }
  57
  58 my $state = make_state([ 'P', 'PS' ],
  59   $set_dot_ssh->but(
  60     next => $path_status->but(next => $check_dir)
  61   )
  62 );
  63
  64 {
  65   my $res = $state->run;
  66   is($res->scope_var('PS')->bound_value, $paths{'/home/me/.ssh'});
  67 }
  68
  69 %paths = ();
  70
  71 is($state->run, undef);
  72
  73 my $pop_stack = FromCode->new(code => sub { $_[1]->pop_return_stack });
  74
  75 my $ps_pop = $path_status->but(then => $pop_stack);
  76
  77 my @path_status = (
  78   $ps_pop,
  79   FromCode->new(
  80     code => sub {
  81       my ($self, $state) = @_;
  82       my $path = $state->scope_var('P')->bound_value;
  83       $state->return_from_run(
  84         DX::ObservationRequired->new(
  85           observation => sub { $paths{$path} = $observe_path{$path} },
  86           resume => $state->then($self->next),
  87         )
  88       );
  89     },
  90     next => $ps_pop
  91   )
  92 );
  93
  94 my $or_code = sub {
  95   my ($self, $state) = @_;
  96   my $var = DX::Var->new(id => 'OR')->with_stream(
  97     ArrayStream->from_array(@path_status)
  98   );
  99   my $inner_or = FromCode->new(code => sub { $_[1]->then($var->bound_value) });
 100
 101   $state->push_return_then($self->next, $inner_or)
 102         ->mark_choice($var);
 103 };
 104
 105 my $or_state = make_state([ 'P', 'PS' ],
 106   $set_dot_ssh->but(
 107     next => FromCode->new(
 108       code => $or_code,
 109       next => $check_dir
 110     )
 111   )
 112 );
 113
 114 my $ob_req = $or_state->run;
 115
 116 $ob_req->observation->();
 117
 118 {
 119   my $res = $ob_req->resume->run;
 120   is($res->scope_var('PS')->bound_value, $paths{'/home/me/.ssh'});
 121 }
 122
 123 done_testing;