#!/usr/bin/perl

use strict;
use warnings;

use Test::More 'no_plan';
use Test::TempDir;

use Set::Object;

{
    # this will be a default class, for now I'm keeping them separate
    package MyGIN;
    use Moose;

    # in memory index:
    #with qw(
    #   Search::GIN::DelegateToIndexed
    #   Search::GIN::Driver::Hash
    #);

    # on disk index:
    with (
        qw(
            Search::GIN::Core
            Search::GIN::Driver::Hash
            Search::GIN::SelfIDs
		),
		'Search::GIN::DelegateToIndexed' => {
			-excludes => "objects_to_ids", # SelfIDs
		},
    );
}

{
    # you create the query objects, the GIN implementation uses them
    # consistently with the index
    package MyTagQuery;
    use Moose::Role;

    use MooseX::Types::Set::Object;

    with qw(Search::GIN::Query);

    has tags => (
        isa => "Set::Object",
        is  => "ro",
        coerce   => 1,
        required => 1,
    );

    sub extract_values {
        my $self = shift;
        return (
            values => [ $self->tags->members ],
        );
    }
}
{
    package MyTagQuery::Intersection;
    use Moose;

    with qw(MyTagQuery);

    sub consistent {
        my ( $self, $index, $item ) = @_;
        return $self->tags->subset($item->tags);
    }

    around extract_values => sub {
        my ( $next, $self, @args ) = @_;
        return (
            method => "all",
            $self->$next(@args),
        );
    };

    __PACKAGE__->meta->make_immutable;
}
{
    package MyTagQuery::Union;
    use Moose;

    with qw(MyTagQuery);

    sub consistent {
        my ( $self, $index, $item ) = @_;
        return $self->tags->intersection($item->tags)->size >= 1;
    }

    __PACKAGE__->meta->make_immutable;
}
{
    # this is an indexable object
    package MyObject;
    use Moose;

    use overload '""' => sub { $_[0]->id }, fallback => 1; # is_deeply diagnosis

    use MooseX::Types::Set::Object;

    with qw(Search::GIN::Indexable);

    has id => (
        isa => "Str",
        is  => "ro",
    );

    sub gin_id { shift->id }

    has tags => (
        isa => "Set::Object",
        is  => "ro",
        coerce  => 1,
        default => sub { Set::Object->new },
    );

    sub gin_extract_values {
        my $self = shift;
        $self->tags->members;
    }

    __PACKAGE__->meta->make_immutable;
}


my $gin = MyGIN->new(
    manager => {
        home => temp_root,
        create => 1,
    },
    file => "foo.idx",
    distinct => 1,
);

my @objs = map { MyObject->new(%$_) } (
    {
        id   => "aaaaaaaaaaaaaaaa",
        tags => [ qw(foo bar baz donkey) ],
    },
    {
        id   => "aaaaaaaaaaaaaaab",
        tags => [ qw(bar gorch baz) ],
    },
    {
        id   => "aaaaaaaaaaaaaaac",
        tags => [ qw(zot urf donkey gorch) ],
    },
);

$gin->insert(@objs);

{
    my @res = $gin->query( MyTagQuery::Intersection->new( tags => [qw(foo)] ) )->all;
    is_deeply( [ @res ], [ $objs[0] ] );
}

{
    my @res = $gin->query( MyTagQuery::Union->new( tags => [qw(foo)] ) )->all;
    is_deeply( [ @res ], [ $objs[0] ] );
}

{
    my @res = $gin->query( MyTagQuery::Intersection->new( tags => [qw(bar)] ) )->all;
    is_deeply( [ sort @res ], [ sort @objs[0, 1] ] );
}

{
    my @res = $gin->query( MyTagQuery::Intersection->new( tags => [qw(gorch)] ) )->all;
    is_deeply( [ sort @res ], [ sort @objs[1, 2] ] );
}

{
    my @res = $gin->query( MyTagQuery::Intersection->new( tags => [qw(bar gorch)] ) )->all;
    is_deeply( [ @res ], [ $objs[1] ] );
}

{
    my @res = $gin->query( MyTagQuery::Union->new( tags => [qw(bar gorch)] ) )->all;
    is_deeply( [ sort @res ], [ sort @objs ] );
}