factor action execution out into solver method
[scpubgit/DKit.git] / t / dot_ssh.t
index 47a178b..2e37b31 100644 (file)
@@ -4,6 +4,7 @@ use DX::Solver;
 use DX::SetOver;
 use DX::Observer::FromCode;
 use DX::Action::FromCode;
+use File::Spec;
 use Test::Exception;
 
 {
@@ -12,7 +13,7 @@ use Test::Exception;
   use Moo;
 
   has path => (is => 'ro', required => 1);
-  has info => (is => 'ro');
+  has info => (is => 'ro', predicate => 1);
 
   package My::PathStatusInfo;
 
@@ -39,6 +40,9 @@ my %protos = (
 my %empty = (
   '.ssh' => My::PathStatus->new(
     path => '.ssh'
+  ),
+  '.ssh/authorized_keys' => My::PathStatus->new(
+    path => '.ssh/authorized_keys'
   )
 );
 
@@ -53,29 +57,29 @@ my $solver = DX::Solver->new(
 
 $solver->add_rule(@$_) for (
   [ path_status => [ qw(PS) ],
-    [ member_of => 'PS', [ value => 'path_status' ] ] ],
+    [ member_of => 'PS', \'path_status' ] ],
   [ path => [ qw(PS P) ],
-    [ prop => 'PS', [ value => 'path' ], 'P' ] ],
+    [ prop => 'PS', \'path', 'P' ] ],
+  [ info_prop => [ qw(PS N V) ],
+    [ exists => [ qw(PSI) ],
+      [ prop => 'PS', \'info', 'PSI' ],
+      [ prop => 'PSI', 'N', 'V' ] ] ],
   [ mode => [ qw(PS M) ],
-    [ constrain => [ qw(PS M) ],
-        sub { $_[0]->info and $_[0]->info->mode eq $_[1] } ] ],
+    [ info_prop => 'PS', \'mode', 'M' ] ],
   [ exists_path => [ qw(PS) ],
-    [ constrain => [ qw(PS) ],
-        sub {
-          $_[0]->info and ($_[0]->info->is_directory or $_[0]->info->is_file)
-        } ] ],
+    [ info_prop => 'PS', \'is_directory', \1 ] ],
+  [ exists_path => [ qw(PS) ],
+    [ info_prop => 'PS', \'is_file', \1 ] ],
   [ is_directory => [ qw(PS) ],
-    [ constrain => [ qw(PS) ],
-        sub { $_[0]->info and $_[0]->info->is_directory } ] ],
+    [ info_prop => 'PS', \'is_directory', \1 ] ],
   [ is_file => [ qw(PS) ],
-    [ constrain => [ qw(PS) ],
-        sub { $_[0]->info and $_[0]->info->is_file } ] ],
+    [ info_prop => 'PS', \'is_file', \1 ] ],
 );
 
 %path_status = %protos;
 
 sub paths_for_simple {
-  join ' ', map $_->{PS}->bound_value->path, $solver->query(
+  join ' ', map $_->value_for('PS')->path, $solver->query(
     [ qw(PS) ], [ path_status => 'PS' ], @_
   )->results;
 }
@@ -127,7 +131,7 @@ lives_ok {
   )->results
 };
 
-is(join(' ', map $_->{PS}->bound_value->path, @res), '.ssh');
+is(join(' ', map $_->value_for('PS')->path, @res), '.ssh');
 
 delete $solver->rule_set->rules->{'path_status_at/2'};
 
