changes-and-comments

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

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 0a81da0..68ed3ee 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -15,7 +15,7 @@ use Moose::Meta::TypeCoercion;
 {
     require Sub::Exporter;
     
-    my @exports = qw[type subtype as where message coerce from via find_type_constraint];
+    my @exports = qw[type subtype as where message coerce from via find_type_constraint enum];
 
     Sub::Exporter->import( 
         -setup => { 
@@ -69,6 +69,15 @@ use Moose::Meta::TypeCoercion;
         $type->coercion($type_coercion);
     }
     
+    sub create_type_constraint_union {
+        my (@type_constraint_names) = @_;
+        return Moose::Meta::TypeConstraint->union(
+            map { 
+                find_type_constraint($_) 
+            } @type_constraint_names
+        );
+    }
+    
     sub export_type_contstraints_as_functions {
         my $pkg = caller();
            no strict 'refs';
@@ -101,6 +110,16 @@ sub where   (&) { $_[0] }
 sub via     (&) { $_[0] }
 sub message (&) { $_[0] }
 
+sub enum {
+    my ($type_name, @values) = @_;
+    my $regexp = join '|' => @values;
+       _create_type_constraint(
+           $type_name,
+           'Str',
+           sub { qr/^$regexp$/i }
+       );    
+}
+
 # define some basic types
 
 type 'Any'  => where { 1 }; # meta-type including all
@@ -109,23 +128,19 @@ type 'Item' => where { 1 }; # base-type
 subtype 'Undef'   => as 'Item' => where { !defined($_) };
 subtype 'Defined' => as 'Item' => where {  defined($_) };
 
-subtype 'Value' => as 'Item' => where { !ref($_) };
-subtype 'Ref'   => as 'Item' => where {  ref($_) };
-
 subtype 'Bool'  => as 'Item' => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' };
 
-subtype 'Str' => as 'Value' => where { defined($_) };
+subtype 'Value' => as 'Defined' => where { !ref($_) };
+subtype 'Ref'   => as 'Defined' => where {  ref($_) };
+
+subtype 'Str' => as 'Value' => where { 1 };
 
 subtype 'Num' => as 'Value' => where { Scalar::Util::looks_like_number($_) };
-subtype 'Int' => as 'Num'   => where { "$_" =~ /^[0-9]+$/ };
+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' };      
 
@@ -163,6 +178,8 @@ Moose::Util::TypeConstraints - Type constraint system for Moose
   coerce Num 
       => from Str
         => via { 0+$_ }; 
+        
+  enum RGBColors => qw(red green blue);
 
 =head1 DESCRIPTION
 
@@ -185,23 +202,22 @@ This module also provides a simple hierarchy for Perl 5 types, this
 could probably use some work, but it works for me at the moment.
 
   Any
-  
   Item 
+      Bool
       Undef
       Defined
-      Bool
-      Value
-          Int
-          Str
-      Ref
-          ScalarRef
-          CollectionRef
+          Value
+              Num
+                Int
+              Str
+          Ref
+              ScalarRef
               ArrayRef
               HashRef
-          CodeRef
-          RegexpRef
-          Object       
-              Role
+              CodeRef
+              RegexpRef
+              Object   
+                  Role
 
 Suggestions for improvement are welcome.
     
@@ -216,6 +232,11 @@ Suggestions for improvement are welcome.
 This function can be used to locate a specific type constraint 
 meta-object. What you do with it from there is up to you :)
 
+=item B<create_type_constraint_union (@type_constraint_names)>
+
+Given a list of C<@type_constraint_names>, this will return a 
+B<Moose::Meta::TypeConstraint::Union> instance.
+
 =item B<export_type_contstraints_as_functions>
 
 This will export all the current type constraints as functions 
@@ -248,6 +269,8 @@ This creates an unnamed subtype and will return the type
 constraint meta-object, which will be an instance of 
 L<Moose::Meta::TypeConstraint>. 
 
+=item B<enum ($name, @values)>
+
 =item B<as>
 
 This is just sugar for the type constraint construction syntax.