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 }
	]
};

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 $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;