use strict;
use warnings;

package Data::Dumper::LispLike;
# ABSTRACT: Dump perl data structures formatted as Lisp-like S-expressions

use Exporter ();
our @ISA = qw(Exporter);
our @EXPORT = qw(&dumplisp);
our $VERSION = '0.004'; # VERSION


our $indent = "    ";


our $maxsimplewidth = 60;

our %escapes = (
	"\a"	=> '\a',
	"\b"	=> '\b',
	"\e"	=> '\e',
	"\f"	=> '\f',
	"\n"	=> '\n',
	"\r"	=> '\r',
	"\t"	=> '\t',
	"\\"	=> "\\\\",
);

sub dumplisp_scalar($) {
	1 == @_ or die;
	my $scalar = shift;
	die unless defined($scalar) and not ref($scalar);
	unless( $scalar =~ /^[\w\-%\/,\!\?=]+$/ ) {
		$scalar =~
			s/([^\w\-%\/,\!\?=\`~@#\$^&*\(\)+\[\]\{\}\|;:"\.<> ])/
			$escapes{$1} || sprintf '\x%X', ord $1/eg;
		$scalar = "'$scalar'";
	}
	return $scalar;
}

sub dumplisp_iter($;$$);
sub dumplisp_iter($;$$) {
	1 == @_ or 2 == @_ or 3 == @_ or die;
	my ($lisp, $level, $maxlength) = @_;
	$level ||= 0;
	$maxlength = $maxsimplewidth unless defined $maxlength;
	my $simple = ( $level < 0 );
	my $out = $simple ? "" : "\n" . ( $indent x $level );
	if( not defined $lisp ) {
		return "$out<undef>";
	} elsif( not ref $lisp ) {
		return $out . dumplisp_scalar $lisp;
	} elsif( 'ARRAY' eq ref $lisp ) {
		my @l = @$lisp;
		if( not @l ) {
			$out .= "(";
		} elsif( $simple ) {
			$out .= "(";
			my $first = 1;
			foreach my $current ( @l ) {
				$out .= " " unless $first;
				undef $first;
				$out .= dumplisp_iter( $current, -1, $maxlength - length $out );
				die if $simple and length $out > $maxlength;
			}
		} else { # not $simple and @l not empty
			my $try_add = eval {
				dumplisp_iter( $lisp, -1, $maxlength );
			};
			if( defined($try_add) and length($try_add) <= $maxlength ) {
				return $out . $try_add;
			}
			$out .= "(";
			if( defined($l[0]) and not ref($l[0]) ) {
				$out .= dumplisp_scalar shift @l;
			}
			$out .= dumplisp_iter( $_, $level + 1 ) foreach @l;
		}
		return "$out)";
	} else {
		die "cannot dumplisp " . ref($lisp) . "\n";
	}
}


sub dumplisp($) {
	1 == @_ or die "Usage: dumplisp(<expression>)\n";
	my $out = dumplisp_iter shift;
	chomp $out;
	$out =~ s/^\n//;
	return "$out\n";
}

1;


__END__
=pod

=head1 NAME

Data::Dumper::LispLike - Dump perl data structures formatted as Lisp-like S-expressions

=head1 VERSION

version 0.004

=head1 SYNOPSIS

    use Data::Dumper::LispLike;
    print dumplisp [ 1, 2, [3, 4] ]; # prints "(1 2 (3 4))\n";

=head1 ATTRIBUTES

=head2 $Data::Dumper::LispLike::indent

Indentation string. Default is "    " (four spaces).

=head2 $Data::Dumper::LispLike::maxsimplewidth

Maximum width of s-expression that is considered "simple",
i.e. that fits into one line and does not need to be split
into many lines. Default is 60.

=head1 FUNCTIONS

=head2 dumplisp()

    my $listref = ...;
    print dumplisp $listref;

This function converts an C<ARRAYREF>, which may contain strings or other
C<ARRAYREF>s, into Lisp-like S-expressions. The output is much compacter
and easier to read than the output of C<Data::Dumper>.

=for Pod::Coverage method_names_here

=head1 EXAMPLE

Here is a bigger real-life example of dumplisp() output:

    (COMMA
        (AND
            (CMDDEF -writeln (%str) (BLOCK (CMDRUN -write '%str\n')))
            (CMDDEF -writeln1 (%STR) (BLOCK (CMDRUN -write1 '%STR\n')))
            (CMDDEF
                -warn
                (%WARN_MESSAGE)
                (BLOCK (CMDRUN -warnf '%WARN_MESSAGE\n')))
            (CMDDEF -abort () (BLOCK (CMDRUN -exit 1)))
            (CMDDEF
                -die
                (%DIE_MESSAGE)
                (BLOCK (COMMA (CMDRUN -warn %DIE_MESSAGE) (CMDRUN -abort))))
            (IF
                (OPTION
                    (COMPARE != %UNAME/SYSNAME Linux)
                    (CMDRUN -die 'pfind is only for linux')))
            (CMDDEF -kill () (BLOCK (CMDRUN -signal KILL)))
            (CMDDEF -term () (BLOCK (CMDRUN -signal TERM)))
            (CMDDEF -hup () (BLOCK (CMDRUN -signal HUP)))
            (CMDDEF -ps () (BLOCK (CMDRUN -exec ps uf '{}')))
            (CMDDEF
                pso
                (%PS_FIELDS)
                (BLOCK (CMDRUN -exec ps '\q-o' %PS_FIELDS '{}')))
            (CMDDEF -exe (%exe_arg) (BLOCK (COMPARE == %exe %exe_arg)))
            (CMDDEF -cwd (%cwd_arg) (BLOCK (COMPARE == %cwd %cwd_arg)))
            (ASSIGN %vsz %statm/size)
            (ASSIGN %rss %statm/resident)
            (CMDDEF -kthread () (BLOCK (COMPARE == 0 %rss)))
            (CMDDEF -userspace () (BLOCK (NOT (CMDRUN -kthread))))
            (ASSIGN %ppid %stat/ppid)
            (ASSIGN %comm %stat/comm)
            (ASSIGN %nice %stat/nice)
            (ASSIGN
                %nice_flag
                (CONDITIONAL
                    (OPTION (COMPARE -lt %nice 0) '<')
                    (OPTION (COMPARE -gt %nice 0) N)
                    (DEFAULT '')))
            (ASSIGN %s %stat/state)
            (ASSIGN %state %s%nice_flag)
            (ASSIGN %name %status/Name)
            (CMDDEF
                -grep
                (%GREP_ARG)
                (BLOCK
                    (OR
                        (COMPARE -m %exe '*%GREP_ARG*')
                        (COMPARE -m %comm '*%GREP_ARG*')
                        (COMPARE -m %name '*%GREP_ARG*'))))
            (CMDDEF
                -egrep
                (%EGREP_ARG)
                (BLOCK
                    (OR
                        (COMPARE '=~' %exe %EGREP_ARG)
                        (COMPARE '=~' %comm %EGREP_ARG)
                        (COMPARE '=~' %name %EGREP_ARG))))
            (ASSIGN %command %tree%name)
            (CMDDEF
                -pstree
                ()
                (BLOCK
                    (AND
                        (CMDRUN -settree)
                        (CMDRUN -echo %ppid %pid %state %command)))))
        (AND
            (BLOCK (OR (CMDRUN -userspace) (COMPARE == %pid 23)))
            (CMDRUN -head 10)
            (CMDRUN -echo %pid %ppid %stat/ppid)
            (CMDRUN -ps)))

=head1 SUPPORT

L<http://github.com/spiculator/data-dumper-lisplike>

=head1 AUTHOR

Sergey Redin <sergey@redin.info>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Sergey Redin.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut