X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FLaTeX%2FTikZ%2FFunctor.pm;h=ac51ccf73d2d763331a2b6693fd1bf8050395677;hb=61a93a58351bf2d238dcf81a1a557112b0c0ee85;hp=eaf13cabed4a9b35bc7eb778cbc7977e8624ce47;hpb=f0b56a8644ce9573f173c6b477e254f0f42401d0;p=perl%2Fmodules%2FLaTeX-TikZ.git diff --git a/lib/LaTeX/TikZ/Functor.pm b/lib/LaTeX/TikZ/Functor.pm index eaf13ca..ac51ccf 100644 --- a/lib/LaTeX/TikZ/Functor.pm +++ b/lib/LaTeX/TikZ/Functor.pm @@ -9,16 +9,42 @@ LaTeX::TikZ::Functor - Build functor methods that recursively visit nodes of a L =head1 VERSION -Version 0.01 +Version 0.02 =cut -our $VERSION = '0.01'; +our $VERSION = '0.02'; =head1 DESCRIPTION -A functor takes a L tree and clones it according to certain rules. -Rules can apply not only to L objects, but also to the L objects they contain. +A functor takes a L 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 objects. +They can apply not only to L consumer objects, but also to the L 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 @@ -26,21 +52,18 @@ use Carp (); 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 '' @@ -51,81 +74,19 @@ BEGIN { 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; }); } =head1 METHODS -=head2 C<< new rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ] >> +=head2 C -Creates a new functor object that will use both the default and these user-specified rules. + my $functor = LaTeX::TikZ::Functor->new( + rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ], + ); + +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 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. @@ -134,7 +95,7 @@ The default set and mod rules clone their relevant objects, so you get a clone f 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( @@ -168,6 +129,9 @@ Thus, if you define your own L or L object, =cut +my @default_set_rules; +my @default_mod_rules; + sub new { my ($class, %args) = @_; @@ -178,12 +142,21 @@ sub new { while (@user_rules) { my ($spec, $handler) = splice @user_rules, 0, 2; - my $rule = $validate_rule->($spec, $handler); + my ($target, $replace) = $validate_spec->($spec); + + my $rule = LaTeX::TikZ::Functor::Rule->new( + target => $target, + handler => $handler, + ); - $insert_rule->($rule, $rule->[4] ? \@set_rules : \@mod_rules, 1); + $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; @@ -195,15 +168,16 @@ sub new { 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: @@ -211,20 +185,16 @@ 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; @@ -238,11 +208,13 @@ LaTeX::TikZ::Interface->register( }, ); -=head2 C<< default_rule $spec => $handler >> +=head2 C + + LaTeX::TikZ::Functor->default_rule($spec => $handler) 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 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. @@ -251,19 +223,25 @@ 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. +L, L. =head1 AUTHOR @@ -284,7 +262,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2010 Vincent Pit, all rights reserved. +Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.