Commit | Line | Data |
b40d5c51 |
1 | use strictures 1; |
2 | use Test::More; |
3 | use aliased 'DX::Op::FromCode'; |
4 | use aliased 'DX::ArrayStream'; |
b40d5c51 |
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) = @_; |
0de441cd |
18 | $state->bind_value($state->scope_var('P'), '/home/me/.ssh') |
19 | ->then($self->next); |
b40d5c51 |
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}) { |
0de441cd |
27 | return $state->bind_value($state->scope_var('PS'), $p) |
28 | ->then($self->next); |
b40d5c51 |
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( |
5ef4d923 |
86 | observer => sub { $paths{$path} = $observe_path{$path} }, |
b40d5c51 |
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 | |
5ef4d923 |
117 | $ob_req->observer->(); |
b40d5c51 |
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; |