From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 3 Feb 2014 13:07:41 +0000 (+0000)
Subject: add exists, convert dot_ssh to use prop for everything
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=859049a333deff68898650acf61a18c4c6a923db;p=scpubgit%2FDKit.git

add exists, convert dot_ssh to use prop for everything
---

diff --git a/lib/DX/RuleSet.pm b/lib/DX/RuleSet.pm
index 74ca544..3c449da 100644
--- a/lib/DX/RuleSet.pm
+++ b/lib/DX/RuleSet.pm
@@ -12,6 +12,7 @@ use DX::Op::Not;
 use DX::Op::ProposeAction;
 use DX::Op::Materialize;
 use DX::Op::Prop;
+use DX::Op::Exists;
 use List::Util qw(reduce);
 
 has rules => (is => 'ro', default => sub { {} });
@@ -104,4 +105,12 @@ sub _expand_op_prop {
   DX::Op::Prop->new(%new);
 }
 
+sub _expand_op_exists {
+  my ($self, $vars, @body) = @_;
+  DX::Op::Exists->new(
+    vars => $vars,
+    body => $self->_expand_and_link(DX::Op::Return->new, @body)
+  );
+}
+
 1;
diff --git a/lib/DX/State.pm b/lib/DX/State.pm
index 6fd62a2..e87682a 100644
--- a/lib/DX/State.pm
+++ b/lib/DX/State.pm
@@ -58,10 +58,10 @@ sub assign_vars {
 }
 
 sub bind_value {
-  my ($self, $var, $value) = @_;
-  my $bound = $var->with_value($value);
+  my ($self, $var_id, $value) = @_;
+  my $bound = $self->by_id->{$var_id}->with_value($value);
   $self->but(
-    by_id => { %{$self->by_id}, $var->id => $bound },
+    by_id => { %{$self->by_id}, $var_id => $bound },
   );
 }
 
diff --git a/t/dot_ssh.t b/t/dot_ssh.t
index 47a178b..6c3bc9d 100644
--- a/t/dot_ssh.t
+++ b/t/dot_ssh.t
@@ -12,7 +12,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;
 
@@ -57,19 +57,25 @@ $solver->add_rule(@$_) for (
   [ path => [ qw(PS P) ],
     [ prop => 'PS', [ value => 'path' ], 'P' ] ],
   [ mode => [ qw(PS M) ],
-    [ constrain => [ qw(PS M) ],
-        sub { $_[0]->info and $_[0]->info->mode eq $_[1] } ] ],
+    [ exists => [ qw(PSI) ],
+      [ prop => 'PS', [ value => 'info' ], 'PSI' ],
+      [ prop => 'PSI', [ value => 'mode' ], 'M' ] ] ],
   [ exists_path => [ qw(PS) ],
-    [ constrain => [ qw(PS) ],
-        sub {
-          $_[0]->info and ($_[0]->info->is_directory or $_[0]->info->is_file)
-        } ] ],
+    [ exists => [ qw(PSI) ],
+      [ prop => 'PS', [ value => 'info' ], 'PSI' ],
+      [ prop => 'PSI', [ value => 'is_directory' ], [ value => 1 ] ] ] ],
+  [ exists_path => [ qw(PS) ],
+    [ exists => [ qw(PSI) ],
+      [ prop => 'PS', [ value => 'info' ], 'PSI' ],
+      [ prop => 'PSI', [ value => 'is_file' ], [ value => 1 ] ] ] ],
   [ is_directory => [ qw(PS) ],
-    [ constrain => [ qw(PS) ],
-        sub { $_[0]->info and $_[0]->info->is_directory } ] ],
+    [ exists => [ qw(PSI) ],
+      [ prop => 'PS', [ value => 'info' ], 'PSI' ],
+      [ prop => 'PSI', [ value => 'is_directory' ], [ value => 1 ] ] ] ],
   [ is_file => [ qw(PS) ],
-    [ constrain => [ qw(PS) ],
-        sub { $_[0]->info and $_[0]->info->is_file } ] ],
+    [ exists => [ qw(PSI) ],
+      [ prop => 'PS', [ value => 'info' ], 'PSI' ],
+      [ prop => 'PSI', [ value => 'is_file' ], [ value => 1 ] ] ] ],
 );
 
 %path_status = %protos;
diff --git a/t/observe.t b/t/observe.t
index 04432ac..f3594c6 100644
--- a/t/observe.t
+++ b/t/observe.t
@@ -15,7 +15,7 @@ my %paths = %observe_path;
 my $set_dot_ssh = FromCode->new(
   code => sub {
     my ($self, $state) = @_;
-    $state->bind_value($state->scope_var('P'), '/home/me/.ssh')
+    $state->bind_value($state->scope_var('P')->id, '/home/me/.ssh')
           ->then($self->next);
   }
 );
@@ -24,7 +24,7 @@ my $path_status = FromCode->new(
   code => sub {
     my ($self, $state) = @_;
     if (my $p = $paths{$state->scope_var('P')->bound_value}) {
-      return $state->bind_value($state->scope_var('PS'), $p)
+      return $state->bind_value($state->scope_var('PS')->id, $p)
                    ->then($self->next);
     }
     return $state->backtrack;
diff --git a/t/ssh_key.t b/t/ssh_key.t
index da18596..c997117 100644
--- a/t/ssh_key.t
+++ b/t/ssh_key.t
@@ -28,7 +28,7 @@ sub make_set_bind {
     die "key unbound" unless $key->is_bound;
     die "thing bound" if $thing->is_bound;
     if (my $value = $set->{$key->bound_value}) {
-      return $state->bind_value($thing, $value)->then($self->next);
+      return $state->bind_value($thing->id, $value)->then($self->next);
     }
     return $state->backtrack;
   }