From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 11 Feb 2014 18:30:21 +0000 (+0000)
Subject: use FactRef objects to sanify action handling
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDKit.git;a=commitdiff_plain;h=4ce2e7784f3194a4f3db8df1711e951c0b05e7cf

use FactRef objects to sanify action handling
---

diff --git a/lib/DX/FactRef.pm b/lib/DX/FactRef.pm
new file mode 100644
index 0000000..9c7b1ac
--- /dev/null
+++ b/lib/DX/FactRef.pm
@@ -0,0 +1,15 @@
+package DX::FactRef;
+
+use Moo;
+
+with 'DX::Role::Ref';
+
+has fact_type => (is => 'ro', required => 1);
+has fact_id => (is => 'ro', required => 1);
+
+sub resolve {
+  my ($self, $state) = @_;
+  $state->facts->{$self->fact_type}->get($self->fact_id);
+}
+
+1;
diff --git a/lib/DX/Op/MemberOf.pm b/lib/DX/Op/MemberOf.pm
index 7b16482..65f4511 100644
--- a/lib/DX/Op/MemberOf.pm
+++ b/lib/DX/Op/MemberOf.pm
@@ -1,6 +1,7 @@
 package DX::Op::MemberOf;
 
 use DX::ArrayStream;
+use DX::RefSet;
 use Moo;
 
 with 'DX::Role::Op';
@@ -16,10 +17,13 @@ sub run {
   );
   my ($member, $of) = @args{qw(member of)};
   die "member bound" if $member->is_bound;
-  my $set = $state->facts->{$state->resolve_value($of)};
+  my $set = $state->facts->{my $type = $state->resolve_value($of)};
+  my $ref_set = DX::RefSet->new(
+    target => $type, names => [ $set->key_list ],
+  );
   return $state->then($self->next)
                ->add_dependencies($member->id, $of->id)
-               ->bind_root_set($member->id, $set)
+               ->bind_root_set($member->id, $ref_set)
 }
 
 1;
diff --git a/lib/DX/Op/ProposeAction.pm b/lib/DX/Op/ProposeAction.pm
index 7031b4f..2249496 100644
--- a/lib/DX/Op/ProposeAction.pm
+++ b/lib/DX/Op/ProposeAction.pm
@@ -19,11 +19,16 @@ sub run {
   ($state, my %args) = $self->_expand_args($state, %{$self->_arg_map});
   my @vars = @args{sort keys %args};
   my @deps = $state->action_dependencies(map $_->id, @vars);
-  my $action = $self->builder->(@vars)
+  my $action = $self->builder->(map $state->resolve_value($_), @vars)
                     ->but(dependencies => \@deps);
-  my ($id, $value) = $action->expected_effect;
-  my $var = $state->by_id->{$id}->with_value($value)->with_action($action);
-  $state->but(by_id => { %{$state->by_id}, $id => $var })
+  my ($fact_type, $value) = $action->expected_effect;
+  my $id = $vars[0]->id;
+  my $var = $state->by_id->{$id}->with_action($action);
+  my $fact_set = $state->facts->{$fact_type}->with_value($value);
+  $state->but(
+            by_id => { %{$state->by_id}, $id => $var },
+            facts => { %{$state->facts}, $fact_type => $fact_set },
+          )
         ->then($self->next);
 }
 
diff --git a/lib/DX/SetOver.pm b/lib/DX/SetOver.pm
index 45ca5ba..c72accc 100644
--- a/lib/DX/SetOver.pm
+++ b/lib/DX/SetOver.pm
@@ -7,6 +7,13 @@ has over => (is => 'ro', required => 1);
 
 has values => (is => 'ro', default => sub { {} });
 
+sub key_list { sort keys %{$_[0]->values} }
+
+sub get {
+  my ($self, $key) = @_;
+  return $self->values->{$key};
+}
+
 sub to_stream {
   my ($self) = @_;
   my $values = $self->values;
diff --git a/lib/DX/State.pm b/lib/DX/State.pm
index d397958..1f84991 100644
--- a/lib/DX/State.pm
+++ b/lib/DX/State.pm
@@ -3,6 +3,7 @@ package DX::State;
 use Return::MultiLevel qw(with_return);
 use DX::Op::Backtrack;
 use Scalar::Util qw(blessed);
+use Safe::Isa;
 use Moo;
 
 has next_op => (is => 'ro', required => 1);
@@ -30,7 +31,11 @@ sub scope_var {
 
 sub resolve_value {
   my ($self, $var) = @_;
-  $var->bound_value;
+  my $val = $var->bound_value;
+  if ($val->$_does('DX::Role::Ref')) {
+    return $val->resolve($self);
+  }
+  return $val;
 }
 
 sub allocate_var {
diff --git a/t/dot_ssh.t b/t/dot_ssh.t
index f4cb2de..b06771c 100644
--- a/t/dot_ssh.t
+++ b/t/dot_ssh.t
@@ -231,11 +231,10 @@ $solver->add_rule(@$_) for (
     [ not => [ exists_path => 'PS' ] ],
     [ act => [ 'PS' ],
         sub {
-          my ($ps_var) = @_;
-          my ($id, $value) = ($ps_var->id, $ps_var->bound_value);
+          my ($value) = @_;
           DX::Action::FromCode->new(
             expect => sub {
-              ($id => My::PathStatus->new(
+              (path_status => My::PathStatus->new(
                 path => $value->path,
                 info => My::PathStatusInfo->new(
                   is_directory => 1, mode => ''
@@ -293,11 +292,10 @@ $solver->add_rule(@$_) for (
     [ not => [ exists_path => 'PS' ] ],
     [ act => [ 'PS' ],
         sub {
-          my ($ps_var) = @_;
-          my ($id, $value) = ($ps_var->id, $ps_var->bound_value);
+          my ($value) = @_;
           DX::Action::FromCode->new(
             expect => sub {
-              ($id => My::PathStatus->new(
+              (path_status => My::PathStatus->new(
                 path => $value->path,
                 info => My::PathStatusInfo->new(
                   is_file => 1, mode => ''
@@ -328,6 +326,8 @@ is(scalar @res, 1, 'One result');
 
 is(scalar(my @act = $res[0]->actions), 2, 'Two actions');
 
+#::Dwarn(\@act);
+
 is(scalar(my ($poss) = grep !@{$_->dependencies}, @act), 1, 'One possible');
 
 $solver->run_action($poss);