The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More tests => 43;
use Test::Differences;
use Test::Moose;
use MooseX::Types::Structured qw/Dict/;

use Parse::Method::Signatures;

use aliased 'Parse::Method::Signatures::Param';

BEGIN {
    eval "use aliased 'Parse::Method::Signatures::Param::${_}'"
        for qw/Named Positional Bindable Placeholder/;

    eval "use aliased 'Parse::Method::Signatures::Param::Unpacked::${_}' => 'Unpacked${_}'"
        for qw/Array Hash/;
}

{
    my $sig = Parse::Method::Signatures->signature('(Str $name)');

    ok(!$sig->has_named_params);
    ok($sig->has_positional_params);
    is(scalar @{ $sig->positional_params }, 1);

    my ($param) = $sig->positional_params;
    isa_ok($param, Param);
    ok($param->has_type_constraints);
    #is($param->type_constraints->data, 'Str');
    is($param->variable_name, '$name');
    ok($param->required);
    ok(!$param->has_constraints);

    does_ok($param, $_) for Positional, Bindable;

    my $tc = $param->meta_type_constraint;
    isa_ok($tc, 'Moose::Meta::TypeConstraint');
    is($tc->name, 'Str');
}
{
    my $sig = Parse::Method::Signatures->signature('(Str :$who, Int :$age where { $_ > 0 })');

    ok(!$sig->has_positional_params);
    ok($sig->has_named_params);
    is(scalar @{ $sig->named_params }, 2);

    my @params = $sig->named_params;
    isa_ok($_, Param) for @params;
    for my $param (@params) {
        does_ok($param, $_) for Named, Bindable;
    }

    my ($who, $age) = @params;
    #is($who->type_constraints->data, 'Str');
    is($who->variable_name, '$who');
    ok(!$who->required);
    ok(!$who->has_constraints);
    my $tc = $who->meta_type_constraint;
    isa_ok($tc, 'Moose::Meta::TypeConstraint');
    is($tc->name, 'Str');

    #is($age->type_constraints->data, 'Int');
    is($age->variable_name, '$age');
    ok(!$age->required);
    ok($age->has_constraints);
    is_deeply([$age->constraints], ['{ $_ > 0 }']);
    $tc = $age->meta_type_constraint;
    isa_ok($tc, 'Moose::Meta::TypeConstraint');
    is($tc->name, 'Int');
}

{
    my $sig = Parse::Method::Signatures->signature('($, $foo, $)');

    ok($sig->has_positional_params);
    ok(!$sig->has_named_params);
    is(scalar @{ $sig->positional_params }, 3);

    does_ok($sig->positional_params->[0], Placeholder);
    does_ok($sig->positional_params->[2], Placeholder);
}

{
    my $type = 'HashRef[ArrayRef[Moo]|Str]|Num';
    my $param = Parse::Method::Signatures->param("${type} \$foo");

    my $tc = $param->meta_type_constraint;
    isa_ok($tc, 'Moose::Meta::TypeConstraint');
    is($tc->name, $type);
}

{
    my $param = Parse::Method::Signatures->param(
        input => 'Dict[foo => Int] $foo',
        type_constraint_callback => sub {
            my ($tc, $name) = @_;
            return Dict if $name eq 'Dict';
            return $tc->find_registered_constraint($name);
        },
    );
    my $tc = $param->meta_type_constraint;
    is($tc->name, 'MooseX::Types::Structured::Dict[foo,Int]');
    ok($tc->check({foo => 2}), "TC behaves right");
    ok(!$tc->check({foo => "str"}), "TC behaves right");
    ok(!$tc->check({Foo => "str"}), "TC behaves right");
}

=for later

eq_or_diff( 
  scalar Parse::Method::Signatures->signature('(Str $name, Bool :$excited = 0)'),
  { params => [
      { tc => 'Str',
        var => '$name',
      },
      { tc => 'Bool',
        var => '$excited',
        named => 1,
        default => '0'
      },
    ]
  },
);

