package sane;

# this filters perl source code and adds semicolons and braces and stuff so
# that you can write it in a somewhat python-like style

use strict; use warnings;

my $opts;

sub import {
	my $module = shift;
	$opts = { @_ };
}

use Filter::Simple sub {
	tr/\r//d;
	if ($_ ne "" and !$opts->{test}) {
		# it calls this sub again with an empty string
		# after the call with the code, I have no idea why
		$_ = insanify($_);
		if ($opts->{preview}) {
			print STDERR <<End;
output of insanify filter
>>>>>>>>>>>>>>>>>
$_<<<<<<<<<<<<<<<<<

End
		}
		if ($opts->{dump}) {
			my $dump_file = $0;
			$dump_file =~ s{ ([^/]*)$ }{ ".$1" }msxe;  # would be a useful addon to sane.pm / brace regexps?
			open my $dump_fh, ">", $dump_file
			 or die "can't open dump_file $dump_file";
			print $dump_fh $_;
		}
	}
};

our $output;

sub insanify {
	my ($text) = @_;
	chomp $text;
	my ($lines) = [split m/\n/, $text, -1];
	my $output = insanify_lines($lines);
	return $output;
}

sub insanify_lines {
	my ($lines) = @_;
	my $tabs = [];
	my $spaces = [];
	for (@$lines) {
		my ($tab, $space) = m/ \A (\t*) (\s*)/x;
		push @$tabs, length($tab);
		push @$spaces, length($space);
	}

	# add standard boilerplate
	$output = "use strict; use warnings; use Perl6::Say; ";

	sub out {
		$output .= join "", @_;
	}

	# a line at a time
	my $i = 0;
	while (defined $lines->[$i]) {
		my $skip_newline = 0;
		my $line = $lines->[$i];
		my $tab = $tabs->[$i];
		my $space = $spaces->[$i];

		# handle multi-line quoted strings (q qq qx qr s)
		# this is a hack - but hey, so is perl
		my $quote_block;
		if ($line =~ s/ (\A|\b|\s) (q|qq|qx|qr|s|\.) \z /$1/x) {
			my $skip_spaces = 0;
			$quote_block = $2;
			my $quote_op = $quote_block;
			if ($quote_block eq ".") {
				$quote_op = "";
				$skip_spaces = 1;  # this is a SUPER BOGUS hack for regexp opts
			}
			my $line_with_quote = $line;
			my $tab_strip = $tab + 1;
			++$i;
			my $quoted_lines = [];
			while (1) {
				$line = $lines->[$i];
				$tab = $tabs->[$i];
				$space = $spaces->[$i];
				if ($tab >= $tab_strip) {
					$line = substr $line, $tab_strip;
					push @$quoted_lines, $line;
				} else {
					last;
				}
				++$i;
			}
			--$i;
			if (@$quoted_lines == 0) {
				$line = $line_with_quote . $quote_op. "{}";
			} else {
				out "$line_with_quote\n";
				$quoted_lines->[0] = " $quote_op\{" . $quoted_lines->[0];
				$quoted_lines->[-1] .= "\n}"; $skip_newline = 1;
				$line = pop @$quoted_lines;
				for (@$quoted_lines) { out "$_\n"; }
			}
			# the final quoted line is output by normal mechanism
			# what a mess!
			$tab = $tab_strip-1;
			if ($skip_spaces) { 
				# this is a SUPER BOGUS hack for regexp opts
				$lines->[$i+1] =~ s/ \A (\t*) (\s+) /$1/x;
			}
		}

		# compare indent of adjacent lines to add braces
		my $line_next = $lines->[$i+1];
		if (!defined $line_next) { $line_next = ""; }
		my $tab_next = $tabs->[$i+1] || 0;
		my $space_next = $spaces->[$i+1] || 0;

		# add parens for if, elsif, unless, while, until, for
		if (!$quote_block) {
			$line =~ s/ \A (\t*) (if|unless|while|until|for (?:my )?\$\w+|for|\s+elsif)
		                       (\s*) (.*) \z
			          /$1$2$3($4)/x;
		}

		# remove single dot
		$line =~ s/ \A (\t*) \. \z /$1/x;

		# separate comment, if any
#		($line, $comment) = $line =~ /(\t*

		# add semicolons and braces
		if ($tab_next == $tab) {
			unless ($space_next || $line =~ m/ \A \s* (\#|\z) /x) {
				# don't add ; to continuing lines, blank lines or comments
				$line .= ";";
			}
		} elsif ($tab_next > $tab) {
			$line .= " {" x ($tab_next - $tab);
		} elsif ($tab_next < $tab) {
			$line .= ";";
			my $d = $tab - $tab_next;
			if ($d > 1) {
				$line .= " };" x ($d-1);
			}
			$line .= " }";
			if ($space_next == 0) { $line .= ";"; }
		}
		
		out "$line";
		unless ($skip_newline) { out "\n"; }

		++$i;
	}

	return $output;
}

1
