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

use parent qw(Exporter);
use IMPL::clone qw(clone);
use Scalar::Util qw(blessed);
use POSIX;
use Carp qw(carp);

our @EXPORT      = qw(&is &isclass &typeof &coarsen &coarsen_dt);
our %EXPORT_TAGS = (
    base => [
        qw(
          &is
          &clone
          &isclass
          &typeof
          &ishash
          &isarray
          &isscalar
          &isglob
          )
    ],
    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 {
    carp "A typename can't be undefined" unless $_[1];
    blessed( $_[0] ) and $_[0]->isa( $_[1] );
}

sub isclass {
    carp "A typename can't be undefined" unless $_[1];
    local $@;
    eval { not ref $_[0] and $_[0]->isa( $_[1] ) };
}

sub typeof(*) {
    blessed( $_[0] );
}

sub isarray {
    not blessed( $_[0] ) and ref $_[0] eq 'ARRAY';
}

sub ishash {
    not blessed( $_[0] ) and ref $_[0] eq 'HASH';
}

sub isscalar {
    not blessed( $_[0] ) and ref $_[0] eq 'SCALAR';
}

sub isglob {
    not blessed( $_[0] ) and ref $_[0] eq 'GLOB';
}

sub coarsen {
    my ( $value, $resolution ) = @_;
    return $resolution ? ceil( $value / $resolution ) * $resolution : $value;
}

# datetime is DateTime object
# resolution is DateTime::Duration object, the resulting time will be aligned to it
sub coarsen_dt {
    my ( $datetime, $resolution ) = @_;

    return $datetime unless $resolution;

    my $date = $datetime->clone()->truncate( to => "day" );

    return $date->add(
        minutes => coarsen(
            $datetime->subtract_datetime($date)->in_units('minutes'),
            $resolution->in_units('minutes')
        )
    );
}

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;