use Moose::Meta::TypeCoercion::Union;
-our $VERSION = '0.82';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
+use List::MoreUtils qw(all);
+use List::Util qw(first);
use base 'Moose::Meta::TypeConstraint';
__PACKAGE__->meta->add_attribute('type_constraints' => (
accessor => 'type_constraints',
- default => sub { [] }
+ default => sub { [] },
+ Class::MOP::_definition_context(),
));
sub new {
);
$self->_set_constraint(sub { $self->check($_[0]) });
- $self->coercion(Moose::Meta::TypeCoercion::Union->new(
- type_constraint => $self
- ));
+
return $self;
}
+# XXX - this is a rather gross implementation of laziness for the benefit of
+# MX::Types. If we try to call ->has_coercion on the objects during object
+# construction, this does not work when defining a recursive constraint with
+# MX::Types.
+sub coercion {
+ my $self = shift;
+
+ return $self->{coercion} if exists $self->{coercion};
+
+ # Using any instead of grep here causes a weird error with some corner
+ # cases when MX::Types is in use. See RT #61001.
+ if ( grep { $_->has_coercion } @{ $self->type_constraints } ) {
+ return $self->{coercion} = Moose::Meta::TypeCoercion::Union->new(
+ type_constraint => $self );
+ }
+ else {
+ return $self->{coercion} = undef;
+ }
+}
+
+sub has_coercion {
+ return defined $_[0]->coercion;
+}
+
sub _actually_compile_type_constraint {
my $self = shift;
};
}
+sub can_be_inlined {
+ my $self = shift;
+
+ # This was originally done with all() from List::MoreUtils, but that
+ # caused some sort of bizarro parsing failure under 5.10.
+ for my $tc ( @{ $self->type_constraints } ) {
+ return 0 unless $tc->can_be_inlined;
+ }
+
+ return 1;
+}
+
+sub _inline_check {
+ my $self = shift;
+ my $val = shift;
+
+ return '('
+ . (
+ join ' || ', map { '(' . $_->_inline_check($val) . ')' }
+ @{ $self->type_constraints }
+ )
+ . ')';
+}
+
+sub inline_environment {
+ my $self = shift;
+
+ return { map { %{ $_->inline_environment } }
+ @{ $self->type_constraints } };
+}
sub equals {
my ( $self, $type_or_name ) = @_;
return @other_constraints == 0;
}
-sub parents {
+sub parent {
my $self = shift;
- $self->type_constraints;
+
+ my ($first, @rest) = @{ $self->type_constraints };
+
+ for my $parent ( $first->_collect_all_parents ) {
+ return $parent if all { $_->is_a_type_of($parent) } @rest;
+ }
+
+ return;
}
sub validate {
return ($message . ' in (' . $self->name . ')') ;
}
+sub find_type_for {
+ my ($self, $value) = @_;
+
+ return first { $_->check($value) } @{ $self->type_constraints };
+}
+
sub is_a_type_of {
my ($self, $type_name) = @_;
- foreach my $type (@{$self->type_constraints}) {
- return 1 if $type->is_a_type_of($type_name);
- }
- return 0;
+
+ return all { $_->is_a_type_of($type_name) } @{ $self->type_constraints };
}
sub is_subtype_of {
my ($self, $type_name) = @_;
- foreach my $type (@{$self->type_constraints}) {
- return 1 if $type->is_subtype_of($type_name);
- }
- return 0;
+
+ return all { $_->is_subtype_of($type_name) } @{ $self->type_constraints };
}
sub create_child_type {
1;
+# ABSTRACT: A union of Moose type constraints
+
__END__
=pod
-=head1 NAME
-
-Moose::Meta::TypeConstraint::Union - A union of Moose type constraints
-
=head1 DESCRIPTION
This metaclass represents a union of type constraints. A union takes
This returns the array reference of C<type_constraints> provided to
the constructor.
-=item B<< $constraint->parents >>
+=item B<< $constraint->parent >>
-This returns the same constraint as the C<type_constraints> method.
+This returns the nearest common ancestor of all the components of the union.
=item B<< $constraint->check($value) >>
A type is considered equal if it is also a union type, and the two
unions have the same member types.
+=item B<< $constraint->find_type_for($value) >>
+
+This returns the first member type constraint for which C<check($value)> is
+true, allowing you to determine which of the Union's member type constraints
+a given value matches.
+
=item B<< $constraint->is_a_type_of($type_name_or_object) >>
-This returns true if any of the member type constraints return true
+This returns true if all of the member type constraints return true
for the C<is_a_type_of> method.
=item B<< $constraint->is_subtype_of >>
-This returns true if any of the member type constraints return true
+This returns true if all of the member type constraints return true
for the C<is_a_subtype_of> method.
=item B<< $constraint->create_child_type(%options) >>
=head1 BUGS
-All complex software has bugs lurking in it, and this module is no
-exception. If you find a bug please either email me, or add the bug
-to cpan-RT.
-
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+See L<Moose/BUGS> for details on reporting bugs.
=cut