unions

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 61c2b62..8d3d1c0 100644 (file)
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -8,7 +8,7 @@ use metaclass;
 use Sub::Name 'subname';
 use Carp      'confess';
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 __PACKAGE__->meta->add_attribute('name'       => (reader => 'name'      ));
 __PACKAGE__->meta->add_attribute('parent'     => (reader => 'parent'    ));
@@ -34,7 +34,7 @@ sub new {
     return $self;
 }
 
-sub compile_type_constraint () {
+sub compile_type_constraint {
     my $self  = shift;
     my $check = $self->constraint;
     (defined $check)
@@ -72,11 +72,61 @@ sub validate {
             return $self->message->($value);
         }
         else {
-            return "Validation failed for '" . $self->name . "' failed.";
+            return "Validation failed for '" . $self->name . "' failed";
         }
     }
 }
 
+sub union {
+    my ($class, @type_constraints) = @_;
+    return Moose::Meta::TypeConstraint::Union->new(
+        type_constraints => \@type_constraints
+    );
+}
+
+package Moose::Meta::TypeConstraint::Union;
+
+use strict;
+use warnings;
+use metaclass;
+
+our $VERSION = '0.01';
+
+__PACKAGE__->meta->add_attribute('type_constraints' => (
+    accessor  => 'type_constraints',
+    default   => sub { [] }
+));
+
+sub new { 
+    my $class = shift;
+    my $self  = $class->meta->new_object(@_);
+    return $self;
+}
+
+sub name { join ' | ' => map { $_->name } @{$_[0]->type_constraints} }
+
+sub check {
+    my $self  = shift;
+    my $value = shift;
+    foreach my $type (@{$self->type_constraints}) {
+        return 1 if $type->check($value);
+    }
+    return undef;
+}
+
+sub validate {
+    my $self  = shift;
+    my $value = shift;
+    my $message;
+    foreach my $type (@{$self->type_constraints}) {
+        my $err = $type->validate($value);
+        return unless defined $err;
+        $message .= ($message ? ' and ' : '') . $err
+            if defined $err;
+    }
+    return ($message . ' in (' . $self->name . ')') ;    
+}
+
 1;
 
 __END__
@@ -136,6 +186,12 @@ the C<message> will be used to construct a custom error message.
 
 =back
 
+=over 4
+
+=item B<union (@type_constraints)>
+
+=back
+
 =head1 BUGS
 
 All complex software has bugs lurking in it, and this module is no 

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 4a9e4aa..3d6d7ba 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -120,12 +120,8 @@ subtype 'Num' => as 'Value' => where { Scalar::Util::looks_like_number($_) };
 subtype 'Int' => as 'Num'   => where { "$_" =~ /^[0-9]+$/ };
 
 subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' };
-
-subtype 'CollectionRef' => as 'Ref' => where { ref($_) eq 'ARRAY' || ref($_) eq 'HASH' };
-
-subtype 'ArrayRef' => as 'CollectionRef' => where { ref($_) eq 'ARRAY'  };
-subtype 'HashRef'  => as 'CollectionRef' => where { ref($_) eq 'HASH'   };     
-
+subtype 'ArrayRef'  => as 'Ref' => where { ref($_) eq 'ARRAY'  };
+subtype 'HashRef'   => as 'Ref' => where { ref($_) eq 'HASH'   };      
 subtype 'CodeRef'   => as 'Ref' => where { ref($_) eq 'CODE'   };
 subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' };      
 
@@ -195,9 +191,8 @@ could probably use some work, but it works for me at the moment.
               Str
           Ref
               ScalarRef
-              CollectionRef
-                  ArrayRef
-                  HashRef
+              ArrayRef
+              HashRef
               CodeRef
               RegexpRef
               Object   

diff --git a/t/050_util_type_constraints.t b/t/050_util_type_constraints.t
index 5d9e6d1..6316806 100644 (file)
--- a/t/050_util_type_constraints.t
+++ b/t/050_util_type_constraints.t
@@ -72,7 +72,7 @@ ok(!$natural->has_message, '... it does not have a message');
 ok(!defined($natural->validate(5)), '... validated successfully (no error)');
 
 is($natural->validate(-5), 
-  "Validation failed for 'Natural' failed.", 
+  "Validation failed for 'Natural' failed", 
   '... validated unsuccessfully (got error)');
 
 

diff --git a/t/052_util_std_type_constraints.t b/t/052_util_std_type_constraints.t
index e340b63..4a97f6c 100644 (file)
--- a/t/052_util_std_type_constraints.t
+++ b/t/052_util_std_type_constraints.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 205;
+use Test::More tests => 194;
 use Test::Exception;
 
 use Scalar::Util ();
