#!/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";

use Chj::xopen qw(xopen_read xopen_write);
use Chj::TEST ":all";
use Chj::xIOUtil qw(xgetfile_utf8);
#use FP::Repl::Trap; $SIG{INT}=sub{ die "SIGINT" };


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 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;

    
our $code= xgetfile_utf8($inpath);

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

sub translate {
    my ($c)=@_;
    #warn "translate: <$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);
    #warn "expand_tail_at_pos $pos";

    # 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'";
            pos($code)= $pos+1;
        }
    } else {
        warn "wrong2"
    }
}


if ($opt_repl) {
    require Chj::Backtrace;
    require FP::Repl;
    FP::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;

}
