use Mojo::Base -strict;

use Test::More;
use Mojo::Exception qw(check raise);
use Mojo::File      qw(curfile);

package MojoTest::X::Foo;
use Mojo::Base 'Mojo::Exception';

package MojoTest::X::Bar;
use Mojo::Base 'Mojo::Exception';

package MojoTest::X::Yada;
use Mojo::Base 'MojoTest::X::Bar';

package main;

subtest 'Verbose' => sub {
  ok(!Mojo::Exception->new->verbose, 'not verbose');
  local $ENV{MOJO_EXCEPTION_VERBOSE} = 1;
  ok(Mojo::Exception->new->verbose, 'verbose');
};

subtest 'Basics' => sub {
  my $e = Mojo::Exception->new;
  is $e->message, 'Exception!',   'right message';
  is "$e",        "Exception!\n", 'right message';
  $e = Mojo::Exception->new('Test!');
  is $e->message, 'Test!',   'right message';
  is "$e",        "Test!\n", 'right message';
};

subtest 'Context information' => sub {
  my $line = __LINE__;
  eval {

    # test

    my $wrapper = sub { Mojo::Exception->throw('Works!') };
    $wrapper->();

    # test

  };
  my $e = $@;
  isa_ok $e, 'Mojo::Exception', 'right class';
  like $e->inspect,        qr/^Works!/,      'right result';
  like $e->frames->[0][1], qr/exception\.t/, 'right file';
  is $e->lines_before->[0][0], $line,                    'right number';
  is $e->lines_before->[0][1], '  my $line = __LINE__;', 'right line';
  is $e->lines_before->[1][0], $line + 1,                'right number';
  is $e->lines_before->[1][1], '  eval {',               'right line';
  is $e->lines_before->[2][0], $line + 2,                'right number';
  ok !$e->lines_before->[2][1], '  empty line';
  is $e->lines_before->[3][0], $line + 3,    'right number';
  is $e->lines_before->[3][1], '    # test', 'right line';
  is $e->lines_before->[4][0], $line + 4,    'right number';
  ok !$e->lines_before->[4][1], 'empty line';
  is $e->line->[0],           $line + 5,                                                      'right number';
  is $e->line->[1],           "    my \$wrapper = sub { Mojo::Exception->throw('Works!') };", 'right line';
  is $e->lines_after->[0][0], $line + 6,                                                      'right number';
  is $e->lines_after->[0][1], '    $wrapper->();',                                            'right line';
  is $e->lines_after->[1][0], $line + 7,                                                      'right number';
  ok !$e->lines_after->[1][1], 'empty line';
  is $e->lines_after->[2][0], $line + 8,    'right number';
  is $e->lines_after->[2][1], '    # test', 'right line';
  is $e->lines_after->[3][0], $line + 9,    'right number';
  ok !$e->lines_after->[3][1], 'empty line';
  is $e->lines_after->[4][0], $line + 10, 'right number';
  is $e->lines_after->[4][1], '  };',     'right line';
};

subtest 'Trace' => sub {
  sub wrapper2 { Mojo::Exception->new->trace(@_) }
  sub wrapper1 { wrapper2(@_) }
  like wrapper1()->frames->[0][3],  qr/wrapper2/, 'right subroutine';
  like wrapper1(0)->frames->[0][3], qr/trace/,    'right subroutine';
  like wrapper1(1)->frames->[0][3], qr/wrapper2/, 'right subroutine';
  like wrapper1(2)->frames->[0][3], qr/wrapper1/, 'right subroutine';
};

subtest 'Inspect (UTF-8)' => sub {
  my $file = curfile->sibling('exception', 'utf8.txt');
  my $e    = Mojo::Exception->new("Whatever at $file line 3.");
  is_deeply $e->lines_before, [], 'no lines';
  is_deeply $e->line,         [], 'no line';
  is_deeply $e->lines_after,  [], 'no lines';
  $e->inspect;
  is_deeply $e->lines_before->[-1], [2, 'use warnings;'], 'right line';
  is_deeply $e->line,               [3, 'use utf8;'],     'right line';
  is_deeply $e->lines_after->[0],   [4, ''],              'right line';

  $e = Mojo::Exception->new("Died at $file line 4.")->inspect;
  is_deeply $e->lines_before->[-1], [3, 'use utf8;'],               'right line';
  is_deeply $e->line,               [4, ''],                        'right line';
  is_deeply $e->lines_after->[0],   [5, "my \$s = 'Über•résumé';"], 'right line';

  $file = $file->sibling('non_utf8.txt');
  $e    = Mojo::Exception->new("Whatever at $file line 3.");
  is_deeply $e->lines_before, [], 'no lines';
  is_deeply $e->line,         [], 'no line';
  is_deeply $e->lines_after,  [], 'no lines';
  $e->inspect->inspect;
  is_deeply $e->lines_before->[-1], [2, 'use warnings;'], 'right line';
  is_deeply $e->line,               [3, 'no utf8;'],      'right line';
  is_deeply $e->lines_after->[0],   [4, ''],              'right line';
  $e = Mojo::Exception->new("Died at $file line 4.")->inspect;
  is_deeply $e->lines_before->[-1], [3, 'no utf8;'],                            'right line';
  is_deeply $e->line,               [4, ''],                                    'right line';
  is_deeply $e->lines_after->[0],   [5, "my \$s = '\xDCber\x95r\xE9sum\xE9';"], 'right line';
};

