bump all versions to 0.60
[gitmo/Moose.git] / lib / Moose / Util / TypeConstraints.pm
index f12c26b..f84b57e 100644 (file)
@@ -9,7 +9,7 @@ use List::MoreUtils qw( all );
 use Scalar::Util 'blessed';
 use Moose::Exporter;
 
-our $VERSION   = '0.57';
+our $VERSION   = '0.60';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -86,11 +86,11 @@ sub create_type_constraint_union {
     (scalar @type_constraint_names >= 2)
         || Moose->throw_error("You must pass in at least 2 type names to make a union");
 
-    my @type_constraints = sort {$a->name cmp $b->name} map {
+    my @type_constraints = map {
         find_or_parse_type_constraint($_) ||
          Moose->throw_error("Could not locate type constraint ($_) for the union");
     } @type_constraint_names;
-    
+
     return Moose::Meta::TypeConstraint::Union->new(
         type_constraints => \@type_constraints
     );
@@ -107,7 +107,7 @@ sub create_parameterized_type_constraint {
         my $base_type_tc = $REGISTRY->get_type_constraint($base_type);
         return _create_parameterized_type_constraint(
             $base_type_tc,
-            $type_parameter,
+            $type_parameter
         );
     } else {
         Moose->throw_error("Could not locate the base type ($base_type)");
@@ -118,16 +118,14 @@ sub _create_parameterized_type_constraint {
     my ( $base_type_tc, $type_parameter ) = @_;
     if ( $base_type_tc->can('parameterize') ) {
         return $base_type_tc->parameterize($type_parameter);
-    }
-    else {
+    } else {
         return Moose::Meta::TypeConstraint::Parameterized->new(
-            name   => $base_type_tc->name . '[' . $type_parameter . ']',
+            name => $base_type_tc->name . '[' . $type_parameter . ']',
             parent => $base_type_tc,
-            type_parameter =>
-                find_or_create_isa_type_constraint($type_parameter),
+            type_parameter => find_or_create_isa_type_constraint($type_parameter),
         );
     }
-}
+}                                       
 
 #should we also support optimized checks?
 sub create_class_type_constraint {
@@ -223,7 +221,7 @@ sub find_or_parse_type_constraint {
 }
 
 sub normalize_type_constraint_name {
-    my $type_constraint_name = shift @_;
+    my $type_constraint_name = shift;
     $type_constraint_name =~ s/\s//g;
     return $type_constraint_name;
 }
@@ -356,15 +354,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 )
@@ -376,37 +374,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 || '__ANON__',
         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)
@@ -457,19 +442,12 @@ sub _install_type_coercions ($$) {
     my $op_union = qr{ \s* \| \s* }x;
     my $union    = qr{ $type (?: $op_union $type )+ }x;
 
-    ## New Stuff for structured types.
-    my $comma = qr{,};
-    my $indirection = qr{=>};
-    my $divider_ops = qr{ $comma | $indirection }x;
-    my $structure_divider = qr{\s* $divider_ops \s*}x;    
-    my $structure_elements = qr{ ($type $structure_divider*)+ }x;
-
-    $any = qr{ $type | $union | $structure_elements }x;
+    $any = qr{ $type | $union }x;
 
     sub _parse_parameterized_type_constraint {
         { no warnings 'void'; $any; } # force capture of interpolated lexical
-        my($base, $elements) = ($_[0] =~ m{ $type_capture_parts }x);
-        return ($base,$elements);
+        $_[0] =~ m{ $type_capture_parts }x;
+        return ($1, $2);
     }
 
     sub _detect_parameterized_type_constraint {