#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Moose;
use Test::Exception;

use KiokuDB::TypeMap;
use KiokuDB::TypeMap::Entry::Alias;
use KiokuDB::TypeMap::Entry::Naive;

{
    package KiokuDB_Test_Foo;
    use Moose;

    package KiokuDB_Test_Bar;
    use Moose;

    extends qw(KiokuDB_Test_Foo);

    package KiokuDB_Test_CA;

    package KiokuDB_Test_CA::Sub;
    use base qw(KiokuDB_Test_CA);
}

{
    my $n = KiokuDB::TypeMap::Entry::Naive->new;

    isa_ok( $n, "KiokuDB::TypeMap::Entry::Naive" );
    does_ok( $n, "KiokuDB::TypeMap::Entry" );

    my $t = KiokuDB::TypeMap->new(
        entries => {
            KiokuDB_Test_CA => $n,
        }
    );

    isa_ok( $t, "KiokuDB::TypeMap" );

    is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve regular entry" );
    is( $t->resolve("KiokuDB_Test_CA::Sub"), undef, "failed resolution of subclass" );
    is( $t->resolve("KiokuDB_Test_Foo"), undef, "failed resolution of unspecified class" );
    is( $t->resolve("Blarfla"), undef, "failed resolution of random string" );
}

{
    my $n = KiokuDB::TypeMap::Entry::Naive->new;

    my $a = KiokuDB::TypeMap::Entry::Alias->new( to => "KiokuDB_Test_CA" );

    isa_ok( $a, "KiokuDB::TypeMap::Entry::Alias" );
    ok( !$a->does("KiokuDB::TypeMap::Entry"), "alias is not a real type entry" );

    my $t = KiokuDB::TypeMap->new(
        entries => {
            KiokuDB_Test_CA => $n,
            KiokuDB_Test_Foo => $a,
        }
    );

    isa_ok( $t, "KiokuDB::TypeMap" );

    is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve regular entry" );
    is( $t->resolve("KiokuDB_Test_CA::Sub"), undef, "failed resolution of subclass" );
    is( $t->resolve("KiokuDB_Test_Foo"), $n, "alias resolution" );
    is( $t->resolve("Blarfla"), undef, "failed resolution of random string" );
}

{
    my $n = KiokuDB::TypeMap::Entry::Naive->new;

    my $t = KiokuDB::TypeMap->new(
        isa_entries => {
            KiokuDB_Test_CA => $n,
        }
    );

    isa_ok( $t, "KiokuDB::TypeMap" );

    is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve isa entry for base class" );
    is( $t->resolve("KiokuDB_Test_CA::Sub"), $n, "resolve isa entry for subclass" );
    is( $t->resolve("KiokuDB_Test_Foo"), undef, "failed resolution" );
}

{
    my $n = KiokuDB::TypeMap::Entry::Naive->new;

    my $t = KiokuDB::TypeMap->new(
        isa_entries => {
            KiokuDB_Test_CA => $n,
            KiokuDB_Test_Foo => KiokuDB::TypeMap::Entry::Alias->new( to => "KiokuDB_Test_CA" ),
        },
        entries => {
            'Unknown::KiokuDB_Test_Foo' => KiokuDB::TypeMap::Entry::Alias->new( to => "KiokuDB_Test_CA" ),
        },
    );

    isa_ok( $t, "KiokuDB::TypeMap" );

    is( $t->resolve("KiokuDB_Test_CA"), $n, "resolve isa entry for base class" );
    is( $t->resolve("KiokuDB_Test_CA::Sub"), $n, "resolve isa entry for subclass" );
    is( $t->resolve("KiokuDB_Test_Foo"), $n, "alias resolution of isa entry" );
    is( $t->resolve("KiokuDB_Test_Bar"), $n, "alias resolution of isa entry" );
    is( $t->resolve("Blarfla"), undef, "failed resolution of random string" );
    is( $t->resolve("Unknown::KiokuDB_Test_Foo"), $n, "alias to isa entry" );
}

{
    # typemap inheritence

    my $ca = KiokuDB::TypeMap::Entry::Naive->new;
    my $foo = KiokuDB::TypeMap::Entry::Naive->new;

    my $t1 = KiokuDB::TypeMap->new(
        includes => [
            KiokuDB::TypeMap->new(
                entries => {
                    'KiokuDB_Test_CA' => $ca,
                },
            ),
        ],
        entries => {
            'KiokuDB_Test_Foo' => $foo,
        }
    );

    my $t2 = KiokuDB::TypeMap->new(
        entries => {
            'KiokuDB_Test_CA' => $ca,
        },
        includes => [
            KiokuDB::TypeMap->new(
                entries => {
                    'KiokuDB_Test_Foo' => $foo,
                }
            ),
        ],
    );

    my $t3 = KiokuDB::TypeMap->new(
        includes => [
            KiokuDB::TypeMap->new(
                entries => {
                    'KiokuDB_Test_CA' => $ca,
                },
            ),
            KiokuDB::TypeMap->new(
                entries => {
                    'KiokuDB_Test_Foo' => $foo,
                }
            ),
        ],
    );

    my @desc = ( "inherit KiokuDB_Test_CA", "inherit KiokuDB_Test_Foo", "inherit both" );
    foreach my $t ( $t1, $t2, $t3 ) {
        my $desc = "(". shift(@desc) . ")";

        isa_ok( $t, "KiokuDB::TypeMap" );

        is( $t->resolve("KiokuDB_Test_CA"), $ca, "resolve KiokuDB_Test_CA entry $desc" );
        is( $t->resolve("KiokuDB_Test_Foo"), $foo, "resolve KiokuDB_Test_Foo entry $desc" );
        is( $t->resolve("KiokuDB_Test_CA::Sub"), undef, "failed resolution $desc" );
        is( $t->resolve("KiokuDB_Test_Bar"), undef, "failed resolution $desc" );
    }
}

