#!/usr/local/bin/perl

use strict;
use warnings;

use Pod::Usage;
use PPIx::Regexp;
use PPIx::Regexp::Dumper;
use PPIx::Regexp::Util qw{ __instance };
use Term::ReadLine;

@ARGV or die "Need an argument.\n";

my $re = PPIx::Regexp->new( $ARGV[0] )
    or die PPIx::Regexp->errmsg();

my $obj = $re;
my $tr = Term::ReadLine->new( 'Navigate a regular expression' );

my %internal = (
    capture_names => sub {
	defined $obj or return;
	return join( ', ', map { "'$_'" } $obj->capture_names() );
    },
    delimiters => sub {
	defined $obj or return;
	return join( ', ', map { "'$_'" } $obj->delimiters() );
    },
    dump => sub {
	my @args;
	defined $_[0] and @args = split qr{ \s+ }smx, $_[0];
	return PPIx::Regexp::Dumper->new(
	    $obj, @args )->string();
    },
    help => sub {
	pod2usage( {
		-exitval	=> 'NOEXIT',
		-verbose	=> 2,
		-output		=> \*STDOUT,
	    } );
	return;
    },
    nav => sub {
	return _safe( $obj->nav() );
    },
    parse => sub {
	my $temp = PPIx::Regexp->new( $_[0] )
	    or return PPIx::Regexp->errstr();
	return ( $obj = $re = $temp );
    },
    reset => sub {
	return ( $obj = $re );
    },
);

sub _safe {
    my ( @args ) = @_;
    my $rslt = join ', ', map {
	ref $_ eq 'ARRAY' ? '[ ' . _safe( @{ $_ } ) . ' ]' : "'$_'"
    } @args;
    $rslt =~ s/ \[ \s+ \] /[]/smxg;
    $rslt =~ s/ ' ( \d+ ) ' /$1/smxg;
    $rslt =~ s/ \[ \s* ( \d+ ) \s* \] /$1/smxg;
    $rslt =~ s/ ' ( \w+ ) ', /$1 =>/smxg;
    return $rslt;
}

while ( defined ( my $buffer = $tr->readline( 'prenav> ' ) ) ) {
    $buffer =~ s/ \s+ \z //smx;
    $buffer or next;
    $buffer =~ s/ \A \s+ //smx;
    '#' eq substr $buffer, 0, 1 and next;
    my ( $method, $arg ) = split qr{\s+}smx, $buffer, 2;
    'exit' eq $method and last;
    my $temp = eval {
	$internal{$method} ?
	    $internal{$method}->( $arg ) :
	    $obj->$method( $arg );
    } or do {
	if ( $@ ) {
	    warn $@;
	} else {
	    print "undef\n";
	}
	next;
    };

    print _format( $temp );

    __instance( $temp, 'PPIx::Regexp::Element' )
	and $obj = $temp;
}

sub _format {
    my ( @args ) = @_;
    my $rslt;

    foreach my $thing ( @args ) {
	if ( __instance( $thing, 'PPIx::Regexp::Element' ) ) {
	    $rslt .= $thing->class() . "\t" . $thing->content() . "\n";
	} elsif ( ref $thing eq 'ARRAY' ) {
	    $rslt .= _format( @{ $thing } );
	} else {
	    $rslt .= $thing =~ m/ \n /smx ? $thing :
		$thing =~ m/ \A ' /smx ? "$thing\n" :
		$thing =~ m/ \D /smx ? "'$thing'\n" :
					"$thing\n";
	}
    }

    return $rslt;
}

__END__

=head1 NAME

prenav - Navigate a PPIx::Regexp parse tree

=head1 SYNOPSIS

 prenav 's/(\w+)/\u$1/g'
 prenav> find_first Token::CharClass::Simple
 PPIx::Regexp::Token::CharClass::Simple  \w
 prenav> dump verbose 1
 PPIx::Regexp::Token::CharClass::Simple  '\\w'  significant
     can_be_quantified
 prenav> parent
 PPIx::Regexp::Structure::Capture    (\w+)
 prenav> exit

=head1 DESCRIPTION

This script takes as its argument a string to be parsed as a regular
expression, and prompts the user for navigation commands. A navigation
command is any method that returns another element in the parse tree.

Unless documented otherwise, all commands apply to the current
object. Initially the current object is the L<PPIx::Regexp|PPIx::Regexp>
object generated by the parse. Once a navigation command is issued, the
object navigated to becomes the current object. If the navigation
command does not specify an object (e.g. C<child 5> when the current
object has fewer than 5 children) the current object remains unchanged.

In addition to the navigation methods, any method that returns a scalar
value can be used as a command. The value returned will be displayed.

In addition to all the above, the following commands are recognized:

=over

=item capture_names

This command wraps the
L<< PPIx::Regexp->capture_names()|PPIx::Regexp/capture_names >> method,
joining the results into a comma-delimited string.

=item dump

This command dumps the current object. Options to
L<< PPIx::Regexp::Dumper->new()|PPIx::Regexp::Dumper/new> may be
specified as arguments to the command. See the L<SYNOPSIS|/SYNOPSIS> for
an example.

=item exit

This comamnd terminates the script.

=item help

This command displays this documentation.

=item nav

 nav

This command displays the method calls and arguments needed to navigate
from the root of the parse tree to the current object. Yes, this is a
perfectly good method, but we wrap the results of that method in some
semi-nice formatting.

Any arguments are ignored

=item parse

 parse s/ ( \w+ ) foo \1 /bar/smx

This command provides another regular expression to parse. If the parse
succeeds, the previous regular expression is abandoned, and the new
L<PPIx::Regexp|PPIx::Regexp> object becomes the current object.

The new regular expression is taken to be everything on the line after
the whit espace after the word C<parse>. It should B<not> be quoted.

=item reset

This command selects the top-level object as the current object. The
C<top> command does the same thing, but C<top> does it by running
through the parent chain, where C<reset> simply slam-dunks the retained
L<PPIx::Regexp|PPIx::Regexp> object.

=back

=head1 SUPPORT

Support is by the author. Please file bug reports at
L<http://rt.cpan.org>, or in electronic mail to the author.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009-2016 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the directory LICENSES.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :