From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 12 Mar 2016 03:15:35 +0000 (+0000)
Subject: slightly janky attempt at show all solutions
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f458fa2c2ee9249f800318c53b117e77705ecd07;p=scpubgit%2FDX.git

slightly janky attempt at show all solutions
---

diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm
index 6b5061f..9cc2249 100644
--- a/lib/DX/QueryState.pm
+++ b/lib/DX/QueryState.pm
@@ -64,11 +64,18 @@ sub with_additional_proposition {
                       ->with_additional_proposition($prop);
   my $sol_ss = $self->new_search_state_for($prop_seq)
                     ->find_solution;
-  die "No solution" unless $sol_ss;
+  die "No solution\n" unless $sol_ss;
   $self->but(
     proposition_sequence => $prop_seq,
     search_state => $sol_ss,
   );
 }
 
+sub with_forced_backtrack {
+  my ($self) = @_;
+  my $next_ss = $self->search_state->find_next_solution;
+  die "No next solution\n" unless $next_ss;
+  $self->but(search_state => $next_ss);
+}
+
 1;
diff --git a/lib/DX/SearchState.pm b/lib/DX/SearchState.pm
index c339382..4245668 100644
--- a/lib/DX/SearchState.pm
+++ b/lib/DX/SearchState.pm
@@ -53,7 +53,8 @@ sub find_solution {
 
 sub force_backtrack {
   my ($self) = @_;
-  my ($first_alt, @rest_alt) = $self->alternatives;
+  my ($first_alt, @rest_alt) = @{$self->alternatives};
+  return undef unless $first_alt;
   return ref($self)->new(
     current_hypothesis => $first_alt->[0],
     resume_step => $first_alt->[1],
diff --git a/lib/DX/ShellSession.pm b/lib/DX/ShellSession.pm
index a703e57..5cde1d5 100644
--- a/lib/DX/ShellSession.pm
+++ b/lib/DX/ShellSession.pm
@@ -29,6 +29,18 @@ has tcl => (is => 'lazy', builder => sub {
     $self->apply_to_state([ mode => 'shell' ]);
     $qvars->();
   });
+  $tcl->CreateCommand('...' => sub {
+    $self->apply_to_state([ mode => 'shell' ]);
+    my ($cur) = $self->shell_state->current_query_state;
+    while ($cur) {
+      $self->_set_shell_state(
+        $self->shell_state->but(current_query_state => $cur)
+      );
+      $qvars->();
+      $cur = eval { $cur->with_forced_backtrack };
+      push our @Result, [ output => $@ ] if $@;
+    }
+  });
   $tcl->CreateCommand(qlist => sub {
     push our @Result, map [ output => $_ ], @{
       $self->shell_state->current_query_state->proposition_sequence->members