#!/usr/bin/env perl

# Copyright (c) 2015 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.

use strict; use warnings; use warnings FATAL => 'uninitialized';

# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname); BEGIN {
    my $location= (-l $0) ? abs_path ($0) : $0;
    $location=~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname)=($1,$2);
}
use lib "$mydir/../lib";


sub usage {
    print "usage: $myname in out
  expand `tail ` syntax in Perl code using `Sub::Call::Tail`, so that it
  doesn't depend on that module anymore.

  This is currently just a crude hack (totally imprecise).
";
    exit 1;
}

use Getopt::Long;
our $verbose=0;
our $opt_repl;
GetOptions("verbose"=> \$verbose,
	   "help"=> sub{usage},
	   "repl"=> \$opt_repl,
	   #"dry-run"=> \$opt_dry,
	   ) or exit 1;
usage unless @ARGV==2;

our ($inpath,$outpath)=@ARGV;

use Chj::xopen qw(xopen_read xopen_write);
use Chj::TEST ":all";

our $code= xopen_read($inpath)->xcontent; # evil, doesn't check close return value

our $IDENT= qr/\w+(?:::\w+)*/;

sub translate {
    my ($c)=@_;
    $c=~ s/\s+\z//s; # XX killing line numbering
    $c=~ s/^\s+//s; # dito?
    my @p;
    if ($c=~ /\#/) {
	undef
    } elsif (@p= split /->/, $c and @p==2) {
	my ($before,$after)= @p;
	'@_='.$after.'; goto &{'.$before.'}'
    } elsif ($c=~ s/^\&//) {
	if (my ($ident, $args)= $c=~ m/^(\$${IDENT})\s*(\(.*)/s) {
	    '@_='.$args.'; goto &'.$ident
	} else {
	    die "dunno about '$c'";
	}
    } elsif (my ($ident,$args)= $c=~ m/^($IDENT)\s*(\(.*)/s) {
	'@_='.$args.'; goto \&'.$ident
    } else {
	undef
    }
}

TEST { translate '&$odd ($n - 1)'."\n\t " }
  '@_=($n - 1); goto &$odd';
TEST { translate 'Weakened($even)->($n)' }
  '@_=($n); goto &{Weakened($even)}';
TEST { translate ' &$then
   ($$config{downcaps} && is_allcaps ($2) ? $1.lc($2).".xhtml"
               : $path0)' }
  '@_=($$config{downcaps} && is_allcaps ($2) ? $1.lc($2).".xhtml"
               : $path0); goto &$then';

use FP::Div 'min';

sub min_maybe {
    min grep { defined $_ } @_
}


# register positions of the lines, and their indentation
sub get_line_position_and_indents {
    my $line_position_and_indents=[];
    my $lineno=-1; # 0-based index, *not* what editors expect
    while ($code=~ /(?:^|\n)([ \t]*)/g) {
	$lineno++;
	my $indentstr= $1;
	my $pos= pos ($code);
	# the pos where that line starts:
	my $pos0= $pos - length ($indentstr);
	my $i=0;
	for (split //, $indentstr) {
	    if ($_ eq ' ') {
		$i++
	    } elsif ($_ eq "\t") {
		# 8-based tabs
		$i= (int ($i / 8) + 1)* 8
	    } else {
		die "??"
	    }
	}
	push @$line_position_and_indents,
	  [$lineno, $pos0, $i];
    }
    $line_position_and_indents
}

our $line_position_and_indents= get_line_position_and_indents;


sub find_line_by_pos {
    my ($pos)=@_;
    # XX would need binary search for efficiency.
    my $prevline= $$line_position_and_indents[0];
    for (@$line_position_and_indents[1..$#$line_position_and_indents]) {
	my ($lineno, $pos0, $i)= @$_;
	return $prevline if $pos < $pos0;
	$prevline=$_;
    }
    return $prevline # (don't have len of that line to check, thus trust)
}

# expand the 'tail' keyword right before pos in $code, set pos to
# afterwards.
sub expand_tail_at_pos {
    my $pos= pos ($code);

    # Where is the end of the arguments? Either when encountering a
    # ";", or a line with indent the same or smaller than the current
    # line, whichever comes first.

    my $maybe_endpos_semicolon= pos($code)-1 if $code=~ /;/g;
    # -1 so as to leave the ';' in *afterwards*.

    my ($tailline_lineno, $tailline_pos0, $tailline_i)=
      @{find_line_by_pos $pos};
    my $afterline;
    for my $lineno ($tailline_lineno+1 .. $#$line_position_and_indents) {
	$afterline= $$line_position_and_indents[$lineno];
	last if $$afterline[2] <= $tailline_i;
    }
    my $maybe_endpos_indent= $$afterline[1]-1 if $afterline;
    # -1 so as to leave the "\n" in.

    my $maybe_endpos= min_maybe ($maybe_endpos_semicolon, $maybe_endpos_indent);

    if (defined $maybe_endpos) {
	my $endpos= $maybe_endpos;
	my $args= substr $code, $pos, $endpos-$pos;
	if (defined (my $replacement= translate $args)) {
	    my $startpos = $pos - 4;

	    substr $code, $startpos, $endpos - $startpos, $replacement;

	    # re-init index. XX nonscalable of course.
	    $line_position_and_indents= get_line_position_and_indents;

	    pos($code)= $startpos + length $replacement;
	    #warn "right: '$args'";
	} else {
	    #warn "wrong1: '$args'";
	}
    } else {
	#warn "wrong2"
    }
}


if ($opt_repl) {
    require Chj::Backtrace;
    require Chj::repl;
    Chj::repl::repl ();
    exit;

} else {

    # be insensitive to 'tail ' mentioned in comments; so bad. but
    # lookbehind are not variable width, and setting pos($code) from
    # within a substitution does not work.
    $code=~ s=\n[\t ]*#[^\n]*\btail [^\n]*[^\n]=\n\n=sg;

    # Instead of writing a various kinds of parens and various kinds
    # of quoting parser, look at indentation: after newlines allow
    # only more indentation than the line where the tail statement is
    # found on has.
    while ($code=~ m/(?<!\$)\btail\b/g) {
	expand_tail_at_pos
    }

    $code=~ s/\buse\s*Sub::Call::Tail\b.*?;//s; # XX kills line numbering

    my $o= xopen_write $outpath;
    $o->xprint ($code);
    $o->xclose;

    chmod 0755, $outpath
	if -x $inpath;

}
