From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 14 Feb 2014 10:24:49 +0000 (+0000)
Subject: move actions to a separate state attribute
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=577a2146b78ad2f1703c4231c6a11c9b1ec9827c;p=scpubgit%2FDKit.git

move actions to a separate state attribute
---

diff --git a/lib/DX/Lib/FS.pm b/lib/DX/Lib/FS.pm
index be78481..00b5420 100644
--- a/lib/DX/Lib/FS.pm
+++ b/lib/DX/Lib/FS.pm
@@ -9,8 +9,6 @@ use DX::SetOver;
 use Moo;
 
 our @RULES = (
-  [ has_action => [ qw(Thing Action) ],
-    [ prop => 'Thing', \'required_action', 'Action' ] ],
   [ path_status => [ qw(PS) ],
     [ member_of => 'PS', \'path_status' ] ],
   [ path => [ qw(PS P) ],
diff --git a/lib/DX/Op/HasAction.pm b/lib/DX/Op/HasAction.pm
new file mode 100644
index 0000000..7fee15a
--- /dev/null
+++ b/lib/DX/Op/HasAction.pm
@@ -0,0 +1,28 @@
+package DX::Op::HasAction;
+
+use Safe::Isa;
+use Moo;
+
+has arg_spec => (is => 'ro', required => 1);
+
+with 'DX::Role::Op';
+
+sub run {
+  my ($self, $state) = @_;
+  my @arg_spec = @{$self->arg_spec};
+  ($state, my %vars) = $self->_expand_args(
+    $state, Thing => $arg_spec[0], Action => $arg_spec[1]
+  );
+  die "Thing must be bound" unless $vars{Thing}->is_bound;
+  my $thing = $state->resolve_value($vars{Thing});
+  if ($thing->$_does('DX::Role::Fact') and $thing->has_required_action) {
+    return $state->bind_value(
+      $vars{Action}->id,
+      $state->actions->{$thing->required_action}
+    )->add_dependencies($vars{Action}->id => $vars{Thing}->id)
+     ->then($self->next);
+  }
+  return $state->backtrack;
+}
+
+1;
diff --git a/lib/DX/Op/ModifyAction.pm b/lib/DX/Op/ModifyAction.pm
index 57696b4..a4975b4 100644
--- a/lib/DX/Op/ModifyAction.pm
+++ b/lib/DX/Op/ModifyAction.pm
@@ -1,5 +1,6 @@
 package DX::Op::ModifyAction;
 
+use Safe::Isa;
 use DX::ObservationRequired;
 use Moo;
 
@@ -18,8 +19,10 @@ sub run {
   my ($self, $state) = @_;
   ($state, my %args) = $self->_expand_args($state, %{$self->_arg_map});
   my ($subject, @vars) = @args{sort keys %args};
-  die "Can't alter action on $subject" unless
-    my $orig_action = $state->resolve_value($subject)->required_action;
+  my $subject_fact = $state->resolve_value($subject);
+  die "Subject not a fact" unless $subject_fact->$_does('DX::Role::Fact');
+  die "Subject has no action" unless $subject_fact->has_required_action;
+  my $orig_action = $state->actions->{$subject_fact->required_action};
   my @deps = $state->action_dependencies(
     @{$orig_action->dependencies},
     map $_->id, @vars
@@ -31,9 +34,12 @@ sub run {
   my $action = $self->builder->(@builder_args)
                     ->but(dependencies => \@deps);
   my ($fact_type, $value) = $action->expected_effect;
-  my $final_value = $value->but(required_action => $action);
+  my $final_value = $value->but(required_action => $action->id);
   my $fact_set = $state->facts->{$fact_type}->with_value($final_value);
-  $state->but(facts => { %{$state->facts}, $fact_type => $fact_set })
+  $state->but(
+            facts => { %{$state->facts}, $fact_type => $fact_set },
+            actions => { %{$state->actions}, $action->id => $action },
+          )
         ->then($self->next);
 }
 
diff --git a/lib/DX/Op/ProposeAction.pm b/lib/DX/Op/ProposeAction.pm
index b1aa7f3..e63eb40 100644
--- a/lib/DX/Op/ProposeAction.pm
+++ b/lib/DX/Op/ProposeAction.pm
@@ -21,11 +21,12 @@ sub run {
   my @deps = $state->action_dependencies(map $_->id, @vars);
   my $action = $self->builder->(map $state->resolve_value($_), @vars)
                     ->but(dependencies => \@deps);
+  my ($rec_state, $action_id) = $state->record_action($action);
   my ($fact_type, $value) = $action->expected_effect;
-  my $final_value = $value->but(required_action => $action);
+  my $final_value = $value->but(required_action => $action_id);
   my $fact_set = $state->facts->{$fact_type}->with_value($final_value);
-  $state->but(facts => { %{$state->facts}, $fact_type => $fact_set })
-        ->then($self->next);
+  $rec_state->but(facts => { %{$state->facts}, $fact_type => $fact_set })
+            ->then($self->next);
 }
 
 1;
diff --git a/lib/DX/Result.pm b/lib/DX/Result.pm
index ddfb626..d409b55 100644
--- a/lib/DX/Result.pm
+++ b/lib/DX/Result.pm
@@ -12,12 +12,9 @@ sub var_names {
 sub actions {
   my ($self) = @_;
   my $state = $self->_state;
-  my $by_id = $self->_state->by_id;
-  return map $_->required_action,
-           grep $_->has_required_action,
-             grep $_->$_does('DX::Role::Fact'),
-               map $state->resolve_value($_),
-                 values %$by_id;
+  my $actions = $state->actions;
+  my @act = @{$actions}{sort keys %$actions};
+  return @act; # separate array to get correct scalar context return
 }
 
 sub independent_actions {
diff --git a/lib/DX/Role/Action.pm b/lib/DX/Role/Action.pm
index 113dd44..3b7367a 100644
--- a/lib/DX/Role/Action.pm
+++ b/lib/DX/Role/Action.pm
@@ -2,6 +2,8 @@ package DX::Role::Action;
 
 use Moo::Role;
 
+has id => (is => 'ro');
+
 has dependencies => (is => 'ro', default => sub { [] });
 
 has was_run => (is => 'rw');
diff --git a/lib/DX/RuleSet.pm b/lib/DX/RuleSet.pm
index baa9586..1559d49 100644
--- a/lib/DX/RuleSet.pm
+++ b/lib/DX/RuleSet.pm
@@ -16,6 +16,7 @@ use DX::Op::Materialize;
 use DX::Op::Prop;
 use DX::Op::Exists;
 use DX::Op::Predicate;
+use DX::Op::HasAction;
 use List::Util qw(reduce);
 
 has rules => (is => 'ro', default => sub { {} });
@@ -136,4 +137,9 @@ sub _expand_op_exists {
   );
 }
 
+sub _expand_op_has_action {
+  my ($self, @args) = @_;
+  DX::Op::HasAction->new(arg_spec => \@args);
+}
+
 1;
diff --git a/lib/DX/State.pm b/lib/DX/State.pm
index 2f0e2b0..95f49f6 100644
--- a/lib/DX/State.pm
+++ b/lib/DX/State.pm
@@ -24,6 +24,8 @@ has facts => (is => 'ro');
 
 has dependencies => (is => 'ro', default => sub { {} });
 
+has actions => (is => 'ro', default => sub { {} });
+
 sub scope_var {
   my ($self, $name) = @_;
   $self->by_id->{$self->scope->{$name}};
@@ -61,6 +63,18 @@ sub expand_vars {
   ), %vars;
 }
 
+sub record_action {
+  my ($self, $action) = @_;
+  my %id_gen = %{$self->id_gen};
+  my ($type) = (ref($action) =~ /([^:]+)$/);
+  my $id = join('_', $type, ++($id_gen{$type}||='000'));
+  my $recorded = $action->but(id => $id);
+  $self->but(
+    id_gen => \%id_gen,
+    actions => { %{$self->actions}, $id => $recorded }
+  ), $id;
+}
+
 sub assign_vars {
   my ($self, %vars) = @_;
   my ($state, %expanded) = $self->expand_vars(%vars);
@@ -188,11 +202,11 @@ sub action_dependencies {
   while (my $id = shift @queue) {
     $seen{$id}++;
     my $value = $self->resolve_value($by_id->{$id});
-    push @found, $id if $value->$_does('DX::Role::Fact')
-                        and $value->has_required_action;
+    push @found, $value if $value->$_does('DX::Role::Fact')
+                           and $value->has_required_action;
     push @queue, grep !$seen{$_}, keys %{$deps->{$id}};
   }
-  return @found;
+  return map $_->required_action, @found;
 }
 
 sub copy_vars {