X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDX%2FQueryState.pm;h=aa5fede58192b76185cbf8b0c8477b962a0993e3;hb=ed70e2d8711c4a910b1c99ca3f47f5a8715c4207;hp=cd54b8229144fa2091b855e691e5a864b3580968;hpb=2fe8c22aab1d36482c0b09065d29c58f3f688e58;p=scpubgit%2FDX.git diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm index cd54b82..aa5fede 100644 --- a/lib/DX/QueryState.pm +++ b/lib/DX/QueryState.pm @@ -45,15 +45,52 @@ sub new_search_process_for { } sub with_additional_proposition { - my ($self, $prop) = @_; - my $prop_seq = $self->proposition_sequence - ->with_additional_proposition($prop); - my $sol_ss = $self->new_search_process_for($prop_seq) + my ($self, $new_prop) = @_; + my $old_prop_seq = $self->proposition_sequence; + my $new_prop_seq = $old_prop_seq->with_additional_proposition($new_prop); + my $old_ss = $self->search_process->current_search_state; + my %seen; + my $_munge; $_munge = sub { + my ($ss) = @_; + return $seen{$ss} ||= do { + my %but = ( + decisions_taken => [ + map [ $_->[0], $_->[1]->$_munge ], @{$ss->decisions_taken} + ] + ); + if ($ss->propositions eq $old_prop_seq) { + $but{propositions} = $new_prop_seq; + } + foreach my $type (qw(on_solution_step on_exhaustion_step)) { + my $step = $ss->$type; + if ($step and $step->can('resume_search_state')) { + $but{$type} + = $seen{$step} + ||= $step->but( + resume_search_state => $step->resume_search_state->$_munge + ); + } + } + $ss->but(%but); + }; + }; + my $munged_ss = $old_ss->$_munge; + undef($_munge); + + my $new_ss = $munged_ss->but( + is_solution_state => 0, + next_step => DX::Step::ConsiderProposition->new( + proposition => $new_prop + ), + ); + + my $sol_sp = $self->search_process + ->but(current_search_state => $new_ss) ->find_solution; - die "No solution\n" unless $sol_ss; + die "No solution\n" unless $sol_sp; $self->but( - proposition_sequence => $prop_seq, - search_process => $sol_ss, + proposition_sequence => $new_prop_seq, + search_process => $sol_sp, ); }