use Mouse::Util qw(does_role not_supported); # enables strict and warnings
use Carp qw(confess);
-use Scalar::Util qw(blessed);
+use Scalar::Util ();
use Mouse::Meta::TypeConstraint;
use Mouse::Exporter;
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;
my $class = $options->{class} || $name;
return _create_type 'subtype', $name => (
as => 'Object',
- optimized_as => _generate_class_type_for($class),
+ optimized_as => Mouse::Util::generate_isa_predicate_for($class),
type => 'Class',
);
my $role = $options->{role} || $name;
return _create_type 'subtype', $name => (
as => 'Object',
- optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },
+ optimized_as => sub { Scalar::Util::blessed($_[0]) && does_role($_[0], $role) },
type => 'Role',
);
my $meta = Mouse::Util::get_metaclass_by_name($spec)
or return undef;
- if(_is_a_metarole($meta)){
+ if(Mouse::Util::is_a_metarole($meta)){
return role_type($spec);
}
else{
}
}
-$TYPE{ArrayRef}{constraint_generator} = sub {
- my($type_parameter) = @_;
- my $check = $type_parameter->_compiled_type_constraint;
-
- return sub{
- foreach my $value (@{$_}) {
- return undef unless $check->($value);
- }
- return 1;
- }
-};
-$TYPE{HashRef}{constraint_generator} = sub {
- my($type_parameter) = @_;
- my $check = $type_parameter->_compiled_type_constraint;
-
- return sub{
- foreach my $value(values %{$_}){
- return undef unless $check->($value);
- }
- return 1;
- };
-};
-
-# 'Maybe' type accepts 'Any', so it requires parameters
-$TYPE{Maybe}{constraint_generator} = sub {
- my($type_parameter) = @_;
- my $check = $type_parameter->_compiled_type_constraint;
-
- return sub{
- return !defined($_) || $check->($_);
- };
-};
+$TYPE{ArrayRef}{constraint_generator} = \&_parameterize_ArrayRef_for;
+$TYPE{HashRef}{constraint_generator} = \&_parameterize_HashRef_for;
+$TYPE{Maybe}{constraint_generator} = \&_parameterize_Maybe_for;
sub _find_or_create_parameterized_type{
my($base, $param) = @_;
my $name = sprintf '%s[%s]', $base->name, $param->name;
- $TYPE{$name} ||= do{
- my $generator = $base->{constraint_generator};
-
- if(!$generator){
- confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
- }
-
- Mouse::Meta::TypeConstraint->new(
- name => $name,
- parent => $base,
- constraint => $generator->($param),
-
- type => 'Parameterized',
- );
- }
+ $TYPE{$name} ||= $base->parameterize($param, $name);
}
+
sub _find_or_create_union_type{
- my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
+ my @types = sort map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
my $name = join '|', @types;
- $TYPE{$name} ||= do{
- return Mouse::Meta::TypeConstraint->new(
- name => $name,
- type_constraints => \@types,
+ $TYPE{$name} ||= Mouse::Meta::TypeConstraint->new(
+ name => $name,
+ type_constraints => \@types,
- type => 'Union',
- );
- };
+ type => 'Union',
+ );
}
# The type parser
sub find_type_constraint {
my($spec) = @_;
- return $spec if _is_a_type_constraint($spec);
+ return $spec if Mouse::Util::is_a_type_constraint($spec);
$spec =~ s/\s+//g;
return $TYPE{$spec};
sub find_or_parse_type_constraint {
my($spec) = @_;
- return $spec if _is_a_type_constraint($spec);
+ return $spec if Mouse::Util::is_a_type_constraint($spec);
$spec =~ s/\s+//g;
return $TYPE{$spec} || do{
}
1;
-
__END__
=head1 NAME
=head1 VERSION
-This document describes Mouse version 0.40_01
+This document describes Mouse version 0.42
=head2 SYNOPSIS