package Tree::Transform::XSLTish::Transformer;
use Moose;
use MooseX::AttributeHelpers;
use Moose::Util::TypeConstraints;
use Params::Validate ':all';
use Tree::Transform::XSLTish::Utils;
use Tree::Transform::XSLTish::Context;
use Tree::XPathEngine;
use Carp::Clan qw(^Tree::Transform::XSLTish);

subtype 'Tree::Transform::XSLTish::Engine'
    => as 'Object'
    => where {
        my $object=$_;
        for my $meth (qw(findnodes)) {
            return unless $object->can($meth);
        }
        return 1;
    };

has 'rules_package' => (is => 'ro', isa => 'ClassName');

has 'context_stack' => (
    metaclass => 'Collection::Array',
    is => 'rw',
    isa => 'ArrayRef[Tree::Transform::XSLTish::Context]',
    default => sub { [] },
    provides => {
        last => 'context',
        push => 'enter',
        pop => 'leave',
        empty => 'has_context',
    },
);

has 'engine' => (
    is => 'ro',
    isa => 'Tree::Transform::XSLTish::Engine',
    lazy => 1,
    builder => '_build_engine',
);

sub _build_engine {
    my ($self)=@_;

    if ($self->rules_package) {
        my $factory=Tree::Transform::XSLTish::Utils::_engine_factory($self->rules_package);
        if ($$factory) {
            return $$factory->();
        }
    }
    return Tree::XPathEngine->new();
}

sub it { $_[0]->context->current_node }

sub transform {
    my ($self,$tree)=@_;

    return $self->apply_rules($self->engine->findnodes('/',$tree));
}

sub apply_rules {
    my ($self,@nodes)=@_;

    unless (@nodes) {
        unless ($self->has_context) {
            carp 'apply_rules called without nodes nor context!';
            return;
        }
        @nodes=$self->engine->findnodes('*',$self->it);
    };

    my $guard=Tree::Transform::XSLTish::ContextGuard->new
        ($self,
         Tree::Transform::XSLTish::Context->new(node_list=>\@nodes)
       );

    my @ret;
    for my $node (@nodes) {
        $self->context->current_node($node);

        #warn "# applying rules to @{[ $node ]}";

        my $rule=$self->find_rule();
        push @ret,$rule->{action}->($self);
    }

    return @ret;
}

sub call_rule {
    my ($self,$name)=@_;

    unless ($name) {
        carp 'call_rule called without a rule name!';
        return;
    }

    unless ($self->has_context) {
        carp 'call_rule called without context!';
        return;
    }

    my $rule=$self->find_rule_by_name($name);
    return $rule->{action}->($self);
}

sub find_rule {
    my ($self,$context)=@_;

    for my $pack (Tree::Transform::XSLTish::Utils::_get_inheritance
          ($self->rules_package)) {
        my $ret=$self->find_rule_in_package($pack,$context);
        return $ret if $ret;
    }

    croak "No valid rule";
}

sub find_rule_by_name {
    my ($self,$name,$context)=@_;

    for my $pack (Tree::Transform::XSLTish::Utils::_get_inheritance
          ($self->rules_package)) {
        my $ret=$self->find_rule_by_name_in_package($pack,$name,$context);
        return $ret if $ret;
    }

    croak "No rule named $name";
}

sub find_rule_in_package {
    my ($self,$package,$context)=@_;

    $context||=$self->context;

    my $store=Tree::Transform::XSLTish::Utils::_rules_store($package);

    my $rules=$store->{by_match};

    my @candidates=
        sort { $b->{priority} <=> $a->{priority} }
            grep { $self->rule_matches($_) } @$rules;
    if (@candidates > 1 and
            $candidates[0]->{priority} ==
                $candidates[1]->{priority}) {
        croak "Ambiguous rule application";
    }
    elsif (@candidates >= 1) {
        return $candidates[0];
    }
}

sub find_rule_by_name_in_package {
    my ($self,$package,$name,$context)=@_;

    $context||=$self->context;

    my $store=Tree::Transform::XSLTish::Utils::_rules_store($package);

    my $rules=$store->{by_name};

    if (exists $rules->{$name}) {
        return $rules->{$name};
    }
}

sub rule_matches {
    my ($self,$rule,$context)=@_;

    $context||=$self->context;

    my $node=$context->current_node;
    my $path=$rule->{match};

    # XXX check the semantic

    my $base_node=$node;

    # this is a ugly hack
    my $test_sub= ($node->can('isSameNode'))?
        sub { grep { $node->isSameNode($_) } @_ }
            :
        sub { grep { "$node" eq "$_" } @_ };

    while ($base_node) {

        #warn "# Testing <$path> against @{[ $node ]} based on @{[ $base_node ]}";
        my @selected_nodes=$self->engine->findnodes($path,$base_node);
        #warn "#  selected: @selected_nodes\n";
        if ($test_sub->(@selected_nodes)) {
            return 1;
        }

        ($base_node)=$self->engine->findnodes('..',$base_node);
    }
    return;
}

__PACKAGE__->meta->make_immutable;no Moose;

package Tree::Transform::XSLTish::ContextGuard;

sub new {
    my ($class,$trans,$context)=@_;
    $trans->enter($context);
    return bless {trans=>$trans},$class;
}

sub DESTROY {
    $_[0]->{trans}->leave();
}

1;
__END__