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