The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use 5.010;
use strict;
use warnings;

use Test::More;
use Data::Dump::Partial qw(dumpp);
use Data::Format::Pretty::Console qw(format_pretty);
use YAML::Any;

local $ENV{ANSITABLE_BORDER_STYLE} = 'Default::single_ascii';
local $ENV{ANSITABLE_COLOR_THEME}  = 'Default::no_color';

my @data = (
    {
        data         => undef,
        struct       => "scalar",
        output       => "",
    },

    {
        data         => "",
        struct       => "scalar",
        output       => "",
    },

    {
        data         => " ",
        struct       => "scalar",
        output       => " \n",
    },

    {
        data         => "foo",
        struct       => "scalar",
        output       => "foo\n",
    },

    # test extra newline not being printed when scalar already ends with newline
    {
        data         => "\n",
        struct       => "scalar",
        output       => "\n",
    },
    {
        data         => "foo\n",
        struct       => "scalar",
        output       => "foo\n",
    },

    {
        data         => bless([], "foo"),
        struct       => "scalar",
        output_re    => qr/foo=/,
    },

    {
        data         => [],
        struct       => "aoa",
        output       => "",
    },

    {
        data         => [ [1,2],[3,4] ],
        struct       => "aoa",
        output_re    => qr/---/,
        ouput_ni     => "1\t2\n3\t4\n",
        is_yaml      => 0,
    },

    {
        data         => [{}],
        struct       => "aoh",
    },

    {
        data         => [{a=>1, b=>2}, {b=>3, c=>4}, {a=>5}],
        struct       => "aoh",
        output_re    => qr/^\|\s*5\s*\|\s*\|\s*\|$/m,
        output_ni_re => qr/^5\t\t$/m,
    },

    {
        data         => [ 1, 2, [3, 4] ],
        struct       => "list",
        output_re    => qr/\| 3, 4.+---/sm,
        ouput_ni_re  => qr/^3, 4\n/m,
    },

    {
        data         => [ [1, 2, 3], [4, 5] ],
        struct       => "list",
        output_re    => qr/^\| 1, 2, 3/m,
        ouput_ni_re  => qr/^1, 2, 3/m,
    },

    {
        data         => {a=>1, b=>2},
        struct       => "hash",
        output_re    => qr/^\|\s*a\s*\|\s*1\s*\|$/sm,
        ouput_ni_re  => qr/^a\t1$/m,
    },

    {
        data         => {a=>1, b=>[2, 3]},
        struct       => "hot",
        output_re    => qr/^a:\n1\n\nb:\n.+---/,
    },

    {
        data         => {a=>{k=>"v"}, b=>{k=>"v"}},
        struct       => "hot",
        output_re    => qr/^a:\n.+---.+/,
    },

    {
        data         => {a=>{b=>{}}},
        struct       => undef,
        is_yaml      => 1,
    },
    {
        name         => 'opt table_column_orders',
        data         => [{a=>1, bat=>1, foo=>1, bar=>1, baz=>1, quux=>1}],
        opts         => {table_column_orders=>[[qw/foo bar baz/]]},
        struct       => 'aoh',
        output_re    =>
            qr/^
               (\|\s+a\s+\|\s+foo\s+\|\s+bar\s+\|\s+bat\s+\|\s+baz\s+\|\s+quux\s+\|
               #|\|\s+a\s+\|\s+bat\s+\|\s+foo\s+\|\s+bar\s+\|\s+baz\s+\|\s+quux\s+\|
               #|\|\s+a\s+\|\s+bar\s+\|\s+bat\s+\|\s+foo\s+\|\s+baz\s+\|\s+quux\s+\|
               )\n/mx,
    },
    {
        name         => 'opt table_column_orders (no order matches)',
        data         => [{a=>1, bat=>1, foo=>1, bar=>1, baz=>1, quux=>1}],
        opts         => {table_column_orders=>[[qw/foo bar baz qux/]]},
        struct       => 'aoh',
        output_re    => qr/^\| a \| bar \| bat \| baz \| foo \| quux \|\n/m,
    },
    {
        name         => 'opt table_column_formats',
        data         => [{fooDate=>942595047, _time1=>1342595047}],
        opts         => {table_column_formats=>[
            {fooDate=>["cat"], _time1=>[[date=>{format=>"%Y"}]]}]},
        struct       => 'aoh',
        output_re    => qr/2012/m, # XXX and not /1999/
    },
    # first broken in 0.20
    {
        name         => "opt table_column_formats doesn't mess multiline text",
        data         => [{text=>""}, {text=>"foo foo foo"}],
        opts         => {table_column_formats=>[
            {text=>[[wrap => {width=>4}]]}]},
        struct       => 'aoh',
        output_re    => qr/^\| foo  \|\n\| foo  \|\n\| foo  \|\n/m,
    },
    # XXX opt table_column_types
    # XXX multi-column
    # XXX max_columns
);

sub is_yaml {
    my ($data, $test_name) = @_;
    eval { Load($data) };
    ok(!$@, $test_name);
}

sub isnt_yaml {
    my ($data, $test_name) = @_;
    eval { Load($data) };
    #XXX doesn't die?
    #ok($@, $test_name);
    #print "\$data=$data, \$@=$@\n";
}

 # detect and format
sub test_dnf {
    my ($spec) = @_;
    my $data   = $spec->{data};
    my $opts   = $spec->{opts} // {};
    my $struct = $spec->{struct};
    my $test_name = $spec->{name} //
        ($struct // "unknown") . ": " . dumpp($data);

    if (exists $spec->{struct}) {
        my $fmt = Data::Format::Pretty::Console->new;
        my ($s, $sm) = $fmt->_detect_struct($data);
        if (!$struct) {
            ok(!$s, "$test_name: _detect_struct: structure unknown");
        } else {
            is($s, $struct, "$test_name: _detect_struct: structure is ".
                   "'$struct'");
        }
    }

    if (exists($spec->{output}) || exists($spec->{output_re}) ||
            exists($spec->{is_yaml})) {
        my $output;
        {
            $output = format_pretty($data, {%$opts, interactive=>1});
        }
        #say $output;
        if (exists($spec->{output})) {
            is($output, $spec->{output}, "$test_name: output exact match");
        }
        if (exists($spec->{output_re})) {
            like($output, $spec->{output_re}, "$test_name: output regex match");
        }
        if (exists($spec->{is_yaml})) {
            if ($spec->{is_yaml}) {
                is_yaml($output, "$test_name: is YAML");
            } else {
                isnt_yaml($output, "$test_name: is not YAML");
            }
        }
    }

    if (exists($spec->{output_ni}) || exists($spec->{output_ni_re}) ||
            exists($spec->{is_yaml})) {
        my $output;
        {
            $output = format_pretty($data, {%$opts, interactive=>0});
        }
        if (exists($spec->{output_ni})) {
            is($output, $spec->{output_ni},
               "$test_name: output exact match (ni)");
        }
        if (exists($spec->{output_ni_re})) {
            like($output, $spec->{output_ni_re},
                 "$test_name: output regex match (ni)");
        }
        if (exists($spec->{is_yaml})) {
            if ($spec->{is_yaml}) {
                is_yaml($output, "$test_name: is YAML (ni)");
            } else {
                isnt_yaml($output, "$test_name: is not YAML (ni)");
            }
        }
    }
}

test_dnf($_) for @data;
done_testing();