{
    # typemap inheritence of isa types

    my $ca = KiokuDB::TypeMap::Entry::Naive->new;
    my $foo = KiokuDB::TypeMap::Entry::Naive->new;

    my $t1 = KiokuDB::TypeMap->new(
        includes => [
            KiokuDB::TypeMap->new(
                isa_entries => {
                    'KiokuDB_Test_CA' => $ca,
                },
            ),
        ],
        isa_entries => {
            'KiokuDB_Test_Foo' => $foo,
        }
    );

    my $t2 = KiokuDB::TypeMap->new(
        isa_entries => {
            'KiokuDB_Test_CA' => $ca,
        },
        includes => [
            KiokuDB::TypeMap->new(
                isa_entries => {
                    'KiokuDB_Test_Foo' => $foo,
                }
            ),
        ],
    );

    my $t3 = KiokuDB::TypeMap->new(
        includes => [
            KiokuDB::TypeMap->new(
                isa_entries => {
                    'KiokuDB_Test_CA' => $ca,
                },
            ),
            KiokuDB::TypeMap->new(
                isa_entries => {
                    'KiokuDB_Test_Foo' => $foo,
                }
            ),
        ],
    );

    my @desc = ( "inherit KiokuDB_Test_CA", "inherit KiokuDB_Test_Foo", "inherit both" );
    foreach my $t ( $t1, $t2, $t3 ) {
        my $desc = "(". shift(@desc) . ")";

        isa_ok( $t, "KiokuDB::TypeMap" );

        is_deeply(
            [ sort @{ $t->all_isa_entry_classes } ],
            [ qw(KiokuDB_Test_CA KiokuDB_Test_Foo) ],
            "isa entry classes"
        );

        is( $t->resolve("KiokuDB_Test_CA"), $ca, "resolve KiokuDB_Test_CA entry $desc" );
        is( $t->resolve("KiokuDB_Test_Foo"), $foo, "resolve KiokuDB_Test_Foo entry $desc" );
        is( $t->resolve("KiokuDB_Test_CA::Sub"), $ca, "resolve KiokuDB_Test_CA entry for subclass $desc" );
        is( $t->resolve("KiokuDB_Test_Bar"), $foo, "resolve KiokuDB_Test_Foo entry for subclass $desc" );
    }
}

{
    # typemap conflicts

    my $ca = KiokuDB::TypeMap::Entry::Naive->new;

    throws_ok {
        KiokuDB::TypeMap->new(
            entries => {
                'KiokuDB_Test_CA' => $ca,
            },
            isa_entries => {
                'KiokuDB_Test_CA' => $ca,
            }
        );
    } qr/\bKiokuDB_Test_CA\b/, "regular conflicting with isa entry";

}

{
    # typemap inheritence conflicts

    my $ca = KiokuDB::TypeMap::Entry::Naive->new;

    throws_ok {
        KiokuDB::TypeMap->new(
            includes => [
                KiokuDB::TypeMap->new(
                    entries => {
                        'KiokuDB_Test_CA' => $ca,
                    },
                ),
                KiokuDB::TypeMap->new(
                    entries => {
                        'KiokuDB_Test_CA' => $ca,
                    }
                ),
            ],
        );
    } qr/\bKiokuDB_Test_CA\b/, "regular entry conflict";

    throws_ok {
        KiokuDB::TypeMap->new(
            includes => [
                KiokuDB::TypeMap->new(
                    isa_entries => {
                        'KiokuDB_Test_CA' => $ca,
                    },
                ),
                KiokuDB::TypeMap->new(
                    isa_entries => {
                        'KiokuDB_Test_CA' => $ca,
                    }
                ),
            ],
        );
    } qr/\bKiokuDB_Test_CA\b/, "isa entry conflict";

    throws_ok {
        KiokuDB::TypeMap->new(
            includes => [
                KiokuDB::TypeMap->new(
                    isa_entries => {
                        'KiokuDB_Test_CA' => $ca,
                    },
                ),
                KiokuDB::TypeMap->new(
                    entries => {
                        'KiokuDB_Test_CA' => $ca,
                    }
                ),
            ],
        );
    } qr/\bKiokuDB_Test_CA\b/, "mixed entry conflict";
}


done_testing;