From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 25 Apr 2017 07:21:10 +0000 (+0000)
Subject: lift some of the rspace handling into the Resolution* classes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=113f21b91243fbf16a81c67eb7d447b435455648;hp=1f3fa757641adc0ddd2151f2d8b6f5cdac3dfd77;p=scpubgit%2FDX.git

lift some of the rspace handling into the Resolution* classes
---

diff --git a/lib/DX/Predicate/Eq.pm b/lib/DX/Predicate/Eq.pm
index 4f27475..a7ca607 100644
--- a/lib/DX/Predicate/Eq.pm
+++ b/lib/DX/Predicate/Eq.pm
@@ -5,16 +5,6 @@ use DX::Class;
 
 with 'DX::Role::Predicate';
 
-sub _possible_resolution_list {
-  my ($self, @args) = @_;
-  my $rspace = $self->_resolution_space_for(@args);
-  return () unless my @members = @{$rspace->members};
-  return map step(
-    actions => $_->actions,
-    depends_on => $_->veracity_depends_on
-  ), @members;
-}
-
 sub _resolution_space_for {
   my ($self, $left, $right) = @_;
 
diff --git a/lib/DX/Predicate/MemberAt.pm b/lib/DX/Predicate/MemberAt.pm
index cc81135..ffb95cc 100644
--- a/lib/DX/Predicate/MemberAt.pm
+++ b/lib/DX/Predicate/MemberAt.pm
@@ -7,36 +7,6 @@ use DX::Class;
 
 with 'DX::Role::Predicate';
 
-sub _possible_resolution_list {
-  my ($self, @args) = @_;
-  my $rspace = $self->_resolution_space_for(@args);
-  return () unless my @members = @{$rspace->members};
-  return map {
-    $_->isa('DX::Resolution')
-      ? step(
-          actions => $_->actions,
-          depends_on => $_->veracity_depends_on,
-        )
-      : do {
-          my ($db, @ap) = (
-            $_->veracity_depends_on_builder, @{$_->action_prototypes}
-          );
-          map {
-            my @cand = @{$_};
-            step(
-              actions => [
-                map {
-                  my ($inv, $type, @args) = @{$ap[$_]};
-                  $inv->${\"action_for_${type}"}(@args, @{$cand[$_]});
-                } 0..$#ap
-              ],
-              depends_on => $db->(@cand),
-            )
-          } @{$_->implementation_candidates};
-        }
-  } @members;
-}
-
 # member_at Dict Key Value
 #
 # Dict must be set to a dict (later maybe also an array and Key -> Index)
diff --git a/lib/DX/Resolution.pm b/lib/DX/Resolution.pm
index 1d5d335..9e67d4d 100644
--- a/lib/DX/Resolution.pm
+++ b/lib/DX/Resolution.pm
@@ -6,4 +6,8 @@ has veracity_depends_on => (is => 'ro', required => 1);
 
 has actions => (is => 'ro', required => 1);
 
+sub next_resolution { $_[0] }
+
+sub remainder { () }
+
 1;
diff --git a/lib/DX/ResolutionSpace.pm b/lib/DX/ResolutionSpace.pm
index abb83ea..ab14c35 100644
--- a/lib/DX/ResolutionSpace.pm
+++ b/lib/DX/ResolutionSpace.pm
@@ -6,4 +6,16 @@ has geometry_depends_on => (is => 'ro', required => 1);
 
 has members => (is => 'ro', required => 1);
 
+sub next_resolution {
+  my ($self) = @_;
+  return undef unless my ($first) = @{$self->members};
+  return $first->next_resolution;
+}
+
+sub remaining_resolution_space {
+  my ($self) = @_;
+  die "Sense makes not" unless my ($first, @rest) = @{$self->members};
+  return $self->but(members => [ $first->remainder, @rest ]);
+}
+
 1;
diff --git a/lib/DX/ResolutionStrategy.pm b/lib/DX/ResolutionStrategy.pm
index ca3f23a..8c5d65f 100644
--- a/lib/DX/ResolutionStrategy.pm
+++ b/lib/DX/ResolutionStrategy.pm
@@ -1,5 +1,6 @@
 package DX::ResolutionStrategy;
 
+use DX::Resolution;
 use DX::Class;
 
 has action_prototypes => (is => 'ro', required => 1);
@@ -17,4 +18,27 @@ has aperture => (is => 'lazy', builder => sub {
   ];
 });
 
+sub next_resolution {
+  my ($self) = @_;
+  return undef unless my ($first) = @{$self->implementation_candidates};
+  my @ap = @{$self->action_prototypes};
+  my @cand = @$first;
+  return DX::Resolution->new(
+    actions => [
+      map {
+        my ($inv, $type, @args) = @{$ap[$_]};
+        $inv->${\"action_for_${type}"}(@args, @{$cand[$_]});
+      } 0..$#ap
+    ],
+    veracity_depends_on => $self->veracity_depends_on_builder->(@cand),
+  );
+}
+
+sub remainder {
+  my ($self) = @_;
+  my ($first, @rest) = @{$self->implementation_candidates};
+  return () unless @rest;
+  return $self->but(implementation_candidates => \@rest);
+}
+
 1;
diff --git a/lib/DX/Role/Predicate.pm b/lib/DX/Role/Predicate.pm
index 28cb8a1..1738d84 100644
--- a/lib/DX/Role/Predicate.pm
+++ b/lib/DX/Role/Predicate.pm
@@ -4,6 +4,20 @@ use List::Util qw(reduce);
 use DX::Utils qw(step CONTENTS_OF);
 use DX::Role;
 
+sub _possible_resolution_list {
+  my ($self, @args) = @_;
+  my $rspace = $self->_resolution_space_for(@args);
+  my @res;
+  while (my $next_res = $rspace->next_resolution) {
+    $rspace = $rspace->remaining_resolution_space;
+    push @res, step(
+      actions => $next_res->actions,
+      depends_on => $next_res->veracity_depends_on,
+    );
+  }
+  return @res;
+}
+
 sub resolution_step_for {
   my ($self, $prop, @args) = @_;
   my ($last, @rest) = reverse $self->_possible_resolution_list(@args);