use v6-alpha;

use Test;

plan 40;

# This is first attempt at rationalizing the := form into a Siglist method call.
# The :() form constructs signatures similar to how \() constructs arguments.
# A subroutine's .signature is a Siglist object.

# Basic siglist binding --
#   $x    := 42;  # is sugar for
#   :($x) := 42;  # which in turn is sugar for
#   :($x).infix:<:=>(42);
{
    my $x;

    my $siglist = eval ':($x)';
    try { $siglist.infix:<:=>(42) };

    is($x, 42, "basic siglist binding works", :todo<feature>);
    dies_ok { $x++ }, "binding was really a binding, not an assignment", :todo<feature>;
}

{
    my ($x, $y, $z);
    my $siglist = eval ':($x,$y,$z)';
    try { $siglist.infix:<:=>(1,2,3) };
    is("$x $y $z", "1 2 3", "siglist bindings works", :todo<feature>);
}

# Same, but more complex 
{
    my ($x, @y, @rest);
    my $siglist = eval ':($x,@y,*@rest)';
    try { $siglist.infix:<:=>(42,[13,17],5,6,7) };
    is("$x!@y[]!@rest[]", "42!13 17!5 6 7", "complex siglist bindings works (1)", :todo<feature>);
}

{
    my ($x);
    my $siglist = eval ':($x?)';
    try { $siglist.infix:<:=>() };
    ok(try { !exists $x }, "complex siglist bindings works (2)", :todo<feature>);
}

# &sub.signature should return a Siglist object
{
    my sub foo ($a, $b) {}
    my $siglist = :($a, $b);

    ok $siglist,
        "a subroutine's siglist can be accessed via .signature (1-1)";
    cmp_ok $siglist, &infix:<===>, try {&foo.signature},
        "a subroutine's siglist can be accessed via .signature (1-2)", :todo<feature>;
}

# Same as above, but more complex
{
    my sub foo (Num $a, $b?, *@rest) {}
    my $siglist = :(Num $a, $b?, *@rest);

    cmp_ok $siglist, &infix:<===>, try { &foo.signature },
        "a subroutine's siglist can be accessed via .signature (2)", :todo<feature>;
}

{
    my sub foo ($a, $b) {}
    my $siglist = eval ':($a)';

    ok !($siglist === try { &foo.signature }),
        "a subroutine's siglist can be accessed via .signature (3)";
}

# User-customized binding
{
    my $x = 42;
    my $siglist = eval '(:($x)) but role {
        method infix:<:=> {
            # do nothing
        }
    }';

    try { $siglist.infix:<:=>(23) };
    is $x, 42,        "user-defined binding worked as expected (1)";
    lives_ok { $x++}, "user-defined binding worked as expected (2)";
}

# Signature values and pretty-printing
# L<S06/"Parameters and arguments">
{
    # let's start with valid signatures whose canonical stringy form looks
    # just like their source. I incidentally use different sigils, can't
    # throw in the complete cartesian product here...
    my @sigs =
        ( ':($x)',                'single required positional'
        , ':($x:)',               'invocant only'
        , ':(@x, $y)',            'two required positionals'
        , ':($x, %y?)',           'required and optional positionals'
        , ':($x is rw is ref is lazy is moose)', # note order matters :/
                                  'traits (including user defined)'
        , ':($x, $y, :$z)',       'positional and named'
        , ':($x, $y?, :$z)',      'optional positional and named'
        , ':(:$x)',               'required named'
        , ':(:$x?)',              'optional named'
        , ':(:short($long))',     'long named'
        , ':(:short($long)?)',    'optional long named'
        , ':($ : %x)',            'dummy invocant'
        , ':($x :($y))',          'unpacking(1)'
        , ':($x :($y: $z))',      'unpacking(2)'
        , # add more here.
        # We parse these correctly but don't pretty print them correctly yet.
        , ':($x = 42)',           'positional with default'
        , ':(@x = (1, 2))',       'positional array with default'
        , ':(%x = (1 => 2))',     'positional hash with default'
        , ':(:$x = 42)',          'named with default'
        , ':(:@x = (1, 2))',      'named array with default'
        , ':(:%x = (1 => 2))',    'named hash with default'
        , ':(:x($y) = 42)',       'longnamed with default'
        , ':(:x(@y) = (1, 2))',   'longnamed array with default'
        , ':(:x(%y) = (1 => 2))', 'longnamed hash with default'
        );
    for @sigs -> $sig, $desc {
        is eval("my \$s = $sig; qq[\$s]"), $sig, "signature stringifies - $desc";
    }

    # ("" ~ :() is just an interim hack to dispatch into pretty-newval. will be removed.)
    # canonized version is different from source
    is eval('""~:($x!)'),          ':($x)',      'required positional with hint';
    is eval('""~:($x? = 42)'),     ':($x = 42)', 'positional with default and hint';
    is eval('""~:(@y? = (1, 2))'), ':(@y = (1, 2))',
                                                'named array with default and hint';

    is eval('""~:($x is rw is ro is rw is copy is ro is rw)'),
                                ':($x is rw)',  'last repeated trait wins'; # XXX: spec
    is eval('""~:($x is moose is ref is ro is lazy)'), # 'is ro' is default thus not printed
                                ':($x is ref is lazy is moose)',
                                'interleaved traits'; # XXX spec this minor point?


    # should die
    eval_dies_ok ':($x! = 42)', "required params can't have a default";
}