3 use List::Util qw(reduce);
4 use aliased 'DX::Op::FromCode';
9 [ssh-key-installed [keyline]
11 [directory-at d [string t/scratch/.ssh]]
12 [directory-perms d [string 0755]]]
14 [file-at f [string t/scratch/.ssh/authorized_keys]]
15 [file-perms f [string 0644]]
16 [file-contains-line f keyline]]
27 my ($self, $state, $thing, $key) = @_;
28 die "key unbound" unless $key->is_bound;
29 die "thing bound" if $thing->is_bound;
30 if (my $value = $set->{$key->bound_value}) {
31 return $state->bind_value($thing->id, $value)->then($self->next);
33 return $state->backtrack;
40 my ($self, $state, @args) = @_;
42 return $state->then($self->next);
44 return $state->backtrack;
48 my $pop_ret = FromCode->new(code => sub { $_[1]->pop_return_stack });
52 reduce { FromCode->new(next => $a, code => $b) } $pop_ret, reverse @to_link;
56 my ($var_names, @body) = @_;
57 my %vars = map +($_ => {}), @$var_names;
58 my $inner_op = link_ops(@body);
60 my ($self, $state) = @_;
61 my $scope = $state->scope;
62 my $ret_op = FromCode->new(
63 code => sub { $_[1]->but(scope => $scope, next_op => $_[0]->next) },
66 $state->but(scope => { %$scope })
67 ->push_return_then($ret_op, $inner_op)
73 my ($predicate, @arg_spec) = @_;
74 die "didn't invent or yet" unless @$predicate == 1;
75 my ($option) = @$predicate;
77 my ($self, $state) = @_;
78 my $scope = $state->scope;
79 my $ret_op = FromCode->new(
80 code => sub { $_[1]->but(scope => $scope, next_op => $_[0]->next) },
84 my ($type, $val) = @$_;
86 $state->scope_var($val);
87 } elsif ($type eq 'value') {
88 $state->allocate_var('v', { bound_value => $val });
93 my $next_op = FromCode->new(
94 code => sub { $option->(@_, @args) },
97 $state->but(scope => {})
98 ->push_return_then($ret_op, $next_op);
103 my ($vars, $op) = @_;
111 )->assign_vars(map +($_ => {}), @$vars);
114 $names{path_status} = [
115 make_set_bind($path_status)
118 $names{path_exists} = [ make_test(
119 sub { $_[0]->{is_directory} || $_[0]->{is_file} }
122 $names{is_directory} = [
123 make_test(sub { $_[0]->bound_value->{is_directory} }),
126 # make_not(make_call($names{path_exists}, [ var => 'D' ])),
128 # sub { +{ action => 'mkdir', path => $_[0]->{path}, is_directory => 1, perms => unknown() } },
134 $names{dot_ssh} = [ make_exists(
136 make_call($names{path_status}, [ var => 'D' ], [ value => 't/scratch/.ssh' ]),
137 make_call($names{is_directory}, [ var => 'D' ])
140 my $state = make_state([], FromCode->new(code => $names{dot_ssh}[0]));
142 is($state->run, undef, 'Failure with no path status');
144 $path_status->{'t/scratch/.ssh'} = { is_directory => 0 };
146 is($state->run, undef, 'Failure with non-directory');
148 $path_status->{'t/scratch/.ssh'} = { is_directory => 1 };
150 isa_ok($state->run, 'DX::State', 'Success with directory');