The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use warnings;
use strict;
use Test::More tests => 26;
use Test::Exception;

BEGIN {
    require_ok 'MooseX::AttributeInflate';
}

{
    package MyClass::Document;
    use Moose;

    has 'text' => (is => 'ro', isa => 'Str', default => 'O Hai');

    package MyClass;
    use Moose;
    use MooseX::AttributeInflate;

    has 'document' => (
        is => 'ro', isa => 'MyClass::Document',
        traits => [qw/Inflated/],
    );
}

happy_path: {
    my $o = MyClass->new();
    my $doc;
    lives_ok {
        $doc = $o->document;
    } 'got doc';
    isa_ok $doc => 'MyClass::Document';
    is $doc->text, 'O Hai';
}

{
    package MyClass2;
    use Moose;
    use MooseX::AttributeInflate;
    extends 'MyClass';

    has '+document' => (
        inflate_args => [text => 'Yup']
    );
}

construct_args: {
    my $o = MyClass2->new;
    my $doc;
    lives_ok {
        $doc = $o->document;
    } 'got doc';
    isa_ok $doc => 'MyClass::Document';
    is $doc->text, 'Yup';
}

{
    package NonMoose;
    use strict;

    sub buildit {
        my $class = shift;
        return bless [@_], $class;
    }

    package MyClass3;
    use Moose;
    use MooseX::AttributeInflate;
    extends 'MyClass';

    has '+document' => (
        isa => 'NonMoose',
        inflate_method => 'buildit',
        inflate_args => [qw(here it is)]
    );
}

construct_method: {
    my $o = MyClass3->new;
    my $doc;
    lives_ok {
        $doc = $o->document;
    } 'got doc';
    isa_ok $doc => 'NonMoose';
    is_deeply $doc, [qw(here it is)];
}

non_object: throws_ok {
    package WTF;
    use Moose;
    use MooseX::AttributeInflate;

    has 'name' => (
        is => 'rw', isa => 'Str',
        traits => [qw/Inflated/],
    );
} qr/subtype of Object/, "can't inflate a non-Object";

is_object: throws_ok {
    package WTF;
    use Moose;
    use MooseX::AttributeInflate;

    has 'name' => (
        is => 'rw', isa => 'Object',
        traits => [qw/Inflated/],
    );
} qr/subtype of Object/, "can't inflate a direct Object";


{
    package MyLazyClass;
    use Moose;
    use MooseX::AttributeInflate;

    has 'doc1' => (
        is => 'ro', isa => 'MyClass::Document',
        traits => [qw/Inflated/],
        lazy_build => 1,
        default => sub { die 'should be overriden' },
    );
    has 'doc2' => (
        is => 'ro', isa => 'MyClass::Document',
        traits => [qw/Inflated/],
        lazy_build => 1,
        predicate => 'gots_doc2',
        clearer => 'scrub_doc2',
    );
}

lazy_build: {
    my $o = MyLazyClass->new;

    isa_ok $o => 'MyLazyClass', 'created MyLazyClass';
    ok $o->can('has_doc1'), 'standard predicate installed';
    ok $o->can('clear_doc1'), 'standard clearer installed';
    ok !$o->has_doc1;
    lives_ok { $o->doc1 } 'overrode the default';
    ok $o->doc1;
    ok $o->has_doc1;
    $o->clear_doc1;
    ok !$o->has_doc1, 'std clearer/predicate work';

    ok $o->can('gots_doc2'), 'alt predicate installed';
    ok $o->can('scrub_doc2'), 'alt clearer installed';
    ok !$o->gots_doc2;
    ok $o->doc2->text;
    ok $o->gots_doc2;
    $o->scrub_doc2;
    ok !$o->gots_doc2, 'alt clearer/predicate work';
}