#!/usr/bin/env perl
use 5.10.0;
use strict;
use warnings;
use Storable qw(lock_retrieve);
use Tie::IxHash;
use File::Basename qw(dirname);
use Text::Xslate;
use Data::Dumper;
use Data::Section::Simple;

my $classdef = lock_retrieve(dirname(__FILE__) . "/.idl2jsx.bin");

my @classes;
my %used_type;


sub use_type {
    my($type) = @_;
    $used_type{type2id($type)} = trim_comment($type);
    return;
}

# prepare
while(my($class, $def) = each %{$classdef}) {
    next if $def->{skip};
    next if $def->{alias};

    my $c = 0; # for constructors
    my $v = 0; # for member variables
    my $f = 0; # for member functions
    push @classes, $def;

    my %seen;

    my @tests;
    foreach my $member(@{$def->{members}}) {
        next unless ref $member;
        next if $seen{$member->{decl}}++;

        my $receiver;
        if($member->{static}) {
            $receiver = $class;
        }
        else {
            $receiver = "o";
        }

        if(exists $member->{type}) {
            push @tests, sprintf "var v%d : %s = %s.%s;",
                ++$v, $member->{type},
                $receiver, $member->{id};

            use_type($member->{type});
        }
        else {
            my $ret_type    = $member->{ret_type_decl};
            my $param_types = $member->{param_types};

            $ret_type =~ s/\A \s* : \s*//xms;

            if($member->{id} eq 'constructor') {
                push @tests, sprintf "var c%d = new %s(%s);",
                    ++$c, $class, make_args($param_types);
            }
            elsif($ret_type eq 'void') {
                push @tests, sprintf "%s.%s(%s);",
                    $receiver, $member->{id}, make_args($param_types);
            }
            else {
                push @tests, sprintf "var f%d : %s = %s.%s(%s);",
                    ++$f, $ret_type,
                    $receiver, $member->{id}, make_args($param_types);

                use_type($ret_type);
            }
            use_type($_) for @{$param_types};
        }
    }

    $def->{tests} = \@tests;

}
# build
my $xslate = Text::Xslate->new(
    type => "text",
    path => [ Data::Section::Simple->new->get_data_section ],
);

print $xslate->render("web.jsx", {
        classes => \@classes,
        types   => \%used_type,
    });

exit;

sub trim_comment {
    my($t) = @_;
    $t =~ s{/\* .*? \*/}{}xmsg;
    return $t;
}

sub type2id {
    my($type) = @_;
    $type = trim_comment($type);
    $type =~ s/\s+//xmsg;
    $type =~ s/ \W /_/xmsg;
    return $type;
}

sub value_of {
    my($type) = @_;
    return sprintf 'X.get%s()', type2id($type);
}

sub make_args {
    my($param_types) = @_;
    return join(", ", map { value_of($_) } @{$param_types});
}

__DATA__
@@ web.jsx
// THIS FILE IS AUTOMATICALLY GENERATED.
// DON'T EDIT THIS FILE. EDIT jsx2idl/maketest.pl INSTEAD.

import "test-case.jsx";
import "js/web.jsx";

class _Test extends TestCase {

: for $classes -> $class {
    function compile_<: $class.name :>(o : <: $class.name :>) : void {
    : for $class.tests -> $statement {
        <: $statement :>
    : }
    } // <: $class.name :>

: }

    function test_compile() : void {
        this.expect(true).toBe(true);
    }

}

native class X {
: for $types.kv() -> $pair {
    static function get<: $pair.key :>() : <: $pair.value :>;
: }
}