sub list_all_type_constraints { keys %TYPE }
}
+# is-a predicates
+BEGIN{
+ _generate_class_type_for('Mouse::Meta::TypeConstraint' => '_is_a_type_constraint');
+ _generate_class_type_for('Mouse::Meta::Class' => '_is_a_metaclass');
+ _generate_class_type_for('Mouse::Meta::Role' => '_is_a_metarole');
+}
+
+
sub _create_type{
my $mode = shift;
if ($conf && $conf->{class}) {
# No, you're using this wrong
warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
- _create_type 'type', $name => (
+ _create_type 'subtype', $name => (
as => $conf->{class},
type => 'Class',
);
}
else {
- _create_type 'type', $name => (
- optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },
+ _create_type 'subtype', $name => (
+ as => 'Object',
+ optimized_as => _generate_class_type_for($name),
type => 'Class',
);
sub role_type {
my($name, $conf) = @_;
my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
- _create_type 'type', $name => (
+ _create_type 'subtype', $name => (
+ as => 'Object',
optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
type => 'Role',
return;
}
- my $check;
- my $type;
- if($meta->isa('Mouse::Meta::Role')){
- $check = sub{
- return blessed($_[0]) && $_[0]->does($spec);
- };
- $type = 'Role';
+ if(_is_a_metarole($meta)){
+ return role_type($spec);
}
else{
- $check = sub{
- return blessed($_[0]) && $_[0]->isa($spec);
- };
- $type = 'Class';
+ return class_type($spec);
}
-
- return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
- name => $spec,
- optimized => $check,
-
- type => $type,
- );
}
$TYPE{ArrayRef}{constraint_generator} = sub {
sub find_type_constraint {
my($spec) = @_;
- return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
+ return $spec if _is_a_type_constraint($spec);
$spec =~ s/\s+//g;
return $TYPE{$spec};
sub find_or_parse_type_constraint {
my($spec) = @_;
- return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');
+ return $spec if _is_a_type_constraint($spec);
$spec =~ s/\s+//g;
return $TYPE{$spec} || do{