package IMPL::lang;
use strict;
use warnings;

use parent qw(Exporter);
use IMPL::_core::version;

require IMPL::Class::PropertyInfo;

our @EXPORT      = qw(&is);
our %EXPORT_TAGS = (
	base => [
		qw(
		  &is
		  )
	],
	constants => [
		qw(
		  &ACCESS_PUBLIC
		  &ACCESS_PROTECTED
		  &ACCESS_PRIVATE
		  &PROP_GET
		  &PROP_SET
		  &PROP_OWNERSET
		  &PROP_LIST
		  &PROP_ALL
		  )
	],

	declare => [
		qw(
		  &public
		  &protected
		  &private
		  &virtual
		  &property
		  &static
		  &property
		  )
	],
	compare => [
		qw(
		  &equals
		  &equals_s
		  &hashCompare
		  )
	],
	hash => [
		qw(
		  &hashApply
		  &hashMerge
		  &hashDiff
		  &hashCompare
		  )
	]
);

our @EXPORT_OK = keys %{ { map (($_,1) , map (@{$_}, values %EXPORT_TAGS) ) } };

use constant {
	ACCESS_PUBLIC    => 1,
	ACCESS_PROTECTED => 2,
	ACCESS_PRIVATE   => 3,
	PROP_GET         => 1,
	PROP_SET         => 2,
	PROP_OWNERSET    => 10,
	PROP_LIST        => 4,
	PROP_ALL         => 3
};

sub is($$) {
	eval { $_[0]->isa( $_[1] ) };
}

sub virtual($) {
	$_[0]->Virtual(1);
	$_[0];
}

sub public($) {
	$_[0]->Access(ACCESS_PUBLIC);
	$_[0]->Implement;
	$_[0];
}

sub private($) {
	$_[0]->Access(ACCESS_PRIVATE);
	$_[0]->Implement;
	$_[0];
}

sub protected($) {
	$_[0]->Access(ACCESS_PROTECTED);
	$_[0]->Implement;
	$_[0];
}

sub property($$;$) {
	my ( $propName, $mutators, $attributes ) = @_;
	my $Info = new IMPL::Class::PropertyInfo(
		{
			Name       => $propName,
			Mutators   => $mutators,
			Class      => scalar(caller),
			Attributes => $attributes
		}
	);
	return $Info;
}

sub static($$) {
	my ( $name, $value ) = @_;
	my $class = caller;
	$class->static_accessor( $name, $value );
}

sub equals {
	if (defined $_[0]) {
		return 0 if (not defined $_[1]);
		
		return $_[0] == $_[1];
	}  else {
		return 0 if defined $_[1];
		
		return 1;
	}
}

sub equals_s {
	if (defined $_[0]) {
		return 0 if (not defined $_[1]);
		
		return $_[0] eq $_[1];
	}  else {
		return 0 if defined $_[1];
		
		return 1;
	}
}

sub hashDiff {
	my ($src,$dst) = @_;
	
	$dst = { %$dst };
	
	my %result;
	
	foreach my $key ( keys %$src ) {
		if (exists $dst->{$key}) {
			$result{"+$key"} = $dst->{$key} unless equals_s($dst->{$key}, $src->{$key});
			delete $dst->{$key};
		} else {
			$result{"-$key"} = 1;
		}
	}
	
	$result{"+$_"} = $dst->{$_} foreach keys %$dst;
	
	return \%result;
}

sub hashMerge {
	return hashApply( { %{$_[0]} }, $_[1] );
}

sub hashApply {
	my ($target,$diff) = @_;
	
	while ( my ($key,$value) = each %$diff) {
		$key =~ /^(\+|-)?(.*)$/;
		my $op = $1 || '+';
		$key = $2;
		
		if ($op eq '-') {
			delete $target->{$key};
		} else {
			$target->{$key} = $value;
		}
	}
	
	return $target;
}

sub hashCompare {
	my ($l,$r,$cmp) = @_;
	
	$cmp ||= \&equals_s;
	
	return 0 unless scalar keys %$l == scalar keys %$r;
	&$cmp($l->{$_},$r->{$_}) || return 0 foreach keys %$l;
	
	return 1;
}

1;