
=head1 DESCRIPTION

This tests the L<Test::Mojo::Role::Moai> test role. All the templates with sample
data are in the C<__DATA__> section of this file.

=cut

use Mojo::Base -strict;
use Test2::API qw( intercept );
use Test::More;
use Test::Mojo;
use Mojolicious;
use List::Util qw( first );

sub check_test {
    my ( $test, %param ) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    my $events = intercept { $test->() };
    # We will get at least 1 event, the Ok event. If the test fails, we
    # will get at least 3 events: The Ok event (a failure), a diag event
    # with stack information (generated by Test::More), and a diag event
    # with additional diagnostics (generated by Test::Mojo::Role::Moai)
    my $event = first { $_->isa( 'Test2::Event::Ok' ) } reverse @$events;
    is $event->pass, $param{ ok }, $param{name} . ': pass/fail is correct'
        or diag $events->[-1]->message;
    if ( my $diag = $param{ diag } ) {
        my $event = $events->[-1];
        if ( !$event ) {
            fail $param{name} . ': No diag message found';
        }
        elsif ( ref $diag eq 'Regexp' ) {
            like $event->message, $diag, $param{name} . ': diag message matches';
        }
        else {
            is $event->message, $diag, $param{name} . ': diag message equals';
        }
    }
}

subtest 'table' => sub {
    subtest 'table_is - Complete equality' => sub {
        my $app = Mojolicious->new;
        $app->routes->get( '/' )->name( 'table_is' );
        my $t = Test::Mojo->with_roles( '+Moai' )->new( $app );

        check_test(
            sub {
                $t->get_ok( '/' )->table_is(
                    'table#mytable',
                    [
                        [ preaction => 'doug@example.com' ],
                        [ inara => 'cat@example.com' ],
                    ],
                    'table_is with ordered arrays (pass)',
                );
            },
            name => 'table_is with ordered arrays (pass)',
            ok => 1,
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_is(
                    'table#mytable',
                    [
                        [ preaction => 'doug@example.com' ],
                        [ inara => 'dog@example.com' ],
                    ],
                    'table_is with ordered arrays (fail)',
                );
            },
            ok => 0,
            name => 'table_is with ordered arrays (fail)',
            diag => qr{Row: 2 - Col: 2\nExpected: "dog\@example\.com"\nGot: "cat\@example\.com"},
        );
        ok !$t->success, 'Test::Mojo success flag is set to false';

        check_test(
            sub {
                $t->get_ok( '/', form => { noparts => 1 } )
                  ->status_is( 200 )
                  ->or( sub { diag shift->tx->res->dom->at( '#routes,#error' ) } )
                  ->table_is(
                    'table#mytable',
                    [
                        [ User => 'E-mail' ],
                        [ preaction => 'doug@example.com' ],
                        [ inara => 'cat@example.com' ],
                    ],
                    'table_is on table without thead/tbody (pass)',
                );
            },
            ok => 1,
            name => 'table_is on table without thead/tbody (pass)',
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_is(
                    'table#mytable',
                    [
                        { User => 'preaction', 'E-mail' => 'doug@example.com' },
                        { User => 'inara', 'E-mail' => 'cat@example.com' },
                    ],
                    'table_is with unordered hashes (pass)',
                );
            },
            ok => 1,
            name => 'table_is with unordered hashes (pass)',
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_is(
                    'table#mytable',
                    [
                        { User => 'preaction', 'E-mail' => 'doug@example.com' },
                        { User => 'inara', 'E-mail' => 'dog@example.com' },
                    ],
                    'table_is with unordered hashes (fail)',
                );
            },
            ok => 0,
            name => 'table_is with unordered hashes (fail)',
            diag => qr{Row: 2 - Col: 2\nExpected: "dog\@example\.com"\nGot: "cat\@example\.com"},
        );
        ok !$t->success, 'Test::Mojo success flag is set to false';

        check_test(
            sub {
                $t->get_ok( '/' )->table_is(
                    'table#mytable',
                    [
                        {
                            User => 'preaction',
                            'E-mail' => {
                                class => 'bg-primary',
                                text => 'doug@example.com',
                                elem => {
                                    'a[href]' => {
                                        href => 'mailto:doug@example.com',
                                    },
                                },
                            },
                        },
                        {
                            User => 'inara',
                            'E-mail' => {
                                class => 'bg-primary',
                                elem => {
                                    'a[href]' => {
                                        href => 'mailto:cat@example.com',
                                        text => 'cat@example.com',
                                    },
                                },
                            },
                        },
                    ],
                    'table_is with element attributes and descendants (pass)',
                );
            },
            ok => 1,
            name => 'table_is with element attributes and descendants (pass)',
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_is(
                    'table#mytable',
                    [
                        {
                            User => 'preaction',
                            'E-mail' => {
                                class => 'bg-secondary',
                                text => 'doug@example.com',
                                elem => {
                                    'a[href]' => {
                                        href => 'mailto:doug@example.com',
                                    },
                                },
                            },
                        },
                        {
                            User => 'inara',
                            'E-mail' => {
                                class => 'bg-primary',
                                elem => {
                                    'strong' => 'active',
                                    'a[href]' => {
                                        href => 'mailto:dog@example.com',
                                        text => 'dog@example.com',
                                    },
                                },
                            },
                        },
                    ],
                    'table_is with element attributes and descendants (fail)',
                );
            },
            ok => 0,
            name => 'table_is with element attributes and descendants (fail)',
            diag => qr{
                Row:\s*1\s*-\s*Col:\s*2\s*
                Expected:\s*class\s*=\s*bg-secondary\s*
                Got:\s*class\s*=\s*bg-primary\s*
                Row:\s*2\s*-\s*Col:\s*2\s*
                Expected:\s*a\[href\]:\s*"dog\@example\.com"\s*
                Got:\s*a\[href\]:\s*"cat\@example\.com"\s*
                Row:\s*2\s*-\s*Col:\s*2\s*
                Expected:\s*a\[href\]:\s*href\s*=\s*mailto:dog\@example\.com\s*
                Got:\s*a\[href\]:\s*href\s*=\s*mailto:cat\@example\.com\s*
                Row:\s*2\s*-\s*Col:\s*2\s*
                Expected:\s*elem\s*"strong"\s*
                Got:\s*<undef>\s*
            }xms,
        );
        ok !$t->success, 'Test::Mojo success flag is set to false';
    };

    subtest 'table_has - Subsets of rows and columns' => sub {
        my $app = Mojolicious->new;
        $app->routes->get( '/' )->name( 'table_is' );
        my $t = Test::Mojo->with_roles( '+Moai' )->new( $app );

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { User => 'preaction', 'E-mail' => 'doug@example.com' },
                        { User => 'inara', 'E-mail' => 'cat@example.com' },
                    ],
                    'table_has with complete rows/columns (pass)',
                );
            },
            ok => 1,
            name => 'table_is with complete rows/columns (pass)',
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { User => 'preaction', 'E-mail' => 'doug@example.com' },
                        { User => 'inara', 'E-mail' => 'dog@example.com' },
                    ],
                    'table_has with complete rows/columns (fail)',
                );
            },
            ok => 0,
            name => 'table_has with complete rows/columns (fail)',
            diag => qr{
                Missing:\s*Row\s*with\s*E-mail="dog\@example\.com",\s*User="inara"\s*
            }xms,
        );
        ok !$t->success, 'Test::Mojo success flag is set to false';

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { User => 'inara', 'E-mail' => 'cat@example.com' },
                    ],
                    'table_has with partial rows/complete columns (pass)',
                );
            },
            ok => 1,
            name => 'table_is with partial rows/complete columns (pass)',
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { User => 'inara', 'E-mail' => 'dog@example.com' },
                    ],
                    'table_has with partial rows/complete columns (fail)',
                );
            },
            ok => 0,
            name => 'table_has with partial rows/complete columns (fail)',
            diag => qr{
                Missing:\s*Row\s*with\s*E-mail="dog\@example\.com",\s*User="inara"
            }xms,
        );
        ok !$t->success, 'Test::Mojo success flag is set to false';

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { 'E-mail' => 'doug@example.com' },
                        { 'E-mail' => 'cat@example.com' },
                    ],
                    'table_has with complete rows/partial columns (pass)',
                );
            },
            ok => 1,
            name => 'table_is with complete rows/partial columns (pass)',
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { 'E-mail' => 'doug@example.com' },
                        { 'E-mail' => 'dog@example.com' },
                    ],
                    'table_has with complete rows/partial columns (fail)',
                );
            },
            ok => 0,
            name => 'table_has with complete rows/partial columns (fail)',
            diag => qr{
                Missing:\s*Row\s*with\s*E-mail="dog\@example\.com"\s*
            }xms,
        );
        ok !$t->success, 'Test::Mojo success flag is set to false';

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { 'E-mail' => 'doug@example.com' },
                    ],
                    'table_has with partial rows/partial columns (pass)',
                );
            },
            ok => 1,
            name => 'table_is with partial rows/partial columns (pass)',
        );
        ok $t->success, 'Test::Mojo success flag is set to true';

        check_test(
            sub {
                $t->get_ok( '/' )->table_has(
                    'table#mytable',
                    [
                        { 'E-mail' => 'dog@example.com' },
                    ],
                    'table_has with partial rows/partial columns (fail)',
                );
            },
            ok => 0,
            name => 'table_has with partial rows/partial columns (fail)',
            diag => qr{
                Missing:\s*Row\s*with\s*E-mail="dog\@example\.com"\s*
            }xms,
        );
        ok !$t->success, 'Test::Mojo success flag is set to false';

    };
};

done_testing;

__DATA__
@@ table_is.html.ep
<table id="mytable">
    % if ( !param 'noparts' ) {
    <thead>
    % }
        <tr>
            <th>User</th>
            <th>E-mail</th>
        </tr>
    % if ( !param 'noparts' ) {
    </thead>
    <tbody>
    % }
        <tr>
            <td>preaction</td>
            <td class="bg-primary"><a href="mailto:doug@example.com">doug@example.com</a></td>
        </tr>
        <tr>
            <td>inara</td>
            <td class="bg-primary"><a href="mailto:cat@example.com">cat@example.com</a></td>
        </tr>
    % if ( !param 'noparts' ) {
    </tbody>
    % }
</table>

