#!/usr/bin/env perl

# Two hand-maintained agreements are easy to apply in half: the schema version
# a document in t/fixtures/ declares has to match the module that prints it,
# and a live test's knobs have to be named by the tests, their whitelist and
# their documentation.  The suite catches either, but only once it runs,
# which is this hook's job: refuse the commit rather than let CI find it.
#
# A commit is checked as a snapshot: the staged files are written to a
# temporary directory and the checks run there, so a change that is staged in
# half is caught even if the working tree beside it looks complete.  The
# pre-commit mode never reads the working tree.
#
# Enable it once per clone with
#
#     git config core.hooksPath .githooks
#
# and skip it for one commit with "git commit --no-verify".
#
# The same checks can be run from the command line without committing:
#
#     make check-staged    # against the index
#     make check-worktree  # against the working tree, unstaged edits included
#
# They invoke this hook with --staged and --worktree.  The staged mode reads
# the same index and writes the same snapshot as the hook, so the two cannot
# disagree about what is committed; the worktree mode runs both checks in the
# checkout itself, without changing it.
# Either target lists every check with what became of it - passed, with its
# test count, failed, or skipped because nothing staged could change what it
# reads - so a clean run shows which checks ran.  The commit hook itself says
# nothing when it passes.

use strict;
use warnings;
use File::Spec;
use File::Temp qw(tempdir);
use FindBin;

use lib File::Spec->catdir($FindBin::Bin, File::Spec->updir, 'lib');

use App::Actions::Process ();

# A pre-commit hook is given no arguments; the make targets name the mode so
# their reports do not claim a commit was refused.
my $staged   = @ARGV && $ARGV[0] eq '--staged';
my $worktree = @ARGV && $ARGV[0] eq '--worktree';
shift @ARGV if $staged || $worktree;
my $label = $staged ? 'check-staged'
    : $worktree ? 'check-worktree'
    : 'pre-commit';

# A make target is run by a person who wants to know what was checked, so it
# says which checks ran and passed, and which were skipped; a silent success
# could not be told apart from a check that never ran.  The commit hook stays
# quiet when it passes, as hooks are expected to.
my $explicit = $staged || $worktree;

# The checks, in the order they run and are reported.
my @check_names = ('schema', 'live knobs');
# Each check's test file as it is shown (with / on every platform, so the
# report reads the same everywhere) and as it is run (the native path).
my %check_label = (
    'schema'     => 't/schema.t',
    'live knobs' => 't/live-knobs.t',
);
my %check_path = map { $_ => File::Spec->catfile(split m{/}, $check_label{$_}) } keys %check_label;

# The files whose staging can change what each check looks at.  A commit that
# touches neither set has nothing for these checks to say, which keeps an
# ordinary commit cheap.
my @schema_relevant = ('lib', 'bin', 't/schema.t', 't/fixtures');
my @live_relevant = (
    't/real-docker.t',
    't/real-docker-preflight.t',
    't/self_test.t',
    't/live-knobs.t',
    'README.md',
    'lib/App/Actions.pm',
    '.github/workflows',
);

sub run_command {
    my ($command, %options) = @_;

    return App::Actions::Process::capture($command, %options);
}

# Not a git work tree - an unpacked distribution, say: there is no commit to
# guard and no index to read.  git says so itself; its message is not this
# hook's to repeat, so it is dropped.
my ($root, $root_status) = run_command(
    [qw(git rev-parse --show-toplevel)],
    quiet_stderr => 1,
);
if ($root_status) {
    print "$label: not a git work tree, so nothing was checked.\n" if $explicit;
    exit 0;
}

chomp $root;
chdir $root or do {
    print STDERR "$label: cannot change to '$root': $!\n";
    exit 0;
};

my %wanted;

# An explicit worktree check is asked for by a person rather than run for every
# commit, so it runs both checks.  The tree also holds untracked files, which
# the staged-path filter below could not see, so filtering here would risk
# skipping a file the checks would have read.
if ($worktree) {
    %wanted = map { $_ => 1 } @check_names;
} else {
    # Nothing staged that could move either agreement: the commit cannot be
    # the half-applied change this guards against.  An unborn HEAD makes both
    # diffs fail, and the first commit is checked like any other, so both
    # checks run.
    my ($schema_changed, $schema_status) = run_command(
        [ 'git', 'diff', '--cached', '--name-only', 'HEAD', '--', @schema_relevant ],
        quiet_stderr => 1,
    );
    my ($live_changed, $live_status) = run_command(
        [ 'git', 'diff', '--cached', '--name-only', 'HEAD', '--', @live_relevant ],
        quiet_stderr => 1,
    );

    $wanted{'schema'} = 1 if $schema_status || $schema_changed =~ /\S/;
    $wanted{'live knobs'} = 1 if $live_status || $live_changed =~ /\S/;
}

my @checks = map { { name => $_, path => $check_path{$_} } }
    grep { $wanted{$_} } @check_names;