subtest 'Context' => sub {
  my $e = Mojo::Exception->new;
  is $e, "Exception!\n", 'right result';
  $e = Mojo::Exception->new->inspect->inspect;
  is $e, "Exception!\n", 'right result';
  $e = Mojo::Exception->new('Test!');
  $e->frames(
    [
      ['Sandbox',     'template',      4, 'Sandbox::sub'],
      ['MyApp::Test', 'MyApp/Test.pm', 3, 'MyApp::Test::sub'],
      ['main',        'foo.pl',        4, 'main::sub'],
    ],
  );
  $e->lines_before([[3, 'foo();']])->line([4, 'die;'])->lines_after([[5, 'bar();']]);
  is $e,             "Test! at template line 4.\n", 'right result';
  is $e->verbose(1), <<EOF,                         'right result';
Test! at template line 4.
Context:
  3: foo();
  4: die;
  5: bar();
Traceback (most recent call first):
  File "template", line 4, in "Sandbox::sub"
  File "MyApp/Test.pm", line 3, in "MyApp::Test::sub"
  File "foo.pl", line 4, in "main::sub"
EOF
  $e->message("Works!\n")->lines_before([])->lines_after([]);
  is $e, <<EOF, 'right result';
Works!
Context:
  4: die;
Traceback (most recent call first):
  File "template", line 4, in "Sandbox::sub"
  File "MyApp/Test.pm", line 3, in "MyApp::Test::sub"
  File "foo.pl", line 4, in "main::sub"
EOF
};

subtest 'Traceback (real frames)' => sub {
  sub mock_frames { frame_level2(@_) }

  sub frame_level2 {
    my ($e) = @_;
    $e->trace;
    @{$e->frames} = grep { $_->[1] =~ m/^t/ } @{$e->frames};
  }

  my $e                  = Mojo::Exception->new;
  my @frames             = mock_frames($e);
  my $expected_backtrace = join "\n", map {qq(  File "$_->[1]", line $_->[2], in "$_->[3]")} @frames;

  is $e->verbose(1), <<"EOF", 'right result';
Exception! at $frames[0][1] line $frames[0][2].
Traceback (most recent call first):
$expected_backtrace
EOF
};

subtest 'Missing error' => sub {
  my $e = Mojo::Exception->new->inspect;
  is_deeply $e->lines_before, [], 'no lines';
  is_deeply $e->line,         [], 'no line';
  is_deeply $e->lines_after,  [], 'no lines';
  is $e->message, 'Exception!', 'right message';

  $e = Mojo::Exception->new(undef)->inspect;
  is_deeply $e->lines_before, [], 'no lines';
  is_deeply $e->line,         [], 'no line';
  is_deeply $e->lines_after,  [], 'no lines';
  is $e->message, 'Exception!', 'right message';

  $e = Mojo::Exception->new('')->inspect;
  is_deeply $e->lines_before, [], 'no lines';
  is_deeply $e->line,         [], 'no line';
  is_deeply $e->lines_after,  [], 'no lines';
  is $e->message, '', 'right message';
};

subtest 'Check (string exception)' => sub {
  my $result;
  eval { die "test1\n" };
  ok check($@ => [default => sub { $result = $_ }]), 'exception handled';
  is $result, "test1\n", 'exception arrived in handler';
  $result = undef;
  eval { die "test2\n" };
  ok check($@ => [default => sub { $result = shift }]), 'exception handled';
  is $result, "test2\n", 'exception arrived in handler';
  $result = undef;
  eval { die "test3\n" };
  check $@ => [
    default    => sub { $result = 'fail' },
    qr/^test2/ => sub { $result = 'fail' },
    qr/^test3/ => sub { $result = 'test10' },
    qr/^test4/ => sub { $result = 'fail' }
  ];
  is $result, 'test10', 'regular expression matched';
  $result = undef;
  check "test4\n" => [
    qr/^test3/ => sub { $result = 'fail' },
    qr/^test4/ => sub { $result = 'test11' },
    qr/^test5/ => sub { $result = 'fail' }
  ];
  is $result, 'test11', 'regular expression matched';
};

