use strict;
use warnings;

use Test::More;
use Test::Exception;
use Parse::Method::Signatures;

my @sigs = (
    ['()',                      'empty signature'],
    ['($x)',                    'single required positional'],
    ['($x:)',                   'invocant only'],
    ['($x, $y)',                'two required positionals'],
    ['($x where { $_->isa("Moose") })',
                                'with constraint'],
    ['($x where { $_->isa("Moose") } where { $_->does("Gimble") })',
                                'multiple constraints'],
    ['(Str $name)',             'typed positional'],
    ['(Int $x, Str $y)',        'multiple typed positionals'],
    ['(Animal|Human $affe)',    'type constraint alternative'],
    ['(Some::Class $x)',        'type constraint with colon'],
    ['(Some2Class $x)',         'type constraint with number in middle'],
    ['(SomeClass2 $x)',         'type constraint with number at end'],
    ['(Tuple[Int,Str] $x)',     'parameterized types'],
    ['(Str|Tuple[Int,Str] $x)', 'parameterized with alternative'],
    ['($: $x, $y, $z)',         'dummy invocant'],
    ['($, $, $x)',              'dummy positionals'],
    ['($x, @)',                 'dummy list'],
    ['(:$x)',                   'optional named'],
    ['(:$x!)',                  'required named'],
    ['(Str :$x)',               'named with type constraint'],
    ['($x, $y, :$z)',           'positional and named'],
    ['($x, $y?, :$z)',          'optional positional and named'],
    ['(:$a, :$b, :$c)',         'multiple named'],
    ['($a, $b, :$c!, :$d!)',    'positional and multiple required named'],
    ['($a?, $b?, :$c, :$d)',    'optional positional and named'],
    ['(:$x! where { 1 })',      'required named with constraint'],
    ['($self: $moo)',           'invocant and positional'],
    ['(:apan($affe))',          'long named'], # called as $obj->foo(apan => $value)
    ['(:apan($affe)!)',         'required long named'],
    ['($self: :$x)',            'named param with invocant'],
    ['($: :$x)',                'named param with dummy invocant'],
    ['($x = 42)',               'positional with default'],
    ['(:$x = 42)',              'named with default'],
    ['($x = "foo")',            'simple string default'],
    ['($x = "foo, bar")',       'string default with comma'],
    ["(\$x = 'foo, bar')",      'single quoted default with comma'],
    ['($x = q"foo")',           'default with q"" quoting'],
    ['($x = q{foo})',           'default with q{} quoting'],
    ['($x = q(foo))',           'default with q() quoting'],
    ['($x = q,foo,)',           'default with q,, quoting'],
    ['($x, $y = $x)',           'default based on other paramter'],
    ['(Str :$who, Int :$age where { $_ > 0 })',
                                'complex with constraint'],
    ['(Str $name, Bool :$excited = 0)',
                                'complex with default'],
    [q#(SomeClass $thing where { $_->can('stuff') })#, 
                                'complex with constraint'],
    [q#(SomeClass $thing where { $_->can('stuff') }: Str $bar = "apan", Int :$baz = 42 where { $_ % 2 == 0 } where { $_ > 10 })#,
                                'complex invocant, defaults and constraints'],
    ['(@x)',                    'positional array'],
    ['($x, @y)',                'positinal scalar and array'],
    ['(%x)',                    'positinal hash'],
    ['($x, %y)',                'positinal scalar and hash'],
    ['([$x, $y])',              'simple array ref unpacking'],
    ['(ArrayRef [$x, $y])',     'simple array ref unpacking with unparameterized type', 'TODO'],
    ['(ArrayRef[] [$x, $y])',   'simple array ref unpacking with empty parameterized type',],
    ['([@x])',                  'array ref unpacking into array'],
    ['([$x, $y, @rest])',       'array ref unpacking into scalars and arrays'],
    ['($x, [$y, $z, @rest])',   'array ref unpacking combined with normal positionals'],
    ['([$y, $z, @rest], $x)',   'array ref unpacking combined with normal positionals'],
    ['([$y, $z, @rest], :$x)',  'array ref unpacking combined with named'],
    ['(:foo([$x, $y, @rest]))', 'named array ref unpacking'],
    ['({%x})',                  'hash ref unpacking into hash'],
    ['(:foo({%x}))',            'labeld hash ref unpacking into hash'],
    ['({:$x, :$y, %rest})',     'hash ref unpacking into scalars and hash'],
    ['($x, {:$y, :$z, %rest})', 'hash ref unpacking combined with normal positionals'],
    ['({:$y, :$z, %rest}, $x)', 'hash ref unpacking combined with normal positionals'],
    ['({:$x, :$y, %r}, :$z)',   'hash ref unpacking combined with named'],
    ['(:foo({:$x, :$y, %r}))',  'named hash ref unpacking'],
    ['(:foo($), :bar(@))',      'named placeholders'],
    ['(Foo[Bar|Baz[Moo]]|Kooh $foo)',
                                'complex parameterized type'],
    ['($foo is coerce)',        'positional with traits (is)'],
    ['($foo does coerce)',      'positional with traits (does)'],
    ['(:$foo is coerce)',       'named with traits (is)'],
    ['(:$foo does coerce)',     'named with traits (does)'],
    ['($foo is copy is ro does coerce)',
                                'multiple traits'],

    ['($x = "foo")',            'string default'],
    ['($x = q"fo)o")',          'string default'],
    ['($x = [ ])',              'simple array default'],
    ['($x = { })',              'simple hash default'],
    ['($x = 0xf)',              'hex default'],
    ['($x = 0xfF)',             'hex default'],
);

