#!/usr/bin/perl
# testing the grammar
use Mooix::Thing;
use Data::Dumper;
use Test::More import => ['!fail'];
use warnings;
use strict;

# These are referenced by the grammar, and it's up to us to provide them.
use vars qw{$prepositions $pronouns $adjectives $verbs $nouns $answers
            $quantifiers};

# The real parser uses mooix object references, but the grammar does not
# care what is used to represent objects, so long as it can map from names
# to objects. To simplify things, we'll use an object's name is brackets as 
# its "reference". 
sub objref {
	return "[$_[0]]";
}
# These are all the objects that can be used in the tests;
# they don't need to really exist:
my @objects=qw{avatar room ball box phone penny penny};
# The pronouns are static.
my %pronouns=(
	here => [objref("room")],
	all => [map { objref($_) } @objects],
	everything => [map { objref($_) } @objects],
	me => [objref("avatar")],
	my => [objref("avatar")],
	i => [objref("avatar")],
	# note: no "it"!
);

# callbacks used by the grammar
sub lookup_pronoun {
	my $pronoun = lc(shift);
	return $pronouns{$pronoun} if exists $pronouns{$pronoun};
	return;
}

sub lookup_noun {
	my $noun = lc(shift);
	my $adjectives = shift;
	if (grep { $_ eq $noun } @objects) {
		return [objref($noun)];
	}
}

sub recent_obj {
	# not bothering to test this
}

sub is_obj_in_obj {
	return; # for now anyway
}
	    
sub check_quantification {
	my $quant = lc(shift);
	my @objs = @{shift()};

	return \@objs; # for now
}

sub genregex {
	$_=join('|', reverse sort { $a cmp $b } grep { length $_ } @_);
	if (! length $_) {
		$_="\n\n"; # impossible string
	}
	$_=qr/$_/i;
	return $_;
}

sub lookup_number {
        my $word=shift;
        return words2nums($word);
}

run sub ($) {
	my $this=shift;
	
	my @tests = grep { ! /^#/ } $this->commands;
	
	if (@tests / 2 != int(@tests /2)) {
		diag("read ".int(@tests)." non-comment lines from commands field. Not an even number, so it is corrupt");
		exit(1);
	}
	
	plan tests => 4 + (@tests / 2),
	     import => ['!fail'];
	 
	# load up the variables the parser uses
	$prepositions = genregex($this->prepositions);
	$pronouns = genregex($this->pronouns);
        $quantifiers=genregex(qw{all both any every several some few couple 
	                         most either}, "either one");
	$answers = genregex();
	$verbs = qr/\w+/;
	$nouns = genregex(@objects);
	$adjectives = genregex(qw{wooden heavy light ugly bouncy 1492 1996});
    
	ok($this->compilegrammar, "compilegrammar");
	ok(require $this->fieldfile("Grammar.pm"), "require grammar");
	my $parser = myGrammar->new;
	ok(ref $parser, "instantiate parser");
	
	# Words2Nums is required for the tests.
	eval "use Lingua::EN::Words2Nums";
	ok(! $@, "load Lingua::EN::Words2Nums");
	
COMMAND: while (@tests) {
		my $command=shift @tests;
		my $origcommand=$command;
		my $result=shift @tests;

		my $pt=$parser->input(\$command);
		if (length $command || ! defined $pt || ! ref $pt) {
			if (! length $result) {
				ok(1, "expected parse failure");
			}
			else {
				ok(0, "failure parsing \"$command\"");
				diag("failed to parse command: $origcommand (remaining part: $command)");
			}
			next;
		}

		$result=~s/\)$//;
		my @results=map { s/^\(//; $_ } split(/\), /, $result);
		if (@results != @$pt) {
			ok(0, "unexpected number of sentences");
			diag("parse tree: ".Dumper($pt));
			diag("command: $origcommand");
			diag("expected result: $result");
			next;
		}

		foreach my $sentence (@$pt) {
			my $r=shift @results;

			# Match up bits from the expected result with
			# what's in the parse tree. Delete parse tree
			# elements as they are found.
			foreach my $bit (split(', ', $r)) {
				my ($part, $value) = split("=", $bit, 2);
				if ($value=~/^"(.*)"$/) {
					$value=$1;
				}
				if (! exists($sentence->{$part})) {
					ok(0, "parse tree is missing expected part: $part");
					diag("command: $origcommand");
					diag("expected result: $result");
					diag("parse tree: ".Dumper($pt));
					next COMMAND;
				}
				elsif (ref $sentence->{$part} eq 'ARRAY') {
					my @new;
					my $found=0;
					foreach (@{$sentence->{$part}}) {
						if (! $found && $_ eq $value) {
							$found=1;
						}
						else {
							push @new, $_;
						}
					}
					if (! $found) {
						ok(0, "unexpected values");
						diag("command: $origcommand");
						diag("expected result: $part=$result");
						diag("parse tree: ".Dumper($pt));
						next COMMAND;
					}
					if (@new) {
						$sentence->{$part}=\@new;
					}
					else {
						delete $sentence->{$part};
					}
				}
				elsif ($value eq $sentence->{$part} ||
					# any case is ok for verbs
				       ($part eq 'verb' && lc($value) eq lc($sentence->{$part}))) {
					delete $sentence->{$part};
				}
				else {
					ok(0, "expected $part=$value, but got $part=".$sentence->{$part});
					diag("command: $origcommand");
					diag("expected result: $result");
					diag("parse tree: ".Dumper($pt));
					next COMMAND;
				}
			}
			
			# It's ok if there are some parts left with undef
			# values; for example sometimes undef
			# prepositions might be inserted by the grammar
			# if it always inserts a field for them even if
			# there is none.
			foreach (qw{do_preposition io_preposition}) {
				if (exists $sentence->{$_} &&
				    ! defined $sentence->{$_}) {
					delete $sentence->{$_};    
				}
			}
		
			# Make sure that used up all the parts.
			if (keys %$sentence) {
				ok(0, "extra parts in parse tree: ".join(", ", keys %$sentence));
				diag("command: $origcommand");
				diag("expected result: $result");
				diag("parse tree: ".Dumper($pt));
				next COMMAND;
			}
		}
		ok(1, "parse tree is as expected");
	}
}
