#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long;
use Data::Dumper;
use POSIX qw(strftime);
use Cwd;

my @opts;
my @fopts;
my @mopts;

my @saved_args = @ARGV;

my $opt_l;
my $opt_n;
my $opt_p;
my @opt_rts;
my $opt_clean;
my $opt_timeout=60*5;

Getopt::Long::Configure ("bundling");
GetOptions(
    'm=s' => \@mopts,
    'f=s' => \@fopts,
    'o=s' => \@opts,
    't=i' => \$opt_timeout,
    l => \$opt_l,
    n => \$opt_n,
    p => \$opt_p,
    'rts=s' =>\@opt_rts,
    clean => \$opt_clean
    ) or die "Invalid options";

@opts = (@opts, (map { "-f$_" } @fopts), (map { "-m$_" } @mopts));

my @cond;
my @ncond;

foreach (@ARGV) {
    /^\!(.*)/ ? push @ncond, $1 : push @cond, $_;
}

my $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime;

my $pwd = cwd();

# figure out where we are

my ($regress_dir,$jhc_dir);



if (-d "tests" && -d "results") {
    $regress_dir = ".";
    $jhc_dir = "..";
} elsif (-d "regress" && -f "Makefile") {
    $regress_dir = "regress";
    $jhc_dir = "."
} else { die "could not figure out where I am" }

my $test_dir = "$regress_dir/tests";
my $results_dir = "$regress_dir/results";

my $time = `date +%Y%m%d%H%M%S`;
chomp $time;


my $jhc_version = `$jhc_dir/jhc --version`;
$? == 0 or die "Could not run $jhc_dir/jhc --version";

my $rd = "$results_dir/$time";
mkdir $rd or die "$!: could not make $rd";

unlink "$results_dir/current";
system "ln -sf $time $results_dir/current";


my $ho_dir = $opt_clean ? "$rd/ho" : "$results_dir/ho";
$ho_dir .= "_l" if $opt_l;
mkdir $ho_dir;

open RLOG, ">$rd/log.txt" or die "$!: Could not open log";

rlog("$now_string");
rlog("$jhc_version");
rlog("regress ", join " ", @saved_args) if @saved_args;
rlog("-----------------------------------");



-d $test_dir or die "could not find $test_dir";

sub maybe_read {
    my ($fn) = @_;
    open my $fh, "<$fn" or return ();
    my @lines = <$fh>;
    map { chomp } @lines;
    close $fh;
    return @lines;
}

my $error;
my @res;

sub rlog {
    my $msg = join "",@_;
    chomp $msg;
    print RLOG $msg, "\n";
    print $msg, "\n";
}

sub my_system {
    my $time_start = time();
    rlog "; ", join " ",@_;
    my $r = $opt_timeout ? system ("ulimit -t $opt_timeout ; ". join " ",@_) : system @_;
    my $time_end = time();
    return ($r,$time_end - $time_start);
}


sub do_it {
    my ($cwd,$name) = @_;
    #print "Entering $cwd\n";
    my $no_run = -f "$cwd/norun";
    my @flags = maybe_read "$cwd/flags.txt";
    test: foreach my $fn (sort(split /\n/,`ls $cwd`)) {
        my $n = "$cwd/$fn";
        if (-d $n && $n ne "results") {
            my $fnn = $fn;
            $fnn =~ s/^\d+_//;
            do_it($n,"$name.$fnn");
        } elsif ($fn =~ /^([^_].*)\.l?hs$/) {
            my $ln = $1;
            next if $ln =~ /_code$/;
            my $fbase = "$cwd/$ln";
            my $name = "$name.$ln";
            if(@cond) {
                my $keep = 0;
                foreach (@cond) {
                $keep = 1 if $name  =~ /$_/;
                }
                unless($keep) {
                    rlog "Skipping $name";
                    next;
                }
            }
            foreach (@ncond) {
                if($name =~ /$_/) {
                    rlog "Skipping $name";
                    next test;
                }
            }
            rlog "-- $name";
            my @libs = $opt_l ? () : ("--noauto", "-i$jhc_dir/lib/base","-i$jhc_dir/lib/haskell98");
            my @fast = $opt_n ? () : ("-flint");
            my @jhc  = $opt_p ? ("$jhc_dir/jhcp","+RTS", "-S$rd/$name.jhcp_prof",@opt_rts,"-RTS")  :  ("$jhc_dir/jhc");
            my @cmd = (@jhc, "-v", '--ho-dir', $ho_dir, @libs , @fast, "-o", "$rd/$name", @flags, @opts, "$cwd/$fn");
            my $res = join(" ",@cmd) . " > '$rd/$name.jhc_out' 2>&1";
            my ($r,$time) = my_system $res;
            my $result = { name => $name, compile_command => $res, compile_status => $r, compile_results => "$rd/$name.jhc_out", compile_time => $time };
            push @res, $result;
            unless($r == 0) {
                rlog "Compilation Failed: $r";
                my $msg = `tail $result->{compile_results}`;
                rlog $msg;
                $error++;
                if($r == 64512) {done()};
                next;
            }
            next if $no_run;
            my @args = maybe_read("$fbase.args");
            $result->{run_stdout} = "$rd/$name.stdout";
            my $stdin = " < $fbase.stdin" if -f "$fbase.stdin";
            my $run_cmd = "$rd/$name " . join(" ",@args) . " > $result->{run_stdout}" . ($stdin || "");
            $result->{run_cmd} = $run_cmd;
            ($r,$time) = my_system $run_cmd;
            $result->{run_status} = $r;
            $result->{run_time} = $time;
            unless($r == 0) {
                rlog "-- Run Failed: $r";
                $error++;
                if($r == 64512) {done()};
                next;
            }

            if(-f "$fbase.expected.stdout" ) {
                $result->{expected_stdout} = "$fbase.expected.stdout";
                my $r = system "diff $result->{run_stdout} $result->{expected_stdout}";
                $result->{stdout_diff} = $r;
                $error++ if $r ne 0;
            }
        }
    }
}

do_it($test_dir,"tests");
done();


sub done {
    sub statf {
        return defined $_[0] ? ($_[0] == 64512 ? "INT" : $_[0] == 35072 ? "TIME" : $_[0]) : "-";
    }
    sub timef {
        return defined $_[0] ? "$_[0]s" : "-";
    }
    rlog("-----------------------------------");
    rlog("$now_string");
    rlog("$jhc_version");
    rlog("regress ", join " ", @saved_args) if @saved_args;
    rlog "\n--------------------------------------------------------------------";

    my $fmt = "%50s %5s %5s %5s %7s %7s\n";
    rlog sprintf $fmt, "Name", "Compile", "Run", "Out", "CTime", "RTime";
    foreach my $r (@res) {
        rlog sprintf $fmt, $r->{name}, statf($r->{compile_status}),statf($r->{run_status}),statf($r->{stdout_diff}), timef($r->{compile_time}), timef($r->{run_time}) ;

    }
    close RLOG;
    unlink "$results_dir/last";
    system "mv -f $results_dir/latest $results_dir/last";
    unlink "$results_dir/latest";
    system "ln -sf $time $results_dir/latest";
    unless ($error) {
        unlink "$results_dir/latest_success";
        system "ln -sf $time $results_dir/latest_success";
    }
    exit 0;
}