package Webservice::InterMine::LogicParser;

use strict;
use warnings;

use Moose;
use Webservice::InterMine::Types qw(Query);
use MooseX::Types::Moose qw(HashRef Int Str);
use Webservice::InterMine::LogicalOperator;
use Webservice::InterMine::LogicalSet;
use Scalar::Util qw(blessed);

use constant {
    LEFT_BRACKET => '(',
    RIGHT_BRACKET => ')',
    LOGICAL_OPERATOR => "Webservice::InterMine::LogicalOperator",
};

has _query => (
    isa      => Query,
    is       => 'ro',
    handles  => [qw/get_constraint/],
    weak_ref => 1,
    required => 1,
    init_arg => 'query',
);

has operators => (
    isa     => HashRef[Str],
    is      => 'ro',
    traits  => ['Hash'],
    handles => {
        valid_operator => 'exists',
        get_canonical_operator => 'get',
    },
    lazy_build => 1,
);

sub _build_operators {
    return {
        'and' => "AND",
        '&'   => "AND",
        '&&'  => "AND",
        'AND' => 'AND',

        'or'  => "OR",
        'OR'  => "OR",
        '|'   => "OR",
        '||'  => 'OR',

        LEFT_BRACKET, LEFT_BRACKET,
        RIGHT_BRACKET, RIGHT_BRACKET,
    };
}

has _operator_cache => (
    isa => 'HashRef[ ' . LOGICAL_OPERATOR . ']',
    is  => 'ro',
    traits => ['Hash'],
    handles => {
        cache_operator => 'set',
        retrieve_operator => 'get',
        is_cached => 'exists',
    },
    default => sub { {} },
);

sub get_operator {
    my $self = shift;
    my $operator = shift;
    unless ( $self->is_cached($operator) ) {
        $self->cache_operator($operator => LOGICAL_OPERATOR->new(
            token => $self->get_canonical_operator($operator),
            priority => $self->get_priority_of($operator),
        ));
    } 
    return $self->retrieve_operator($operator);
}

has priorities => (
    isa => HashRef[Int],
    is  => 'ro',
    traits => ['Hash'],
    handles => {
      get_priority_of => 'get',
    },
    lazy_build => 1,
);

sub _build_priorities {
    return {
        and => 2,
        or  => 1,
        AND => 2,
        OR  => 1,
        LEFT_BRACKET, 3,
        RIGHT_BRACKET, 3,
    };
}

sub infix_to_postfix {
    my @infix_tokens = @_;
    my (@postfix_tokens, @stack);
    while (my $token = shift @infix_tokens) {
        unless (blessed $token) {
            push @postfix_tokens, $token;
        } else {
            if ($token eq LEFT_BRACKET) {
                push @stack, $token;
            } elsif ($token eq RIGHT_BRACKET) {
                while(my $lp = pop @stack) {
                    if ($lp eq LEFT_BRACKET) {
                        if (my $stack_op = pop @stack) { 
                            push @postfix_tokens, $stack_op 
                                unless ($stack_op eq LEFT_BRACKET);
                            last;
                        } 
                    } else {
                        push @postfix_tokens, $lp;
                    }
                }
            } else {
                while (@stack && ($stack[-1]->priority <= $token->priority)) {
                    my $stack_op = pop @stack;
                    push @postfix_tokens, $stack_op 
                        unless ($stack_op eq LEFT_BRACKET);
                }
                push @stack, $token;
            }
        }
    }
    while (my $stack_op = pop @stack) {
        push @postfix_tokens, $stack_op;
    }
    return @postfix_tokens;
}

sub evaluate {
    my $self = shift;
    my @tokens = @_;
    my @stack;
    for my $token (@tokens) {
        unless (blessed $token) {
            push @stack, $token;
        } else {
            push @stack, $self->make_node($token, pop(@stack), pop(@stack));
        }
    }
    return pop(@stack);
}

sub make_node {
    my ($self, $operator, $right, $left) = @_;
    return Webservice::InterMine::LogicalSet->new(
        op    => "$operator",
        right  => (ref $right) ? $right : $self->get_constraint($right),
        left  => (ref $left) ? $left : $self->get_constraint($left),
    );
}

sub parse_logic {
    my $self = shift;
    my $input = uc(shift);
    return 
        $self->evaluate(
        infix_to_postfix(
        map   {/[()]/ ? split '' : $_}
        map   {$self->valid_operator($_) ? $self->get_operator($_) : split /\b/} 
        split /\s+/, $input));
}

sub parse_logic_without_evaluation {
    my $self = shift;
    my $input = uc(shift);
    return 
        infix_to_postfix(
        map   {/[()]/ ? split '' : $_}
        map   {$self->valid_operator($_) ? $self->get_operator($_) : split /\b/} 
        split /\s+/, $input);
}

__PACKAGE__->meta->make_immutable;
no Moose;
1;