eq_or_diff(
  scalar Parse::Method::Signatures->signature('(Animal|Human $affe)'),
  { params => [
      { tc => 'Animal|Human',
        var => '$affe'
      },
    ]
  },
);

eq_or_diff(
  scalar Parse::Method::Signatures->signature('(:$a, :$b, :$c)'),
  { params => [
      { var => '$a',
        named => 1
      },
      { var => '$b',
        named => 1
      },
      { var => '$c',
        named => 1
      },
    ]
  },
);

eq_or_diff( 
  scalar Parse::Method::Signatures->signature('( $a,  $b, :$c)'),
  { params => [
      { var => '$a' },
      { var => '$b' },
      { var => '$c',
        named => 1
      },
    ]
  },
);

eq_or_diff( 
  scalar Parse::Method::Signatures->signature('($a , $b!, :$c!, :$d!)'),
  { params => [
      { var => '$a' },
      { var => '$b',
        required => 1
      },
      { var => '$c',
        named => 1,
        required => 1
      },
      { var => '$d',
        named => 1,
        required => 1
      },
    ]
  },
);

eq_or_diff( 
  scalar Parse::Method::Signatures->signature('($a?, $b?, :$c , :$d?)'),
  { params => [
      { var => '$a',
        optional => 1
      },
      { var => '$b',
        optional => 1
      },
      { var => '$c',
        named => 1,
      },
      { var => '$d',
        named => 1,
        optional => 1
      },
    ]
  },
);

eq_or_diff(
  scalar Parse::Method::Signatures->signature('($self:  $moo)'),
  { params => [
      { var => '$moo' }
    ],
    invocant => {
      var => '$self'
    }
  },
);

# TODO: Should this have a empty invocant struct?
eq_or_diff(
  scalar Parse::Method::Signatures->signature('(:     $affe ) # called as $obj->foo(affe => $value)'),
  { params => [
      { var => '$affe',
        named => 1
      }
    ]
  }, 
);

eq_or_diff(
  scalar Parse::Method::Signatures->signature('(:apan($affe)) # called as $obj->foo(apan => $value)'),
  { params => [
      { label => 'apan',
        var => '$affe',
        named => 1
      }
    ]
  },
);

eq_or_diff(
  scalar Parse::Method::Signatures->signature(q#(SomeClass $thing where { $_->can('stuff') }:
Str  $bar  = "apan"
Int :$baz! = 42 where { $_ % 2 == 0 } where { $_ > 10 })#),
  { params => [
      { tc => 'Str',
        var => '$bar',
        default => '"apan"'
      },
      { tc => 'Int',
        var => '$baz',
        named => 1,
        required => 1,
        where => [
          '{ $_ % 2 == 0 }',
          '{ $_ > 10 }'
        ],
        default => '42'
      }
    ],
    invocant => {
      tc => 'SomeClass',
      var => '$thing',
      where => [
        '{ $_->can(\'stuff\') }'
      ]
    }
  },
);


eq_or_diff(
  [ Parse::Method::Signatures->signature('(Str $name)') ],
  [ { params => [
      { tc => 'Str',
        var => '$name',
      }
    ]
  }, ''],
);

eq_or_diff(
  [ Parse::Method::Signatures->signature('(Str $name) further data }') ],
  [ { params => [
      { tc => 'Str',
        var => '$name',
      }
    ]
  }, 'further data }'],
);


eq_or_diff(
  [ Parse::Method::Signatures->param(
      input => 'previous data(Str $name) further data }',
      offset => 14) ],
  [ { tc => 'Str',
      var => '$name',
    },
    ') further data }'],
);
eq_or_diff(
  [ Parse::Method::Signatures->param(
      input => 'Str $name) further data }',
    ) ],
  [ { tc => 'Str',
      var => '$name',
    },
    ') further data }'],
);

eq_or_diff(
  [ Parse::Method::Signatures->signature( "(\$param1 # Foo bar\n \$param2) postfix") ],
  [ { params => [
      { var => '$param1' },
      { var => '$param2' },
    ] },
    'postfix'
  ]
);