#line 1
package TestML::AST;
use TestML::Mo;
extends 'Pegex::Tree';

use TestML::Runtime;

has points => default => sub{[]};
has function => default => sub { TestML::Function->new };

# sub final {
#     my ($self, $match, $top) = @_;
#     XXX $match;
# }
# __END__

sub got_code_section {
    my ($self, $code) = @_;
    $self->function->statements($code);
}

sub got_assignment_statement {
    my ($self, $match) = @_;
    return TestML::Statement->new(
        expression => TestML::Expression->new(
            units => [
                TestML::Transform->new(
                    name => 'Set',
                    args => [
                        $match->[0],
                        $match->[1],
                    ],
                ),
            ],
        ),
    );
}

sub got_code_statement {
    my ($self, $list) = @_;
    my ($expression, $assertion);
    my $points = $self->points;
    $self->points([]);

    for (@$list) {
        if (ref eq 'TestML::Expression') {
            $expression = $_;
        }
        if (ref eq 'TestML::Assertion') {
            $assertion = $_;
        }
    }
    return TestML::Statement->new(
        $expression ? ( expression => $expression ) : (),
        $assertion ? ( assertion => $assertion ) : (),
        @$points ? ( points => $points ) : (),
    );
}

sub got_code_expression {
    my ($self, $list) = @_;
    my $units = [];
    push @$units, shift @$list if @$list;
    $list = shift @$list || [];
    for (@$list) {
        my $unit = $_->[0]; #->{unit_call}[0][0];
        push @$units, $unit;
    }
    return TestML::Expression->new(
        units => $units,
    );
}

sub got_number_object {
    my ($self, $number) = @_;
    return TestML::Num->new(
        value => $number,
    );
}

sub got_string_object {
    my ($self, $string) = @_;
    return $self->make_str($string);
}

sub got_point_object {
    my ($self, $point) = @_;
    $point =~ s/^\*// or die;
    push @{$self->points}, $point;
    return TestML::Transform->new(
        name => 'Point',
        args => [$point],
    );
}

sub make_str {
    my ($self, $object) = @_;
    return TestML::Str->new(
        value => $object,
    );
}
sub got_assertion_call {
    my ($self, $call) = @_;
    my ($name, $assertion);
    for (qw( eq has ok )) {
        if ($assertion = $call->{"assertion_$_"}) {
            $name = uc $_;
            $assertion =
                $assertion->{"assertion_operator_$_"}[0] ||
                $assertion->{"assertion_function_$_"}[0];
            last;
        }
    }
    XXX $call unless $assertion;
    return TestML::Assertion->new(
        name => $name,
        expression => $assertion,
    );
}

sub got_assertion_function_ok {
    my ($self, $ok) = @_;
    return {
        assertion_function_ok => [
            TestML::Expression->new,
        ]
    }
}

sub got_function_start {
    my ($self) = @_;
    my $function = TestML::Function->new();
    $function->outer($self->function);
    $self->function($function);
    return 1;
}

sub got_function_object {
    my ($self, $object) = @_;

    my $function = $self->function;
    $self->function($self->function->outer);

    if (ref($object->[0]) and ref($object->[0][0])) {
        $function->signature($object->[0][0]);
    }
    $function->statements($object->[-1]);

    return $function;
}

sub got_transform_name {
    my ($self, $match) = @_;
    return TestML::Transform->new(name => $match);
}

sub got_transform_object {
    my ($self, $object) = @_;
    my $transform = $object->[0];
    if ($object->[1][-1] and $object->[1][-1] eq 'explicit') {
        $transform->explicit_call(1);
        splice @{$object->[1]}, -1, 1;
    }
    my $args = [];
    $args = $object->[1][0] if $object->[1][0];
    $transform->args($args) if @$args;
    return $transform;
}

sub got_transform_argument_list {
    my ($self, $list) = @_;
    push @$list, 'explicit';
    return $list;
}

#----------------------------------------------------------
sub got_data_section {
    my ($self, $data) = @_;
    $self->function->data($data);
}

sub got_data_block {
    my ($self, $block) = @_;
    return TestML::Block->new(
        label => $block->[0][0][0],
        points => +{map %$_, @{$block->[1]}},
    );
}

sub got_block_point {
    my ($self, $point) = @_;
    return {
        $point->[0] => $point->[1],
    };
}

1;