subtest 'Check (exception objects)' => sub {
  my $result;
  eval { MojoTest::X::Foo->throw('fail') };
  check $@ => [
    default            => sub { $result = 'fail' },
    'MojoTest::X::Foo' => sub { $result = 'test12' },
    'MojoTest::X::Bar' => sub { $result = 'fail' }
  ];
  is $result, 'test12', 'class matched';
  $result = undef;
  eval { MojoTest::X::Bar->throw('fail') };
  check $@ => ['MojoTest::X::Foo' => sub { $result = 'fail' }, 'MojoTest::X::Bar' => sub { $result = 'test13' }];
  is $result, 'test13', 'class matched';
  $result = undef;
  check(
    MojoTest::X::Yada->new('fail') => [
      qr/^MojoTest/      => sub { $result = 'fail' },
      'MojoTest::X::Foo' => sub { $result = 'fail' },
      'MojoTest::X::Bar' => sub { $result = 'test14' }
    ]
  );
  is $result, 'test14', 'class matched';
  $result = undef;
  check(MojoTest::X::Yada->new('whatever') =>
      ['MojoTest::X::Foo' => sub { $result = 'fail' }, qr/^whatever/ => sub { $result = 'test23' }]);
  is $result, 'test23', 'regex matched';
};

subtest 'Check (multiple)' => sub {
  my $result = undef;
  check(MojoTest::X::Yada->new('whatever') =>
      [['MojoTest::X::Foo', 'MojoTest::X::Bar'] => sub { $result = 'test15' }, default => sub { $result = 'fail' }]);
  is $result, 'test15', 'class matched';
  $result = undef;
  check(
    MojoTest::X::Bar->new('whatever') => [
      ['MojoTest::X::Foo', 'MojoTest::X::Yada'] => sub { $result = 'fail' },
      ['MojoTest::X::Bar']                      => sub { $result = 'test16' }
    ]
  );
  is $result, 'test16', 'class matched';
};

subtest 'Check (rethrow)' => sub {
  eval {
    check "test5\n" => [qr/test4/ => sub { die 'fail' }];
  };
  is $@, "test5\n", 'exception has been rethrown';
};

subtest 'Check (nothing)' => sub {
  ok !check(undef() => [default => sub { die 'fail' }]), 'no exception';
  {
    local $@;
    ok !check($@ => [default => sub { die 'fail' }]), 'no exception';
  }
};

subtest 'Check (bad spec)' => sub {
  eval {
    check test => {
      default => sub { }
    };
  };
  like $@, qr/Array reference of pattern\/handler pairs required to dispatch exceptions/, 'right error';

  eval { check test => ['default']; };
  like $@, qr/Array reference of pattern\/handler pairs required to dispatch exceptions/, 'right error';
};

subtest 'Raise' => sub {
  eval { raise 'MyApp::X::Baz', 'test19' };
  my $err = $@;
  isa_ok $err, 'MyApp::X::Baz',   'is a MyApp::X::Baz';
  isa_ok $err, 'Mojo::Exception', 'is a Mojo::Exception';
  like $err, qr/^test19/, 'right error';
  eval { raise 'MyApp::X::Baz', 'test20' };
  $err = $@;
  isa_ok $err, 'MyApp::X::Baz',   'is a MyApp::X::Baz';
  isa_ok $err, 'Mojo::Exception', 'is a Mojo::Exception';
  like $err, qr/^test20/, 'right error again';
  eval { raise 'test22' };
  $err = $@;
  isa_ok $err, 'Mojo::Exception', 'is a Mojo::Exception';
  like $err, qr/^test22/, 'right error';
  eval { raise 'MojoTest::X::Foo', 'test21' };
  $err = $@;
  isa_ok $err, 'MojoTest::X::Foo', 'is a MojoTest::X::Baz';
  like $err, qr/^test21/, 'right error';
  eval { raise 'Mojo::Base', 'fail' };
  like $@, qr/^Mojo::Base is not a Mojo::Exception subclass/, 'right error';
};

done_testing();