my @alternative = (
    [q{($param1, # Foo bar
        $param2?)},             '($param1, $param2?)',     'comments in multiline'],
    ['(:$x = "foo")',           '(:$x = "foo")',           'default value stringifies okay'],
    ['($self: $moo)',           '($self: $moo)',           'invocant and positional'],
    ['(Animal | Human $affe)',  '(Animal|Human $affe)',    'type constraint alternative with whitespace'],
    ['(HashRef[foo => Str] $foo)',
                                '(HashRef["foo",Str] $foo)', 'Hash with required key'],
);

my @invalid = (
    ['($x?:)',                  'optional invocant'],
    ['(@x:)',                   'non-scalar invocant'],
    ['(%x:)',                   'non-scalar invocant'],
    ['($x?, $y)',               'required positional after optional one'],
    ['(Int| $x)',               'invalid type alternation'],
    ['(|Int $x)',               'invalid type alternation'],
    ['(@x, $y)',                'scalar after array'],
    ['(@x, @y)',                'multiple arrays'],
    ['(%x, %y)',                'multiple hashes'],
    ['(@, $x)',                 'scalar after array placeholder'],
    ['(:@x)',                   'named array'],
    ['(:%x)',                   'named hash'],
    ['(:@)',                    'named array placeholder'],
    ['(:%)',                    'named hash placeholder'],
    ['(:[@x])',                 'named array ref unpacking without label'],
    ['([:$x, :$y])',            'unpacking array ref to something not positional'],
    ['(:{%x})',                 'named hash ref unpacking without label'],
    ['({$x, $y})',              'unpacking hash ref to something not named'],
    ['($foo where { 1, $bar)',  'unbalanced { in conditional'],
    ['($foo = `pwd`)',          'invalid quote op', "Do we want to allow this"],
    ['($foo = "pwd\')',         'unbalanced quotes'],
    ['(:$x:)',                  'named invocant is invalid'],
    ['($x! = "foo":)',          'default value for invocant is invalid'],
    ['($foo is bar moo is bo)', 'invalid traits'],
    ['(Foo:: Bar $foo)',        'invalid spaces in TC'],
    ['(Foo ::Bar $foo)',        'invalid spaces in TC'],
    ['(@y: $foo)',              'invalid invocant'],
    ['(@y,)',                   'trailing comma'],
    ['($x where [ foo ])',      'no block after where'],
    ['($x does $x)',            'invalid param trait'],
    ['(:foo(Str $x))',          'invalid label contents'],
    # This should probably be valid
    ['($x = $a[0])',            'invalid label contents'],
);

my @no_warn = (
    ['($x where { $_ =~ /foo/ })', 'Regexp without operator' ]
);

plan tests => scalar @sigs * 3 
            + scalar @alternative 
            + scalar @invalid
            + scalar @no_warn
;

test_sigs(sub {
    my ($input, $msg, $todo) = @_;
    my $sig;
    lives_ok {
        $sig = Parse::Method::Signatures->signature($input);
    } $msg;
    isa_ok($sig, 'Parse::Method::Signatures::Sig', $msg);
    TODO: {
        todo_skip $todo, 1 if $todo && !$sig;
        is($sig->to_string, $input, $msg);
    }
}, @sigs);

for my $row (@alternative) {
    my ($in, $out, $msg) = @{ $row };
    lives_and {
        is(Parse::Method::Signatures->signature($in)->to_string, $out, $msg)
    } $msg;
}

test_sigs(sub {
    my ($sig, $msg) = @_;
    dies_ok { Parse::Method::Signatures->signature($sig) } $msg;
}, @invalid);

test_no_warn(@no_warn);

sub test_sigs {
    my ($test, @sigs) = @_;

    for my $row (@sigs) {
        my ($sig, $msg, $todo) = @{ $row };
        TODO: {
            local $TODO = $todo if $todo;
            $test->($sig, $msg, $todo);
        }
    }
}

sub test_no_warn {
    my (@sigs) = @_;

    my $warnings = "";
    local $SIG{__WARN__} = sub { $warnings .= "@_"; };

    for my $row (@sigs) {
        my ($sig, $msg, $todo) = @{ $row };
        TODO: {
            $warnings = "";
            local $TODO = $todo if $todo;
            Parse::Method::Signatures->signature($sig);
            is("", $warnings, $msg || "'$sig' generated no warnings");
        }
    }
}