=head1 VERSION
-Version 0.01
+Version 0.02
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 DESCRIPTION
-A functor takes a L<LaTeX::TikZ::Set> tree and clones it according to certain rules.
-Rules can apply not only to L<LaTeX::TikZ::Set> objects, but also to the L<LaTeX::TikZ::Mod> objects they contain.
+A functor takes a L<LaTeX::TikZ::Set> tree and returns a new, transmuted version of it according to certain rules.
+It recursively visits all the nodes of the tree, building a new set out of the result of the functor on the child sets.
+
+Rules are stored as L<LaTeX::TikZ::Functor::Rule> objects.
+They can apply not only to L<LaTeX::TikZ::Set> consumer objects, but also to the L<LaTeX::TikZ::Mod> consumer objects they contain.
+When the functor is called against a set object and that the returned set is different from the original (as told by C<==>, which defaults to object identity), then the functor is also applied to all the mods of the set, and their transformed counterparts are added to the new set.
+
+When the functor is called onto a set or mod object, all its associated rules are tried successively, and the handler of the first matching rule is executed with :
+
+=over 4
+
+=item *
+
+the functor object as its first argument ;
+
+=item *
+
+the current set or mod object as its second argument ;
+
+=item *
+
+the arguments passed to the functor itself starting at the third argument.
+
+=back
+
+The handler is expected to return the new set or mod that will replace the old one in the resulting set tree.
+
+If no matching rule is found, the object is returned as-is.
=cut
use Sub::Name ();
+use LaTeX::TikZ::Functor::Rule;
+
use LaTeX::TikZ::Interface;
use LaTeX::TikZ::Tools;
-use Any::Moose 'Util' => [ qw[find_meta does_role] ];
-
my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
-my @default_set_rules;
-my @default_mod_rules;
-
-my ($validate_rule, $insert_rule);
+my $validate_spec;
BEGIN {
- $validate_rule = Sub::Name::subname('validate_rule' => sub {
- my ($spec, $handler) = @_;
+ $validate_spec = Sub::Name::subname('validate_spec' => sub {
+ my ($spec) = @_;
my ($replace, $target);
if (defined $spec and ref $spec eq ''
Carp::confess("Invalid rule spec $spec");
}
- (my $pm = $target) =~ s{::}{/}g;
- $pm .= '.pm';
- require $pm;
-
- my $meta = find_meta($target);
- Carp::confess("No meta object associated with target $target")
- unless defined $meta;
- my $is_role = $meta->isa(any_moose('Meta::Role'));
-
- my $is_set;
- if (does_role($target, 'LaTeX::TikZ::Set')) {
- $is_set = 1;
- } elsif (does_role($target, 'LaTeX::TikZ::Mod')) {
- $is_set = 0;
- } else {
- Carp::confess("Target $target is neither a set nor a mod");
- }
-
- Carp::confess("Invalid handler for rule spec $spec")
- unless defined $handler and ref $handler eq 'CODE';
-
- return [ $target, $handler, $replace, $is_role, $is_set ];
- });
-
- $insert_rule = Sub::Name::subname('insert_rule' => sub {
- my ($rule, $list, $overwrite) = @_;
-
- my ($target, $replace, $is_role) = @{$rule}[0, 2, 3];
-
- if ($replace) {
- my @remove;
-
- for my $i (0 .. $#$list) {
- my $old_target = $list->[$i]->[0];
- if ($is_role ? does_role($old_target, $target)
- : $old_target->isa($target)) {
- if (defined $rule) {
- splice @$list, $i, 1, $rule;
- $rule = undef;
- } else {
- push @remove, $i;
- }
- }
- }
-
- my $shift;
- for (@remove) {
- splice @$list, $_ - $shift, 1;
- ++$shift;
- }
- return 1 unless defined $rule;
-
- } else { # Replace only an existent rule
-
- for my $i (0 .. $#$list) {
- my $old_target = $list->[$i]->[0];
- if ($old_target eq $target) {
- Carp::confess("Default rule already defined for target $target")
- unless $overwrite;
- splice @$list, $i, 1, $rule;
- return 1;
- }
- }
- }
-
- push @$list, $rule;
- return 0;
+ return $target, $replace;
});
}
=head2 C<< new rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ] >>
-Creates a new functor object that will use both the default and these user-specified rules.
+Creates a new functor object that will use both the default and the user-specified rules.
The functor is also a code reference that expects to be called against L<LaTeX::TikZ::Set> objects.
The default set and mod rules clone their relevant objects, so you get a clone functor (for the default set types) if you don't specify any user rule.
my $clone = Tikz->functor;
my $dup = $set->$clone;
-If there is already a default rule for one of the C<$spec>s, it is replaced by the new one ; otherwise, the user rule is appended to the list of default rules.
+If there is already a default rule for one of the C<$spec>s, it is replaced by the new one ; otherwise, the user rule is inserted into the list of default rules after all its descendants' rules and before all its ancestors' rules.
# A translator
my $translate = Tikz->functor(
=cut
+my @default_set_rules;
+my @default_mod_rules;
+
sub new {
my ($class, %args) = @_;
while (@user_rules) {
my ($spec, $handler) = splice @user_rules, 0, 2;
- my $rule = $validate_rule->($spec, $handler);
+ my ($target, $replace) = $validate_spec->($spec);
- $insert_rule->($rule, $rule->[4] ? \@set_rules : \@mod_rules, 1);
+ my $rule = LaTeX::TikZ::Functor::Rule->new(
+ target => $target,
+ handler => $handler,
+ );
+
+ $rule->insert(
+ into => $rule->is_set ? \@set_rules : \@mod_rules,
+ overwrite => 1,
+ replace => $replace,
+ );
}
- my %dispatch = map { $_->[0] => $_ } @set_rules, @mod_rules;
+ my %dispatch = map { $_->target => $_ } @set_rules, @mod_rules;
my $self;
my $rule = $dispatch{ref($set)};
unless ($rule) {
for (@set_rules) {
- if ($_->[2] ? $set->does($_->[0]) : $set->isa($_->[0])) {
+ if ($_->handles($set)) {
$rule = $_;
last;
}
}
- $rule = [ undef, sub { $_[1] } ] unless $rule;
}
- my $new_set = $rule->[1]->($self, $set, @_);
- my $is_new = $new_set ne $set;
+ return $set unless $rule;
+
+ my $new_set = $rule->handler->($self, $set, @_);
+ return $set if $new_set == $set;
my @new_mods;
MOD:
my $rule = $dispatch{ref($mod)};
unless ($rule) {
for (@mod_rules) {
- if ($_->[2] ? $mod->does($_->[0]) : $mod->isa($_->[0])) {
+ if ($_->handles($mod)) {
$rule = $_;
last;
}
}
- unless ($rule) {
- push @new_mods, $mod;
- next MOD;
- }
}
- push @new_mods, $rule->[1]->($self, $mod, @_);
+ push @new_mods, $rule ? $rule->handler->($self, $mod, @_)
+ : $mod;
}
-
- $new_set->mod(@new_mods) if $is_new;
+ $new_set->mod(@new_mods);
return $new_set;
}, $class;
Adds to all subsequently created functors a default rule for the class or role C<$spec>.
-An exception is thrown if there is already a default rule for C<$spec> ; otherwise, the new rule is appended to the current list of rules.
+An exception is thrown if there is already a default rule for C<$spec> ; otherwise, the new rule is inserted into the current list of default rules after all its descendants' rules and before all its ancestors' rules.
But if C<$spec> begins with C<'+'>, the rule will replace I<all> default rules that apply to subclasses or subroles of C<$spec> (including C<$spec> itself).
Returns true if and only if an existent rule was replaced.
sub default_rule {
shift;
+ my ($spec, $handler) = @_;
+
+ my ($target, $replace) = $validate_spec->($spec);
- my $rule = $validate_rule->(@_);
+ my $rule = LaTeX::TikZ::Functor::Rule->new(
+ target => $target,
+ handler => $handler,
+ );
- $insert_rule->(
- $rule,
- $rule->[4] ? \@default_set_rules : \@default_mod_rules,
- 0,
+ $rule->insert(
+ into => $rule->is_set ? \@default_set_rules : \@default_mod_rules,
+ overwrite => 0,
+ replace => $replace,
);
}
=head1 SEE ALSO
-L<LaTeX::TikZ>.
+L<LaTeX::TikZ>, L<LaTeX::TikZ::Functor::Rule>.
=head1 AUTHOR