@@ -153,18 +153,6 @@ ok(!defined ScalarRef(qr/../),           '... ScalarRef rejects anything which i
 ok(!defined ScalarRef(bless {}, 'Foo'),  '... ScalarRef rejects anything which is not a ScalarRef');
 ok(!defined ScalarRef(undef),            '... ScalarRef rejects anything which is not a ScalarRef');
 
-ok(!defined CollectionRef(0),                '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef(100),              '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef(''),               '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef('Foo'),            '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(defined CollectionRef([]),               '... CollectionRef accepts anything which is not a HASH or ARRAY');
-ok(defined CollectionRef({}),               '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef(sub {}),           '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef($SCALAR_REF),      '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef(qr/../),           '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef(bless {}, 'Foo'),  '... CollectionRef rejects anything which is not a HASH or ARRAY');
-ok(!defined CollectionRef(undef),            '... CollectionRef rejects anything which is not a HASH or ARRAY');
-
 ok(!defined ArrayRef(0),                '... ArrayRef rejects anything which is not a ArrayRef');
 ok(!defined ArrayRef(100),              '... ArrayRef rejects anything which is not a ArrayRef');
 ok(!defined ArrayRef(''),               '... ArrayRef rejects anything which is not a ArrayRef');

diff --git a/t/053_util_find_type_constraint.t b/t/053_util_find_type_constraint.t
index 9d77f39..b492250 100644 (file)
--- a/t/053_util_find_type_constraint.t
+++ b/t/053_util_find_type_constraint.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 18;
 use Test::Exception;
 
 BEGIN {
@@ -12,19 +12,22 @@ BEGIN {
 
 foreach my $type_name (qw(
     Any
+    Item 
         Bool
-        Value
-            Int
-            Str
-        Ref
-            ScalarRef
-            CollectionRef
+        Undef
+        Defined
+            Value
+                Num
+                  Int
+                Str
+            Ref
+                ScalarRef
                 ArrayRef
                 HashRef
-            CodeRef
-            RegexpRef
-            Object    
-                Role
+                CodeRef
+                RegexpRef
+                Object 
+                    Role
     )) {
     is(find_type_constraint($type_name)->name, 
        $type_name, 

diff --git a/t/057_union_types.t b/t/057_union_types.t
new file mode 100644 (file)
index 0000000..556d3e7
--- /dev/null
+++ b/t/057_union_types.t
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 27;
+use Test::Exception;
+
+BEGIN {
+    use_ok('Moose::Util::TypeConstraints');           
+}
+
+my $Str = find_type_constraint('Str');
+isa_ok($Str, 'Moose::Meta::TypeConstraint');
+
+my $Undef = find_type_constraint('Undef');
+isa_ok($Undef, 'Moose::Meta::TypeConstraint');
+
+ok(!$Str->check(undef), '... Str cannot accept an Undef value');
+ok($Str->check('String'), '... Str can accept an String value');
+ok(!$Undef->check('String'), '... Undef cannot accept an Str value');
+ok($Undef->check(undef), '... Undef can accept an Undef value');
+
+my $Str_or_Undef = Moose::Meta::TypeConstraint->union($Str, $Undef);
+isa_ok($Str_or_Undef, 'Moose::Meta::TypeConstraint::Union');
+
+ok($Str_or_Undef->check(undef), '... (Str | Undef) can accept an Undef value');
+ok($Str_or_Undef->check('String'), '... (Str | Undef) can accept a String value');
+
+# another ....
+
+my $ArrayRef = find_type_constraint('ArrayRef');
+isa_ok($ArrayRef, 'Moose::Meta::TypeConstraint');
+
+my $HashRef = find_type_constraint('HashRef');
+isa_ok($HashRef, 'Moose::Meta::TypeConstraint');
+
+ok($ArrayRef->check([]), '... ArrayRef can accept an [] value');
+ok(!$ArrayRef->check({}), '... ArrayRef cannot accept an {} value');
+ok($HashRef->check({}), '... HashRef can accept an {} value');
+ok(!$HashRef->check([]), '... HashRef cannot accept an [] value');
+
+my $HashOrArray = Moose::Meta::TypeConstraint->union($ArrayRef, $HashRef);
+isa_ok($HashOrArray, 'Moose::Meta::TypeConstraint::Union');
+
+ok($HashOrArray->check([]), '... (ArrayRef | HashRef) can accept []');
+ok($HashOrArray->check({}), '... (ArrayRef | HashRef) can accept {}');
+
+ok(!$HashOrArray->check(\(my $var1)), '... (ArrayRef | HashRef) cannot accept scalar refs');
+ok(!$HashOrArray->check(sub {}), '... (ArrayRef | HashRef) cannot accept code refs');
+ok(!$HashOrArray->check(50), '... (ArrayRef | HashRef) cannot accept Numbers');
+
+diag $HashOrArray->validate([]);
+
+ok(!defined($HashOrArray->validate([])), '... (ArrayRef | HashRef) can accept []');
+ok(!defined($HashOrArray->validate({})), '... (ArrayRef | HashRef) can accept {}');
+
+is($HashOrArray->validate(\(my $var2)), 'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept scalar refs');
+is($HashOrArray->validate(sub {}),      'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept code refs');
+is($HashOrArray->validate(50),          'Validation failed for \'ArrayRef\' failed and Validation failed for \'HashRef\' failed in (ArrayRef | HashRef)', '... (ArrayRef | HashRef) cannot accept Numbers');
+