@@ -159,7 +163,7 @@ $solver->add_rule(
 $ob_res{'.ssh'} = $protos{'.ssh'};
 
 sub paths_for {
-  join ' ', map $_->{PS}->bound_value->path, $solver->query([ 'PS' ], @_)->results;
+  join ' ', map $_->value_for('PS')->path, $solver->query([ 'PS' ], @_)->results;
 }
 
 is(
@@ -198,6 +202,9 @@ $solver->add_rule(@$_) for (
   [ directory_at => [ qw(PS P) ],
     [ path_status_at => qw(PS P) ],
     [ is_directory => 'PS' ] ],
+  [ file_at => [ qw(PS P) ],
+    [ path_status_at => qw(PS P) ],
+    [ is_file => 'PS' ] ],
 );
 
 %path_status = ();
@@ -251,11 +258,11 @@ is(scalar(@res),1,'Single result');
 
 is($path_status{'.ssh'}, $empty{'.ssh'}, 'Empty observed');
 
-ok(my $action = $res[0]->{PS}->action);
-
-my ($type, $value) = $action->run;
+is(
+  scalar(my ($action) = $res[0]->actions), 1
+);
 
-$solver->facts->{$type}->remove_value($value);
+$solver->run_action($action);
 
 ok(!$path_status{'.ssh'}, 'Empty retracted');
 
@@ -265,6 +272,92 @@ is(scalar(@res),1,'Single result');
 
 is($path_status{'.ssh'}, $protos{'.ssh'}, 'Created observed');
 
-ok(!$res[0]->{PS}->action, 'No action');
+ok(!$res[0]->actions, 'No action');
+
+$solver->add_rule(@$_) for (
+  [ catfile => [ qw(DirPath FileName FilePath) ],
+    DX::Op::FromCode->new(code => sub {
+      my ($self, $state) = @_;
+      my ($dir_path, $file_name, $file_path)
+        = map $state->scope_var($_), qw(DirPath FileName FilePath);
+      die "No." unless $dir_path->is_bound;
+      die "No." unless $file_name->is_bound;
+      die "No." if $file_path->is_bound;
+      my $cat_file = File::Spec->catfile(
+        map $_->bound_value, $dir_path, $file_name
+      );
+      $state->bind_value($file_path->id, $cat_file)
+            ->add_dependencies(
+                $file_path->id => $dir_path->id,
+                $file_path->id => $file_name->id,
+              )
+            ->then($self->next);
+    }) ],
+  [ file_in => [ qw(DirStatus FileName FileStatus) ],
+    [ is_directory => qw(DirStatus) ],
+    [ exists => [ qw(DirPath) ],
+      [ path => qw(DirStatus DirPath) ],
+      [ exists => [ qw(FilePath) ],
+        [ catfile => qw(DirPath FileName FilePath) ],
+        [ file_at => qw(FileStatus FilePath) ] ] ] ],
+  [ is_file => [ qw(PS) ],
+    [ not => [ exists_path => 'PS' ] ],
+    [ act => [ 'PS' ],
+        sub {
+          my ($ps_var) = @_;
+          my ($id, $value) = ($ps_var->id, $ps_var->bound_value);
+          DX::Action::FromCode->new(
+            expect => sub {
+              ($id => My::PathStatus->new(
+                path => $value->path,
+                info => My::PathStatusInfo->new(
+                  is_file => 1, mode => ''
+                )
+              ))
+            },
+            perform => sub {
+              $ob_res{$value->path} = $protos{$value->path};
+              (path_status => $value);
+            }
+          )
+        } ] ]
+);
+
+%path_status = ();
+%ob_res = %empty;
+
+sub keys_file {
+  $solver->query([ qw(D F) ],
+     [ directory_at => 'D' => \'.ssh' ],
+     [ file_in => 'D' => \'authorized_keys' => 'F' ],
+   );
+}
+
+@res = keys_file()->results;
+
+is(scalar @res, 1, 'One result');
+
+is(scalar(my @act = $res[0]->actions), 2, 'Two actions');
+
+is(scalar(my ($poss) = grep !@{$_->dependencies}, @act), 1, 'One possible');
+
+$solver->run_action($poss);
+
+@res = keys_file()->results;
+
+is(scalar @res, 1, 'One result');
+
+is(
+  scalar(($poss) = grep !@{$_->dependencies}, $res[0]->actions), 1,
+  'One possible'
+);
+
+$solver->run_action($poss);
+
+@res = keys_file()->results;
+
+is(scalar @res, 1, 'One result');
+
+is(scalar($res[0]->actions), 0, 'No actions');
 
 done_testing;