# One line per check: what happened to it.  A check that ran shows how many
# tests it ran, which is the evidence that it ran at all.
sub outcome_lines {
    my ($results) = @_;

    my @lines;
    for my $name (@check_names) {
        my $result = $results->{$name};
        if (!$result) {
            push @lines, "  $name ($check_label{$name}): skipped - nothing staged "
                . 'could change what it reads';
            next;
        }

        my $tests = $result->{tests};
        my $count = defined $tests ? " ($tests tests)" : '';
        push @lines, "  $name ($check_label{$name}): "
            . ($result->{passed} ? 'passed' : 'FAILED') . $count;
    }

    return @lines;
}

if (!@checks) {
    print "$label: nothing staged could change what the checks read, so none ran.\n",
        map({ "$_\n" } outcome_lines({})) if $explicit;
    exit 0;
}

# The snapshot the checks read.  A commit is checked from the index written
# out here, because that is what it will contain; the working tree is
# deliberately not consulted.  A worktree check reads this checkout in place,
# since that is the state being asked about.
my $snapshot = $root;
if (!$worktree) {
    $snapshot = tempdir(
        'app-actions pre-commit XXXX',
        TMPDIR => 1, CLEANUP => 1,
    );
    (my $prefix = $snapshot) =~ s{\\}{/}g;

    my ($checkout_error, $checkout_status) = run_command(
        [ 'git', 'checkout-index', '-a', '-f', "--prefix=$prefix/" ],
        merge_stderr => 1,
    );

    # A conflicted index cannot be written out.  A merge commit is not the
    # half-applied change this is for, and refusing it would block the merge.
    if ($checkout_status) {
        print STDERR "$label: the staged files could not be read, so the "
            . "checks were skipped.\n";
        print STDERR "$checkout_error\n" if length $checkout_error;
        exit 0;
    }
}

my $lib = File::Spec->catdir($snapshot, 'lib');

chdir $snapshot or do {
    print STDERR "$label: cannot change to '$snapshot': $!\n";
    exit 0;
};

# The checks are run for a person, not for the harness that may have started
# this hook (a pre-commit hook run from "make test", say), so the children are
# given a plain environment and print the TAP this reads.
my (@failed, %results);
for my $check (@checks) {
    my ($output, $status);
    {
        local $ENV{HARNESS_ACTIVE};
        local $ENV{HARNESS_VERSION};
        local $ENV{HARNESS_OPTIONS};

        ($output, $status) = run_command(
            [ $^X, "-I$lib", $check->{path} ],
            merge_stderr => 1,
        );
    }

    # The plan, "1..N", says how many tests ran; done_testing prints it last.
    my ($tests) = $output =~ /^1\.\.(\d+)/m;
    $results{ $check->{name} } = { passed => !$status, tests => $tests };

    next unless $status;

    # The temporary directory is gone by the time anyone reads this, so its
    # path would be a distraction in a file name the reader has to act on.
    $output =~ s{\Q$snapshot\E/?}{}g;
    push @failed, { %$check, output => $output };
}

if (!@failed) {
    print "$label: every check that ran passed.\n",
        map({ "$_\n" } outcome_lines(\%results)) if $explicit;
    exit 0;
}

# A run that failed before it printed a verdict - a missing module, say - has
# no failing assertion to show, so it is quoted instead of summarised.
sub failing_tap {
    my ($output) = @_;

    my @report;
    my $in_diagnostic = 0;
    for my $line (split /\n/, $output) {
        if ($line =~ /\A(?:not ok|Bail out!)/) {
            push @report, $line;
            $in_diagnostic = 1;
            next;
        }
        if ($in_diagnostic && $line =~ /\A#/) {
            push @report, $line;
            next;
        }
        $in_diagnostic = 0;
    }

    return @report if @report;

    my @lines = grep { /\S/ } split /\n/, $output;
    return @lines > 20 ? @lines[-20 .. -1] : @lines;
}

my @report;
for my $failed (@failed) {
    push @report, "--- $failed->{name} ---", failing_tap($failed->{output});
}

if ($worktree) {
    print STDERR "check-worktree: the checks failed against the working tree.\n\n";
} elsif ($staged) {
    print STDERR "check-staged: the checks failed against what is staged.\n\n";
} else {
    print STDERR "pre-commit: the checks failed against what this commit stages, so it "
        . "was refused and nothing has been committed.\n\n";
}
print STDERR join("\n", outcome_lines(\%results)), "\n\n" if $explicit;
print STDERR join("\n", @report), "\n\n";
print STDERR <<"ADVICE";
A schema version lives in the module that prints it - lib/App/Actions/Check.pm,
lib/App/Actions/Runner.pm, lib/App/Actions/Cache.pm or lib/App/Actions/Logs.pm -
and in every document in t/fixtures/ written for it.  A live knob lives in the
live tests, the whitelist in t/live-knobs.t, README.md, lib/App/Actions.pm and
the workflow that sets it.
ADVICE
print STDERR $worktree
    ? "Fix the file named above and run \"make check-worktree\" again.\n"
    : "Fix the file named above and stage it.  \"git commit --no-verify\" "
        . "skips these checks when committing.\n";

exit 1;
