package Data::MultiValued::AttributeTrait::Tagged;
use Moose::Role;
use Data::MultiValued::Tags;
use Data::MultiValued::AttributeAccessors;
use MooseX::Types::Moose qw(Str HashRef);
use Try::Tiny;
use namespace::autoclean;

has 'full_storage_slot' => (
    is => 'ro',
    isa => Str,
    lazy_build => 1,
    init_arg => undef,
);
sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' }

around slots => sub {
    my ($orig, $self) = @_;
    return ($self->$orig(), $self->full_storage_slot);
};

sub set_full_storage {
    my ($self,$instance) = @_;

    my $ret = Data::MultiValued::Tags->new();
    $self->associated_class->get_meta_instance->set_slot_value(
        $instance,
        $self->full_storage_slot,
        $ret,
    );
    return $ret;
}

sub get_full_storage {
    my ($self,$instance) = @_;

    return $self->associated_class->get_meta_instance
        ->get_slot_value(
            $instance,
            $self->full_storage_slot,
        );
}

sub full_storage {
    my ($self,$instance) = @_;

    return $self->get_full_storage($instance)
        || $self->set_full_storage($instance);
}

sub accessor_metaclass { 'Data::MultiValued::AttributeAccessors' }

after install_accessors => sub {
    my ($self) = @_;

    my $class  = $self->associated_class;

    for my $meth (qw(accessor reader writer predicate clearer)) {
        my $check = "has_$meth";
        next unless $self->$check;

        my $type = "tagged_$meth";
        my $basename = $self->$meth;

        die 'MultiValued attribute trait is not compatible with subref accessors'
            if ref($basename);

        my $name = "${basename}_tagged";

        $class->add_method(
            $self->_process_accessors($type => $name,0)
        );
    }
};

sub load_tagged_value {
    my ($self,$instance,$opts) = @_;

    my $value;my $found=1;
    try {
        $value = $self->full_storage($instance)->get($opts);
    }
    catch {
        unless (ref($_) && $_->isa('Data::MultiValued::Exceptions::NotFound')) {
            die $_;
        }
        $found = 0;
    };

    if ($found) {
        $self->set_raw_value($instance,$value);
    }
    else {
        $self->raw_clear_value($instance);
    }
}

sub raw_clear_value {
    my ($self,$instance) = @_;

    $self->associated_class->get_meta_instance
        ->deinitialize_slot(
            $instance,
            $self->name,
        );
}

sub store_tagged_value {
    my ($self,$instance,$opts) = @_;

    my $value = $self->get_raw_value($instance);
    $self->full_storage($instance)->set({%$opts,value=>$value});
}

our $dyn_opts = {};

before get_value => sub {
    my ($self,$instance) = @_;

    $self->load_tagged_value($instance,$dyn_opts);
};

sub get_tagged_value {
    my ($self,$instance,$opts,$value) = @_;

    local $dyn_opts = $opts;

    return $self->get_value($instance,$value);
}

after set_initial_value => sub {
    my ($self,$instance,$value) = @_;

    $self->store_tagged_value($instance,$dyn_opts);
};

after set_value => sub {
    my ($self,$instance,$value) = @_;

    $self->store_tagged_value($instance,$dyn_opts);
};

sub set_tagged_value {
    my ($self,$instance,$opts,$value) = @_;

    local $dyn_opts = $opts;

    return $self->set_value($instance,$value);
}

before has_value => sub {
    my ($self,$instance) = @_;

    $self->load_tagged_value($instance,$dyn_opts);
};

sub has_tagged_value {
    my ($self,$instance,$opts) = @_;

    local $dyn_opts = $opts;

    return $self->has_value($instance);
}

after clear_value => sub {
    my ($self,$instance) = @_;

    # XXX NIY
    $self->full_storage($instance)->clear($dyn_opts);
};

sub clear_tagged_value {
    my ($self,$instance,$opts) = @_;

    local $dyn_opts = $opts;

    return $self->clear_value($instance);
}

sub get_tagged_read_method  { 
    my $self   = shift;
    return $self->get_read_method . '_tagged';
}

sub get_tagged_write_method  { 
    my $self   = shift;
    return $self->get_write_method . '_tagged';
}

sub _rebless_slot {
    my ($self,$instance) = @_;

    my $st = $self->get_full_storage($instance);
    return unless $st;

    bless $st, 'Data::MultiValued::Tags';
    $st->_rebless_storage;
}

sub _as_hash {
    my ($self,$instance) = @_;

    my $st = $self->get_full_storage($instance);
    return unless $st;

    return $st->_as_hash;
}

package Moose::Meta::Attribute::Custom::Trait::MultiValued::Tagged;{
sub register_implementation { 'Data::MultiValued::AttributeTrait::Tagged' }
}

1;