package SlackBuild::Pattern;
use strict;
use warnings;
use Carp;
use Scalar::Util qw(looks_like_number);
use JSON;

my %matchtab = (
    -eq => sub {
	my ($self, $a, $b) = @_;
	(looks_like_number($a) && looks_like_number($b)) ? $a == $b : $a eq $b;
    },
    '=' => '-eq',
    '==' => '-eq',
    
    -ne => sub {
	my ($self, $a, $b) = @_;
	(looks_like_number($a) && looks_like_number($b)) ? $a != $b : $a ne $b;
    },
    '!=' => '-ne',
    
    -lt => sub {
	my ($self, $a, $b) = @_;
	(looks_like_number($a) && looks_like_number($b)) ? $a < $b : $a lt $b;
    },
    '<' => '-lt',
    
    -le => sub {
	my ($self, $a, $b) = @_;
	(looks_like_number($a) && looks_like_number($b)) ? $a <= $b : $a le $b;
    },
    '<=' => '-le',
    
    -gt => sub {
	my ($self, $a, $b) = @_;
	(looks_like_number($a) && looks_like_number($b)) ? $a > $b : $a gt $b;
    },
    '>' => '-gt',
    
    -ge => sub {
	my ($self, $a, $b) = @_;
	(looks_like_number($a) && looks_like_number($b)) ? $a >= $b : $a ge $b;
    },
    '>=' => '-ge',
    
    -in => sub {
	my ($self, $a, $b) = @_;
	croak 'argument to -in must be array'
	    unless ref($b) eq 'ARRAY';
	foreach my $v (@$b) {
	    return 1
		if (looks_like_number($a) && looks_like_number($v))
		    ? $a == $v : $a eq $v;
	}
    }
);

sub new {
    my $class = shift;
    croak "Bad number of arguments" if @_ % 2;
    my $self = bless { predicates => [], printable => [] }, $class;
    for (my $i = 0; $i < @_; $i+=2) {
	$self->add_predicate($_[$i], $_[$i+1]);
    }
    return $self;
}

sub add_predicate {
    my ($self, $field, $pred) = @_;

    my ($fun, $arg);
    if (ref($pred) eq 'ARRAY') {
	croak "array must have 2 elements" unless @$pred == 2;
        ($fun, $arg) = @$pred;
    } elsif (ref($pred) eq 'HASH') {
	croak "array must have 1 key" unless keys(%$pred) == 1;
	($fun, $arg) = each %$pred;
    } elsif ($pred =~ m{^([<=>]=?)(.*)}) {
	$fun = $1;
	$arg = $2;
    } else {
	$fun = '-eq';
	$arg = $pred;
    }

    while (exists($matchtab{$fun}) && !ref($matchtab{$fun})) {
	$fun = $matchtab{$fun};
    }
    
    croak "unknown predicate: $fun"
	unless (exists($matchtab{$fun}));

    $self->{index}{$field} = @{$self->{predicates}};
    push @{$self->{predicates}}, [
	$field,
	sub {
	    my ($val) = @_;
#	    print "$field $fun $val $arg?\n";
	    return $self->${\ $matchtab{$fun}}($val, $arg);
    }];

    push @{$self->{printable}}, { $field => { $fun => $arg } };
}

sub matches {
    my ($self, $obj) = @_;
#    print "OBJ=$obj\n";
    foreach my $pred (@{$self->{predicates}}) {
	my ($field, $fun) = @$pred;
	return 0 unless &{$fun}($obj->${\$field});
    }
    return 1;
}

sub as_string {
    my $self = shift;
    JSON->new->canonical(1)->encode(
	[sort { $self->predcmp($a, $b) } @{$self->{printable}}]);
}

sub predcmp {
    my ($self, $a, $b) = @_;
    (keys($a))[0] cmp (keys($b))[0];
}

sub get_predicate {
    my ($self, $field) = @_;
    if (exists($self->{index}{$field})) {
	$self->{printable}[$self->{index}{$field}]{$field};
    }
}
1;