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