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

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

require IMPL::Class::PropertyInfo;

our @EXPORT      = qw(&is);
our %EXPORT_TAGS = (
    base => [
        qw(
          &is
          &clone
          )
    ],

    declare => [
        qw(
          &public
          &protected
          &private
          &virtual
          &property
          &static
          &property
          &ACCESS_PUBLIC
          &ACCESS_PROTECTED
          &ACCESS_PRIVATE
          &PROP_GET
          &PROP_SET
          &PROP_OWNERSET
          &PROP_LIST
          &PROP_ALL
          &PROP_RO
          &PROP_RW
          )
    ],
    compare => [
        qw(
          &equals
          &equals_s
          &hashCompare
          )
    ],
    hash => [
        qw(
          &hashApply
          &hashMerge
          &hashDiff
          &hashCompare
          &hashParse
          &hashSave
          )
    ]
);

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

use IMPL::Const qw(:all);

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 ? { %$dst } : {} ;
    $src ||= {};
    
    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) = @_;
    
    return $target unless ref $diff eq 'HASH';
    
    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;
}

sub hashParse {
    my ($s,$p,$d) = @_;
    
    $p = $p ? qr/$p/ : qr/\n+/;
    $d = $d ? qr/$d/ : qr/\s*=\s*/;
    
    return {
        map split($d,$_,2), split($p,$s)
    };
}

sub hashSave {
    my ($hash,$p,$d) = @_;
    
    return "" unless ref $hash eq 'HASH';
    
    $p ||= "\n";
    $d ||= " = ";
    
    return
        join(
            $p,
            map(
                join(
                    $d,
                    $_,
                    $hash->{$_}
                ),
                keys %$hash
            )
        );
}

1;