#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 25;
use Test::Exception;

use Perl6::MetaModel;

=pod

package Foo {
    my $bar;
    my @bar;
    my %bar;

    sub bar { ... }

    package Foo::Bar {}
}

=cut

{
    my $Foo = $::Package->new('$:name' => 'Foo');

    lives_ok {
        $Foo->STORE('$bar' => 1);
        $Foo->STORE('@bar' => [ 1, 2, 3 ]);
        $Foo->STORE('%bar' => { one => 1, two => 2 });
        $Foo->STORE('&bar' => sub { 'Foo::bar' });
        $Foo->STORE('::Bar' => $::Package->new('$:name' => 'Foo::Bar'));
    } '... stored values inside the pacakge';

    is($Foo->FETCH('$bar'), 1, '... got the SCALAR right');
    is_deeply($Foo->FETCH('@bar'), [ 1, 2, 3 ], '... got the ARRAY right');
    is_deeply($Foo->FETCH('%bar'), { one => 1, two => 2 }, '... got the HASH right');
    is($Foo->FETCH('&bar')->(), 'Foo::bar', '... got the CODE right');
    
    my $FooBar = $Foo->FETCH('::Bar');
    isa_ok($FooBar, 'Package');
    is($FooBar->name, 'Foo::Bar', '... got the sub package right');
}

# treat a class as a package

{
    my $Foo = class 'Foo' => {
        is => [ $::Object ],
        attributes => [ '$.bar', '@:baz' ],
        methods => {
            'bar' => sub { 'Foo::bar' }
        }
    };
    
    isa_ok($Foo->FETCH('$.bar'), 'Perl6::Attribute');
    isa_ok($Foo->FETCH('@:baz'), 'Perl6::Attribute');
    

    ok(!defined($Foo->FETCH('%:baz')), '... no attribute by that name here');
    
    my $bizzle = ::make_attribute('$.bizzle');
    lives_ok {
        $Foo->STORE('$.bizzle' => $bizzle);
    } '... we can add Perl6::Attributes though';
    isa_ok($Foo->FETCH('$.bizzle'), 'Perl6::Attribute');    
    is($Foo->FETCH('$.bizzle'), $bizzle, '... it is the same attribute we stored');        
      
    lives_ok {
        $Foo->STORE('&bizzle' => ::make_method(sub { _('$.bizzle') }));
    } '... make a bizzle accessor';
    
    is($Foo->new('$.bizzle' => 42)->bizzle(), 42, '... created and stored the attribute value');
    
    # now for the code ...
      
    is($Foo->FETCH('&bar')->($Foo->new()), 'Foo::bar', '... got the CODE right');  
    
    # check adding instance methods
    lives_ok {
        $Foo->STORE('&baz' => ::make_method(sub { 'Foo::baz' }));
    } '... did store a method object';
    is($Foo->FETCH('&baz')->($Foo->new()), 'Foo::baz', '... got the STORE-ed CODE right');  
    is($Foo->new()->baz(), 'Foo::baz', '... and we can call the method normally too');

    # check adding class methods     
    lives_ok {
        $Foo->STORE('&blarch' => ::make_class_method(sub { 'Foo::blarch' }));
    } '... did store a class method object';
    is($Foo->FETCH('&blarch')->($Foo), 'Foo::blarch', '... got the STORE-ed CODE right');  
    is($Foo->blarch(), 'Foo::blarch', '... and we can call the method normally too');     
     
    # now just store some misc. subs in the class namespace
    lives_ok {
        $Foo->STORE('&bling' => sub { 'Foo::bling' });
    } '... did store a plain-ole sub';
    is($Foo->FETCH('&bling')->(), 'Foo::bling', '... got the STORE-ed CODE right'); 
    dies_ok { $Foo->bling() } '... but you cannot call this as a method';
     
}