From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 3 Apr 2018 19:53:52 +0000 (+0000)
Subject: provide and preserve aperture information
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6aa3640198d41ee9e2c8fcdf28a9aeebd4db7b06;p=scpubgit%2FDX.git

provide and preserve aperture information
---

diff --git a/lib/DX/ActionBuilder/BoundValue.pm b/lib/DX/ActionBuilder/BoundValue.pm
index ba92ab9..7c06e1c 100644
--- a/lib/DX/ActionBuilder/BoundValue.pm
+++ b/lib/DX/ActionBuilder/BoundValue.pm
@@ -2,6 +2,7 @@ package DX::ActionBuilder::BoundValue;
 
 use DX::Action::SetBoundValue;
 use DX::Action::AddBoundValue;
+use DX::Utils qw(:event_types);
 use DX::Class;
 
 with 'DX::Role::ActionBuilder';
@@ -16,6 +17,15 @@ has inner_action_builder => (is => 'ro', required => 1);
 
 sub can_set_value { shift->inner_action_builder->can_set_value }
 
+sub aperture_for_set_value {
+  my ($self) = @_;
+  return [] unless $self->can_set_value;
+  [
+    [ VALUE_SET ,=> @{$self->target_path} ],
+    @{$self->inner_action_builder->aperture_for_set_value},
+  ]
+}
+
 sub action_for_set_value {
   my ($self, $value) = @_;
   my $inner_action = $self->inner_action_builder->action_for_set_value($value);
@@ -31,6 +41,15 @@ sub action_for_set_value {
 
 sub can_add_member { shift->inner_action_builder->can_add_member }
 
+sub aperture_for_add_member {
+  my ($self, $at) = @_;
+  return [] unless $self->can_add_member;
+  [
+    [ VALUE_SET ,=> @{$self->target_path} ],
+    @{$self->inner_action_builder->aperture_for_add_member($at)},
+  ]
+}
+
 sub action_for_add_member {
   my ($self, $at, $value) = @_;
   $at = $at->string_value if ref($at);
diff --git a/lib/DX/ActionBuilder/Normal.pm b/lib/DX/ActionBuilder/Normal.pm
index 089c956..8b3096e 100644
--- a/lib/DX/ActionBuilder/Normal.pm
+++ b/lib/DX/ActionBuilder/Normal.pm
@@ -2,12 +2,17 @@ package DX::ActionBuilder::Normal;
 
 use DX::Action::SetValue;
 use DX::Action::AddValue;
+use DX::Utils qw(:event_types);
 use DX::Class;
 
 with 'DX::Role::ActionBuilder';
 
 has target_path => (is => 'ro', required => 1);
 
+sub aperture_for_set_value {
+  [ [ VALUE_SET ,=> @{$_[0]->target_path} ] ]
+}
+
 sub action_for_set_value {
   my ($self, $value) = @_;
   DX::Action::SetValue->new(
@@ -16,6 +21,11 @@ sub action_for_set_value {
   );
 }
 
+sub aperture_for_add_member {
+  my ($self, $at) = @_;
+  [ [ VALUE_EXISTS ,=> @{$self->target_path}, $at ] ]
+}
+
 sub action_for_add_member {
   my ($self, $at, $value) = @_;
   my $ab = $self->specialize_for_member($at);
diff --git a/lib/DX/ActionBuilder/Null.pm b/lib/DX/ActionBuilder/Null.pm
index 769903e..5aac1b3 100644
--- a/lib/DX/ActionBuilder/Null.pm
+++ b/lib/DX/ActionBuilder/Null.pm
@@ -14,14 +14,22 @@ around target_path => sub {
 
 sub can_set_value { 0 }
 
+sub aperture_for_set_value { [] }
+
 sub action_for_set_value { undef }
 
 sub can_add_member { 0 }
 
+sub aperture_for_add_member { [] }
+
 sub action_for_add_member { undef }
 
+sub aperure_for_set_member { [] }
+
 sub action_for_set_member { undef }
 
+sub aperture_for_remove_member { [] }
+
 sub action_for_remove_member { undef }
 
 sub specialize_for_member {
diff --git a/lib/DX/ActionBuilder/ProxySetToAdd.pm b/lib/DX/ActionBuilder/ProxySetToAdd.pm
index 941ac70..e1e8bf8 100644
--- a/lib/DX/ActionBuilder/ProxySetToAdd.pm
+++ b/lib/DX/ActionBuilder/ProxySetToAdd.pm
@@ -1,5 +1,6 @@
 package DX::ActionBuilder::ProxySetToAdd;
 
+use DX::Utils qw(VALUE_SET);
 use DX::Class;
 
 with 'DX::Role::ActionBuilder';
@@ -8,6 +9,14 @@ has target_path => (is => 'ro', required => 1);
 
 has proxy_to => (is => 'ro', required => 1);
 
+sub aperture_for_set_value {
+  my ($self) = @_;
+  [
+    [ VALUE_SET ,=> @{$self->target_path} ],
+    @{$self->proxy_to->aperture_for_add_member($self->target_path->[-1])}
+  ]
+}
+
 sub action_for_set_value {
   my ($self, $value) = @_;
   $self->proxy_to->action_for_add_member($self->target_path->[-1], $value);
diff --git a/lib/DX/ActionBuilder/UnsetValue.pm b/lib/DX/ActionBuilder/UnsetValue.pm
index 1a0a791..b2c1ddf 100644
--- a/lib/DX/ActionBuilder/UnsetValue.pm
+++ b/lib/DX/ActionBuilder/UnsetValue.pm
@@ -4,12 +4,17 @@ use DX::Action::SetValue;
 use DX::ActionBuilder::Normal;
 use DX::Action::BindValue;
 use DX::ActionBuilder::BoundValue;
+use DX::Utils qw(VALUE_SET);
 use DX::Class;
 
 with 'DX::Role::ActionBuilder';
 
 has target_path => (is => 'ro', required => 1);
 
+sub aperture_for_set_value {
+  [ [ VALUE_SET ,=> @{$_[0]->target_path} ] ]
+}
+
 sub action_for_set_value {
   my ($self, $value) = @_;
   if (my $p = $value->value_path) {
diff --git a/lib/DX/Predicate/Dict.pm b/lib/DX/Predicate/Dict.pm
index 262d5bc..3218e57 100644
--- a/lib/DX/Predicate/Dict.pm
+++ b/lib/DX/Predicate/Dict.pm
@@ -21,6 +21,7 @@ sub _resolution_space_for {
 
   return rspace(
     geometry_depends_on => $deps,
+    aperture => $arg->aperture_for_set_value,
     members => [ res(
       actions => $actions,
       veracity_depends_on => $deps
diff --git a/lib/DX/Predicate/Eq.pm b/lib/DX/Predicate/Eq.pm
index e21be8c..e0b3899 100644
--- a/lib/DX/Predicate/Eq.pm
+++ b/lib/DX/Predicate/Eq.pm
@@ -10,9 +10,12 @@ sub _resolution_space_for {
 
   my $deps = [ [ CONTENTS_OF ,=> $left ], [ CONTENTS_OF ,=> $right ] ];
 
+  my $aperture = [ map @{$_->aperture_for_set_value}, $left, $right ];
+
   if ($left->equals($right)) {
     return rspace(
       geometry_depends_on => $deps,
+      aperture => $aperture,
       members => [
         res(
           actions => [],
@@ -37,6 +40,7 @@ sub _resolution_space_for {
 
   return rspace(
     geometry_depends_on => $deps,
+    aperture => $aperture,
     members => \@members,
   );
 }
diff --git a/lib/DX/Predicate/MemberAt.pm b/lib/DX/Predicate/MemberAt.pm
index ffb95cc..491b48e 100644
--- a/lib/DX/Predicate/MemberAt.pm
+++ b/lib/DX/Predicate/MemberAt.pm
@@ -79,6 +79,7 @@ sub _resolution_space_for {
         );
 
         return rspace(
+          aperture => [],
           geometry_depends_on => $deps,
           members => \@members
         );
@@ -90,6 +91,7 @@ sub _resolution_space_for {
           [ CONTENTS_OF ,=> $dict, $key->string_value ],
           [ TYPE_OF ,=> $value ],
         ],
+        aperture => $value->aperture_for_set_value,
         members => [
           res(
             actions => [ $value->action_for_set_value($cur_val) ],
@@ -126,6 +128,7 @@ sub _resolution_space_for {
 
       return rspace(
         geometry_depends_on => $deps,
+        aperture => $value->aperture_for_set_value,
         members => [
           res(
             actions => [
@@ -149,6 +152,7 @@ sub _resolution_space_for {
       geometry_depends_on => [
         [ EXISTENCE_OF ,=> $dict, $key->string_value ],
       ],
+      aperture => [],
       members => [],
     );
 
@@ -171,6 +175,7 @@ sub _resolution_space_for {
       [ TYPE_OF ,=> $key ],
       [ TYPE_OF ,=> $value ],
     ],
+    aperture => [ map @{$_->aperture_for_set_value}, $key, $value ],
     members => [
       rstrat(
         action_prototypes => [
diff --git a/lib/DX/ResolutionSpace.pm b/lib/DX/ResolutionSpace.pm
index 817595f..8342640 100644
--- a/lib/DX/ResolutionSpace.pm
+++ b/lib/DX/ResolutionSpace.pm
@@ -8,8 +8,18 @@ has proposition => (is => 'ro');
 
 has geometry_depends_on => (is => 'ro', required => 1);
 
+has aperture => (is => 'ro', required => 1);
+
 has members => (is => 'ro', required => 1);
 
+sub for_deparse {
+  my ($self) = @_;
+  [ statement => [
+    [ symbol => 'rspace' ],
+    [ block => $self->members ],
+  ] ];
+}
+
 sub next_resolution {
   my ($self) = @_;
   return undef unless my ($first) = @{$self->members};
diff --git a/lib/DX/Role/Value.pm b/lib/DX/Role/Value.pm
index 4ff2320..41ff6dc 100644
--- a/lib/DX/Role/Value.pm
+++ b/lib/DX/Role/Value.pm
@@ -6,7 +6,7 @@ use DX::Role;
 has action_builder => (
   is => 'ro',
   default => 'DX::ActionBuilder::Null',
-  handles => [ qw(can_set_value action_for_set_value) ],
+  handles => [ qw(can_set_value aperture_for_set_value action_for_set_value) ],
 );
 
 sub value_path { shift->action_builder->target_path }