package IMPL::Config::Bag;
use strict;

use IMPL::lang qw(:base);
use IMPL::declare {
    base => [
        'IMPL::Object' => undef
    ],
    props => [
        _parents   => '*rw',    # array of parent bags
        _parentRev => '*rw',    # the timestamp of the parent
        _sealed    => '*rw',    # the bag has descendants
        _cache     => '*rw',    # own or cached entries
        _timestamp => '*rw',
        _entries   => '*rw',    # each entry is represented by hash
          # { isa => linear_isa_hash, owner => owner_of_the_entry, value => value }
        tag => 'rw'    # used to store additional information
    ]
};

sub CTOR {
    my ( $this, $p ) = @_;

    if ($p) {
        $p->_Seal();
        my @parents;
        push @parents, @{ $p->{$_parents} } if $p->{$_parents};
        push @parents, $p;
        $this->{$_parents}   = \@parents;
        $this->{$_parentRev} = $p->{$_timestamp};
    }

    $this->{$_timestamp} = 0;
    $this->{$_cache}     = {};
    $this->{$_entries}   = [];
}

sub GetParent {
    my ($this) = @_;

    $this->{$_parents} && $this->{$_parents}[ @{ $this->{$_parents} } - 1 ];
}

sub _Seal {
    unless ( $_[0]->{$_sealed} ) {
        $_[0]->{$_sealed}    = 1;
        $_[0]->{$_timestamp} = 0;    # from now the timestamp is important
    }
}

sub _Validate {
    my ($this) = @_;

    my $chain = $this->{$_parents}
      or return 1;

    my $rev = 0;    # rev 0 means that parent was never modified
                    # this allows to made more efficient checks
    my $flush;

    foreach my $bag ( @$chain, $this ) {

        # we need to updated all bags after the first change was detected;
        if ( $flush ||= $rev and $bag->{$_parentRev} != $rev ) {
            $bag->{$_cache}     = {};
            $bag->{$_parentRev} = $rev;
        }
        $rev = $bag->{$_timestamp};
    }

    return $flush ? 0 : 1;
}

sub Resolve {
    my ( $this, $role ) = @_;

    die IMPL::InvalidArgumentException->new('role')
      unless defined $role;

    if ( my $d = $this->_GetDescriptor($role) ) {
        return wantarray ? @{$d}{'value', 'owner'} : $d->{value};
    }
    else {
        return;
    }
}

sub _GetDescriptor {
    my ( $this, $role ) = @_;

    my $d = $this->{$_cache}{$role};

# return descriptor if this is own descriptor and its level is 1 (i.e. it can't be overriden by the parent cache)
# otherwise the cache must be validated
    return $d
      if $d
      and ( ( $d->{owner} == $this and $d->{isa}{$role} == 1 )
        or $this->_Validate() );

    # if there were no descriptor in cache we need to ensure that the cache
    # chain is valid before reolving starts
    $this->_Validate() unless $d;

    # the cache chain is valid
    # $d is not a valid descriptor

    $d = undef;
    my $prev;

    my $parents = $this->{$_parents};
    my @bags = $parents ? ( @$parents, $this ) : ($this);

    foreach my $bag (@bags) {

        # check the cache;
        unless ( my $t = $bag->{$_cache}{$role} ) {

      # no cached entry this may be due cache flush
      # go through own entries and find better entry than inherited from parents
            foreach my $entry ( @{ $bag->{$_entries} } ) {
                my $level = $entry->{isa}{$role};
                if ( $level and ( not($prev) or $level <= $prev ) ) {
                    $d    = $entry;
                    $prev = $level;
                }
            }

            #cache it
            $bag->{$_cache}{$role} = $d if $d;
        }
        else {
            $d    = $t;
            $prev = $d->{isa}{$role};
        }
    }

    return $d;
}

sub ResolveAll {
    my ( $this, $role ) = @_;

    return [
        map $_->{value},
        grep $_->{isa}{$role},
        map @{ $_->{$_entries} },
        @{ $this->{$_parents} || [] },
        $this
    ];

}

sub Register {
    my ( $this, $isa, $value ) = @_;

    $isa = { $isa, 1 } unless ishash($isa);

    push @{ $this->{$_entries} },
      { owner => $this, isa => $isa, value => $value };
    $this->{$_timestamp}++;

    delete $this->{$_cache}{$_} foreach keys %$isa;

    return $this;
}

1;