bump version to 0.65

[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index a9c9310..5219091 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -9,7 +9,7 @@ use List::MoreUtils qw( all );
 use Scalar::Util 'blessed';
 use Moose::Exporter;
 
-our $VERSION   = '0.59';
+our $VERSION   = '0.65';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -47,7 +47,8 @@ use Moose::Util::TypeConstraints::OptimizedConstraints;
 Moose::Exporter->setup_import_methods(
     as_is => [
         qw(
-            type subtype class_type role_type as where message optimize_as
+            type subtype class_type role_type maybe_type
+            as where message optimize_as
             coerce from via
             enum
             find_type_constraint
@@ -301,6 +302,14 @@ sub role_type ($;$) {
     );
 }
 
+sub maybe_type {
+    my ($type_parameter) = @_;
+
+    register_type_constraint(
+        $REGISTRY->get_type_constraint('Maybe')->parameterize($type_parameter)
+    );
+}
+
 sub coerce {
     my ($type_name, @coercion_map) = @_;
     _install_type_coercions($type_name, \@coercion_map);
@@ -354,15 +363,15 @@ sub _create_type_constraint ($$$;$$) {
     my $parent = shift;
     my $check  = shift;
 
-    my ($message, $optimized);
+    my ( $message, $optimized );
     for (@_) {
         $message   = $_->{message}   if exists $_->{message};
         $optimized = $_->{optimized} if exists $_->{optimized};
     }
 
-    my $pkg_defined_in = scalar(caller(0));
+    my $pkg_defined_in = scalar( caller(0) );
 
-    if (defined $name) {
+    if ( defined $name ) {
         my $type = $REGISTRY->get_type_constraint($name);
 
         ( $type->_package_defined_in eq $pkg_defined_in )
@@ -374,37 +383,24 @@ sub _create_type_constraint ($$$;$$) {
             if defined $type;
     }
 
-    my $class = "Moose::Meta::TypeConstraint";
-
-    # FIXME should probably not be a special case
-    if ( defined $parent and $parent = find_or_parse_type_constraint($parent) ) {
-        $class = "Moose::Meta::TypeConstraint::Parameterizable"
-            if $parent->isa("Moose::Meta::TypeConstraint::Parameterizable");
-    }
-
-    my $constraint = $class->new(
-        name               => $name || '__ANON__',
+    my %opts = (
+        name => $name,
         package_defined_in => $pkg_defined_in,
 
-        ($parent    ? (parent     => $parent )   : ()),
-        ($check     ? (constraint => $check)     : ()),
-        ($message   ? (message    => $message)   : ()),
-        ($optimized ? (optimized  => $optimized) : ()),
+        ( $check     ? ( constraint => $check )     : () ),
+        ( $message   ? ( message    => $message )   : () ),
+        ( $optimized ? ( optimized  => $optimized ) : () ),
     );
 
-    # NOTE:
-    # if we have a type constraint union, and no
-    # type check, this means we are just aliasing
-    # the union constraint, which means we need to
-    # handle this differently.
-    # - SL
-    if (not(defined $check)
-        && $parent->isa('Moose::Meta::TypeConstraint::Union')
-        && $parent->has_coercion
-        ){
-        $constraint->coercion(Moose::Meta::TypeCoercion::Union->new(
-            type_constraint => $parent
-        ));
+    my $constraint;
+    if ( defined $parent
+        and $parent
+        = blessed $parent ? $parent : find_or_parse_type_constraint($parent) )
+    {
+        $constraint = $parent->create_child_type(%opts);
+    }
+    else {
+        $constraint = Moose::Meta::TypeConstraint->new(%opts);
     }
 
     $REGISTRY->add_type_constraint($constraint)
@@ -494,6 +490,27 @@ sub _install_type_coercions ($$) {
 # define some basic built-in types
 ## --------------------------------------------------------
 
+# By making these classes immutable before creating all the types we
+# below, we avoid repeatedly calling the slow MOP-based accessors.
+$_->make_immutable(
+    inline_constructor => 1,
+    constructor_name   => "_new",
+
+    # these are Class::MOP accessors, so they need inlining
+    inline_accessors => 1
+    ) for grep { $_->is_mutable }
+    map { $_->meta }
+    qw(
+    Moose::Meta::TypeConstraint
+    Moose::Meta::TypeConstraint::Union
+    Moose::Meta::TypeConstraint::Parameterized
+    Moose::Meta::TypeConstraint::Parameterizable
+    Moose::Meta::TypeConstraint::Class
+    Moose::Meta::TypeConstraint::Role
+    Moose::Meta::TypeConstraint::Enum
+    Moose::Meta::TypeConstraint::Registry
+);
+
 type 'Any'  => where { 1 }; # meta-type including all
 type 'Item' => where { 1 }; # base-type
 
@@ -837,6 +854,11 @@ L<Moose::Meta::TypeConstraint::Class>.
 Creates a type constraint with the name C<$role> and the metaclass
 L<Moose::Meta::TypeConstraint::Role>.
 
+=item B<maybe_type ($type)>
+
+Creates a type constraint for either C<undef> or something of the
+given type.
+
 =item B<enum ($name, @values)>
 
 This will create a basic subtype for a given set of strings.
@@ -972,7 +994,7 @@ C<find_or_create_does_type_constraint>.
 
 =item B<find_or_create_does_type_constraint ($type_name)>
 
-Attempts to parse the type name using L<find_or_parse_type_constraint> and if
+Attempts to parse the type name using C<find_or_parse_type_constraint> and if
 no appropriate constraint is found will create a new anonymous one.
 
 The C<isa> variant will use C<create_class_type_constraint> and the C<does>