#!perl
# Marpa::R3 is Copyright (C) 2017, Jeffrey Kegler.
#
# This module is free software; you can redistribute it and/or modify it
# under the same terms as Perl 5.10.1. For more details, see the full text
# of the licenses in the directory LICENSES.
#
# This program is distributed in the hope that it will be
# useful, but it is provided "as is" and without any express
# or implied warranties. For details, see the full text of
# of the licenses in the directory LICENSES.

use 5.010001;
use strict;
use warnings;

use English qw( -no_match_vars );
use Fatal qw(open close);
use Text::Diff;
use Getopt::Long qw(GetOptions);
use List::Util;
use Test::More 0.94;
use Carp;

use Perl::Tidy;
use Text::Wrap;

use lib 'inc';
use Marpa::R3::Display;

my $warnings = 0;
my $options_result = GetOptions( 'warnings' => \$warnings );

Marpa::R3::exception("$PROGRAM_NAME options parsing failed")
    if not $options_result;

my %exclude = map { ( $_, 1 ) } qw();
my @additional_files = qw();

my @test_files = @ARGV;
my $debug_mode = scalar @test_files;
if ( not $debug_mode ) {

    for my $additional_file (@additional_files) {
        Test::More::diag("Adding $additional_file");
        push @test_files, $additional_file;
    }

    open my $manifest, '<', 'MANIFEST'
        or Marpa::R3::exception("Cannot open MANIFEST: $ERRNO");
    FILE: while ( my $file = <$manifest> ) {
        chomp $file;
        $file =~ s/\s*[#].*\z//xms;
        next FILE if $file =~ m( [/] old_pod [/] )xms;
        next FILE if $file =~ m( html [/] etc [/] drafts [/] )xms;
        my ($ext) = $file =~ / [.] ([^.]+) \z /xms;
        next FILE if not defined $ext;
        $ext = lc $ext;
        next FILE
            if $ext ne 'pod'
                and $ext ne 'pl'
                and $ext ne 'pm'
                and $ext ne 't';
        push @test_files, $file;
    }    # FILE
    close $manifest;

    my %file_seen = ();
    FILE: for my $test_file (@test_files) {

        next FILE if $exclude{$test_file};
        next FILE if -d $test_file;
        if ( $file_seen{$test_file}++ ) {
            Test::More::diag("Duplicate file: $test_file");
        }
    } ## end for my $test_file (@test_files)
    @test_files = keys %file_seen;

} ## end if ( not $debug_mode )

my $error_file;
## no critic (InputOutput::RequireBriefOpen)
if ($debug_mode) {
    open $error_file, '>&STDOUT'
        or Marpa::R3::exception("Cannot dup STDOUT: $ERRNO");
}
else {
    open $error_file, '>', 'author.t/display.errs'
        or Marpa::R3::exception("Cannot open display.errs: $ERRNO");
}
## use critic

my $display_data = Marpa::R3::Display->new();

FILE: for my $file (@test_files) {
    if ( not -f $file ) {
        Test::More::fail(qq{"$file" is not a file});
        next FILE;
    }
    $display_data->read($file);

} ## end for my $file (@test_files)

my @formatting_instructions = qw(perltidy
    remove-display-indent
    remove-blank-last-line inline
    partial flatten normalize-whitespace);

sub format_display {
    my ( $text, $instructions, $is_copy ) = @_;
    my $result = ${$text};

    if ( $instructions->{'remove-display-indent'} and $is_copy ) {
        my ($first_line_spaces) = ( $result =~ /^ (\s+) \S/xms );
        $first_line_spaces = quotemeta $first_line_spaces;
        $result =~ s/^$first_line_spaces//gxms;
    }
    if ( $instructions->{'inline'} ) {
        my $min_indent = 99_999_999;
        my @text = grep {/ [^ ] /xms} split /\n/xms, $result;
        for my $line (@text) {
            my ($s) = ( $line =~ / \A  ([ ]* ) /xms );
            my $indent = length $s;
            $min_indent > $indent and $min_indent = $indent;
        }
        $result = join "\n", map { substr $_, $min_indent } @text;
        my $tidied;

        # perltidy options chosen to make it as likely
        # as possible that code which differs
        # only in whitespace
        # will end up the same.
        Perl::Tidy::perltidy(
            source      => \$result,
            destination => \$tidied,
            perltidyrc  => \'-sbt=0 -iob -dcsc -sil=0',
        );
        $result = $tidied;
    } ## end if ( $instructions->{'inline'} )
    if ( $instructions->{'remove-blank-last-line'} ) {
        $result =~ s/^[ \t]*\n\z//xms;
    }
    if ( $instructions->{'flatten'} ) {
        $result =~ s/[\n\r]/ /gxms;
    }
    if ( $instructions->{'normalize-whitespace'} ) {
        $result =~ s/^\s+//gxms;
        $result =~ s/\s+$//gxms;
        $result =~ s/[ \f\t]+/ /gxms;
        $result =~ s/\n+/\n/gxms;
    } ## end if ( $instructions->{'normalize-whitespace'} )
    if ( defined( my $tidy_options = $instructions->{'perltidy'} ) ) {
        my $tidied;
        Perl::Tidy::perltidy(
            source      => \$result,
            destination => \$tidied,
            perltidyrc  => \$tidy_options
        );
        $result = $tidied;
    } ## end if ( defined( my $tidy_options = $instructions->{'perltidy'...}))
    return \$result;
} ## end sub format_display

# reformat two display according to the instructions in the
# second, and compare.
sub compare {
    my ( $original, $copy ) = @_;
    if ( $original->{partial} ) {
        # say STDERR join " ",
            # "Partial to partial comparison succeeds vacuously for",
            # $original->{filename}, $copy->{filename};
        return 1;
    }
    # say STDERR join " ", "Comparing", $original->{filename}, $copy->{filename};
    my $formatted_original =
        format_display( \$original->{content}, $copy, 0 );
    my $formatted_copy = format_display( \$copy->{content}, $copy, 1 );
    if ( $copy->{partial} ) {
        return 1 if -1 != index ${$formatted_original}, ${$formatted_copy};
        Test::More::diag(
            "Partial: ",
            $original->{filename},
            ' vs. ',
            $copy->{filename},
            "\n",
            (   Text::Diff::diff $formatted_original,
                $formatted_copy,
                { STYLE => 'Table' }
            )
            # Text::Wrap::wrap( q{    }, q{    }, ${$formatted_copy} ),
            # "\nOriginal:\n",
            # Text::Wrap::wrap( q{    }, q{    }, ${$formatted_original} )
        );
        return 0;
    } ## end if ( $copy->{partial} )
    return 1 if ${$formatted_original} eq ${$formatted_copy};
    Test::More::diag(
        'Differences: ',
        $original->{filename},
        ' vs. ',
        $copy->{filename},
        "\n",
        (   Text::Diff::diff $formatted_original,
            $formatted_copy,
            { STYLE => 'Table' }
        )
    );
    return 0;
} ## end sub compare

my $tests_run        = 0;
my $displays_by_name = $display_data->{displays};
DISPLAY_NAME: for my $display_name ( keys %{$displays_by_name} ) {

    my $displays = $displays_by_name->{$display_name};
    if ( scalar @{$displays} <= 1 ) {
        Test::More::fail(
            qq{Display "$display_name" has only one instance, in file }
                . $displays->[0]->{filename} );
        $tests_run++;
    } ## end if ( scalar @{$displays} <= 1 )

    # find the "original"
    my $original_ix;
    DISPLAY: for my $display_ix ( 0 .. $#{$displays} ) {
        if (not grep { $_ ~~ \@formatting_instructions }
            keys %{ $displays->[$display_ix] }
            )
        {
            $original_ix = $display_ix;
        } ## end if ( not grep { $_ ~~ \@formatting_instructions } keys...)
    } ## end for my $display_ix ( 0 .. $#{$displays} )

    # Warn if there wasn't a clear original?
    $original_ix //= 0;    # default to the first

    DISPLAY: for my $copy_ix ( 0 .. $#{$displays} ) {
        next DISPLAY if $copy_ix == $original_ix;
        Test::More::ok compare( $displays->[$original_ix],
            $displays->[$copy_ix] ), "$display_name, copy $copy_ix";
        $tests_run++;
    } ## end for my $copy_ix ( 0 .. $#{$displays} )

} ## end for my $display_name ( keys %{$displays_by_name} )

my $verbatim_by_file = $display_data->{verbatim_lines};
VERBATIM_FILE: for my $verbatim_file ( keys %{$verbatim_by_file} ) {
    my @unchecked      = ();
    my $verbatim_lines = $verbatim_by_file->{$verbatim_file};
    for my $verbatim_line_number ( 1 .. $#{$verbatim_lines} ) {
        my $verbatim_line = $verbatim_lines->[$verbatim_line_number];
        if ($verbatim_line) {
            push @unchecked, "$verbatim_line_number: $verbatim_line";
        }
    } ## end for my $verbatim_line_number ( 1 .. $#{$verbatim_lines...})
    next VERBATIM_FILE if not @unchecked;
    Test::More::fail( qq{Verbatim line(s) not checked in "$verbatim_file": }
            . ( scalar @unchecked )
            . " lines\n"
            . ( join "\n", @unchecked ) );
    $tests_run++;
} ## end for my $verbatim_file ( keys %{$verbatim_by_file} )

Test::More::done_testing($tests_run);

__END__

# vim: set expandtab shiftwidth=4: