1 package Moose::Meta::TypeConstraint::Role;
8 use Scalar::Util 'blessed';
9 use Moose::Util::TypeConstraints ();
11 use base 'Moose::Meta::TypeConstraint';
13 __PACKAGE__->meta->add_attribute('role' => (
15 Class::MOP::_definition_context(),
22 return 'Moose::Util::does_role('
24 . B::perlstring($self->role)
29 my ( $class, %args ) = @_;
31 $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object');
33 my $role_name = $args{role};
34 $args{constraint} = sub { Moose::Util::does_role( $_[0], $role_name ) };
36 $args{inlined} = $inliner;
38 my $self = $class->SUPER::new( \%args );
40 $self->_create_hand_optimized_type_constraint;
41 $self->compile_type_constraint();
46 sub _create_hand_optimized_type_constraint {
48 my $role = $self->role;
49 $self->hand_optimized_type_constraint(
50 sub { Moose::Util::does_role($_[0], $role) }
59 # FIXME find_type_constraint might find a TC named after the role but that isn't really it
60 # I did this anyway since it's a convention that preceded TypeConstraint::Role, and it should DWIM
61 # if anybody thinks this problematic please discuss on IRC.
62 # a possible fix is to add by attr indexing to the type registry to find types of a certain property
63 # regardless of their name
64 Moose::Util::TypeConstraints::find_type_constraint($_)
66 __PACKAGE__->new( role => $_, name => "__ANON__" )
67 } @{ Class::MOP::class_of($self->role)->get_roles },
72 my ( $self, $type_or_name ) = @_;
74 my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
76 return unless defined $other;
77 return unless $other->isa(__PACKAGE__);
79 return $self->role eq $other->role;
83 my ($self, $type_or_name) = @_;
85 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
87 ($self->equals($type) || $self->is_subtype_of($type_or_name));
91 my ($self, $type_or_name_or_role ) = @_;
93 if ( not ref $type_or_name_or_role ) {
95 return 1 if Class::MOP::class_of($self->role)->does_role( $type_or_name_or_role );
98 my $type = Moose::Util::TypeConstraints::find_type_constraint($type_or_name_or_role);
100 return unless defined $type;
102 if ( $type->isa(__PACKAGE__) ) {
103 # if $type_or_name_or_role isn't a role, it might be the TC name of another ::Role type
104 # or it could also just be a type object in this branch
105 return Class::MOP::class_of($self->role)->does_role( $type->role );
107 # the only other thing we are a subtype of is Object
108 $self->SUPER::is_subtype_of($type);
112 sub create_child_type {
113 my ($self, @args) = @_;
114 return Moose::Meta::TypeConstraint->new(@args, parent => $self);
119 # ABSTRACT: Role/TypeConstraint parallel hierarchy
127 This class represents type constraints for a role.
131 C<Moose::Meta::TypeConstraint::Role> is a subclass of
132 L<Moose::Meta::TypeConstraint>.
138 =item B<< Moose::Meta::TypeConstraint::Role->new(%options) >>
140 This creates a new role type constraint based on the given
143 It takes the same options as its parent, with two exceptions. First,
144 it requires an additional option, C<role>, which is name of the
145 constraint's role. Second, it automatically sets the parent to the
148 The constructor also overrides the hand optimized type constraint with
149 one it creates internally.
151 =item B<< $constraint->role >>
153 Returns the role name associated with the constraint.
155 =item B<< $constraint->parents >>
157 Returns all the type's parent types, corresponding to the roles that
160 =item B<< $constraint->is_subtype_of($type_name_or_object) >>
162 If the given type is also a role type, then this checks that the
163 type's role does the other type's role.
165 Otherwise it falls back to the implementation in
166 L<Moose::Meta::TypeConstraint>.
168 =item B<< $constraint->create_child_type(%options) >>
170 This returns a new L<Moose::Meta::TypeConstraint> object with the type
173 Note that it does I<not> return a C<Moose::Meta::TypeConstraint::Role>
180 See L<Moose/BUGS> for details on reporting bugs.