add some basic tracing using the new deparser

[scpubgit/DX.git] / lib / DX / ShellState.pm

package DX::ShellState;

use DX::Utils qw(deparse);
use DX::Class;

has template_query_state => (
  is => 'ro', required => 1, isa => QueryState
);

has current_query_state => (
  is => 'lazy', builder => 'new_query_state'
);

has trace_these => (
  is => 'ro', required => 1,
);

has mode => (is => 'ro', required => 1);

sub new_query_state { $_[0]->template_query_state }

sub trace_sub {
  my ($self) = @_;
  sub {
    my ($tag, $thing) = @_;
    my ($part) = split /\./, $tag;
    return unless $self->trace_these->{$part};
    my $dp = deparse($thing);
    $dp =~ s/\n$//;
    warn "${dp}\n";
  }
}

sub with_trace_changes {
  my ($self, @changes) = @_;
  my %trace = %{$self->trace_these};
  foreach my $change (@changes) {
    if ($change =~ /^\+?(\w+)/) {
      $trace{$1} = 1;
    } elsif ($change =~ /^-(\w+)/) {
      delete $trace{$1};
    }
  }
  return $self->but(trace_these => \%trace);
}

sub with_new_query_state {
  my ($self) = @_;
  $self->but(
    current_query_state => $self->new_query_state
  );
}

sub with_mode {
  my ($self, $new_mode) = @_;
  return (
    $self->but(mode => $new_mode),
    [ mode => $new_mode ],
  );
}

1;