Always load Mouse::Util first, which will be load Mouse::XS in the future
[gitmo/Mouse.git] / lib / Mouse / Util / TypeConstraints.pm
index 3ed075d..a11a478 100644 (file)
@@ -5,6 +5,8 @@ use base 'Exporter';
 
 use Carp ();
 use Scalar::Util qw/blessed looks_like_number openhandle/;
+
+use Mouse::Util;
 use Mouse::Meta::TypeConstraint;
 
 our @EXPORT = qw(
@@ -18,19 +20,17 @@ my %COERCE;
 my %COERCE_KEYS;
 
 sub as ($) {
-    as => $_[0]
+    return(as => $_[0]);
 }
 sub where (&) {
-    where => $_[0]
+    return(where => $_[0])
 }
 sub message (&) {
-    message => $_[0]
+    return(message => $_[0])
 }
 
 sub from { @_ }
-sub via (&) {
-    $_[0]
-}
+sub via (&) { $_[0] }
 
 BEGIN {
     no warnings 'uninitialized';
@@ -78,9 +78,10 @@ BEGIN {
 sub type {
     my $pkg = caller(0);
     my($name, %conf) = @_;
+
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
-    };
+    }
     my $constraint = $conf{where} || do {
         my $as = delete $conf{as} || 'Any';
         if (! exists $TYPE{$as}) {
@@ -104,13 +105,25 @@ sub type {
 }
 
 sub subtype {
-    my $pkg = caller(0);
-    my($name, %conf) = @_;
+    my $pkg = caller;
+
+    my $name;
+    my %conf;
+
+    if(@_ % 2){ # odd number of arguments
+        $name = shift;
+        %conf = @_;
+    }
+    else{
+        %conf = @_;
+        $name = $conf{name} || '__ANON__';
+    }
+
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     };
-    my $constraint = $conf{where};
-    my $as_constraint = find_or_create_isa_type_constraint($conf{as} || 'Any');
+    my $constraint = delete $conf{where};
+    my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any');
 
     $TYPE_SOURCE{$name} = $pkg;
     $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
@@ -126,13 +139,14 @@ sub subtype {
                 $as_constraint->check($_[0]);
             }
         ),
+        %conf
     );
 
     return $name;
 }
 
 sub coerce {
-    my($name, %conf) = @_;
+    my $name = shift;
 
     Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
         unless $TYPE{$name};
@@ -141,7 +155,8 @@ sub coerce {
         $COERCE{$name}      = {};
         $COERCE_KEYS{$name} = [];
     }
-    while (my($type, $code) = each %conf) {
+
+    while (my($type, $code) = splice @_, 0, 2) {
         Carp::croak "A coercion action already exists for '$type'"
             if $COERCE{$name}->{$type};
 
@@ -157,6 +172,7 @@ sub coerce {
         push @{ $COERCE_KEYS{$name} }, $type;
         $COERCE{$name}->{$type} = $code;
     }
+    return;
 }
 
 sub class_type {
@@ -307,6 +323,13 @@ sub find_type_constraint {
 sub find_or_create_isa_type_constraint {
     my $type_constraint = shift;
 
+    Carp::confess("Got isa => type_constraints, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef and Maybe (rt.cpan.org #39795)")
+        if $type_constraint =~ /\A ( [^\[]+ ) \[\.+\] \z/xms &&
+           $1 ne 'ArrayRef' &&
+           $1 ne 'HashRef'  &&
+           $1 ne 'Maybe'
+    ;
+
     my $code;
 
     $type_constraint =~ s/\s+//g;
@@ -342,7 +365,165 @@ __END__
 
 =head1 NAME
 
-Mouse::Util::TypeConstraints - simple type constraints
+Mouse::Util::TypeConstraints - Type constraint system for Mouse
+
+=head2 SYNOPSIS
+
+  use Mouse::Util::TypeConstraints;
+
+  subtype 'Natural'
+      => as 'Int'
+      => where { $_ > 0 };
+
+  subtype 'NaturalLessThanTen'
+      => as 'Natural'
+      => where { $_ < 10 }
+      => message { "This number ($_) is not less than ten!" };
+
+  coerce 'Num'
+      => from 'Str'
+        => via { 0+$_ };
+
+  enum 'RGBColors' => qw(red green blue);
+
+  no Mouse::Util::TypeConstraints;
+
+=head1 DESCRIPTION
+
+This module provides Mouse with the ability to create custom type
+constraints to be used in attribute definition.
+
+=head2 Important Caveat
+
+This is B<NOT> a type system for Perl 5. These are type constraints,
+and they are not used by Mouse unless you tell it to. No type
+inference is performed, expressions are not typed, etc. etc. etc.
+
+A type constraint is at heart a small "check if a value is valid"
+function. A constraint can be associated with an attribute. This
+simplifies parameter validation, and makes your code clearer to read,
+because you can refer to constraints by name.
+
+=head2 Slightly Less Important Caveat
+
+It is B<always> a good idea to quote your type names.
+
+This prevents Perl from trying to execute the call as an indirect
+object call. This can be an issue when you have a subtype with the
+same name as a valid class.
+
+For instance:
+
+  subtype DateTime => as Object => where { $_->isa('DateTime') };
+
+will I<just work>, while this:
+
+  use DateTime;
+  subtype DateTime => as Object => where { $_->isa('DateTime') };
+
+will fail silently and cause many headaches. The simple way to solve
+this, as well as future proof your subtypes from classes which have
+yet to have been created, is to quote the type name:
+
+  use DateTime;
+  subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') };
+
+=head2 Default Type Constraints
+
+This module also provides a simple hierarchy for Perl 5 types, here is
+that hierarchy represented visually.
+
+  Any
+  Item
+      Bool
+      Maybe[`a]
+      Undef
+      Defined
+          Value
+              Num
+                Int
+              Str
+                ClassName
+                RoleName
+          Ref
+              ScalarRef
+              ArrayRef[`a]
+              HashRef[`a]
+              CodeRef
+              RegexpRef
+              GlobRef
+                FileHandle
+              Object
+                Role
+
+B<NOTE:> Any type followed by a type parameter C<[`a]> can be
+parameterized, this means you can say:
+
+  ArrayRef[Int]    # an array of integers
+  HashRef[CodeRef] # a hash of str to CODE ref mappings
+  Maybe[Str]       # value may be a string, may be undefined
+
+If Mouse finds a name in brackets that it does not recognize as an
+existing type, it assumes that this is a class name, for example
+C<ArrayRef[DateTime]>.
+
+B<NOTE:> Unless you parameterize a type, then it is invalid to include
+the square brackets. I.e. C<ArrayRef[]> will be treated as a new type
+name, I<not> as a parameterization of C<ArrayRef>.
+
+B<NOTE:> The C<Undef> type constraint for the most part works
+correctly now, but edge cases may still exist, please use it
+sparingly.
+
+B<NOTE:> The C<ClassName> type constraint does a complex package
+existence check. This means that your class B<must> be loaded for this
+type constraint to pass.
+
+B<NOTE:> The C<RoleName> constraint checks a string is a I<package
+name> which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
+constraint checks that an I<object does> the named role.
+
+=head2 Type Constraint Naming
+
+Type name declared via this module can only contain alphanumeric
+characters, colons (:), and periods (.).
+
+Since the types created by this module are global, it is suggested
+that you namespace your types just as you would namespace your
+modules. So instead of creating a I<Color> type for your
+B<My::Graphics> module, you would call the type
+I<My::Graphics::Types::Color> instead.
+
+=head2 Use with Other Constraint Modules
+
+This module can play nicely with other constraint modules with some
+slight tweaking. The C<where> clause in types is expected to be a
+C<CODE> reference which checks it's first argument and returns a
+boolean. Since most constraint modules work in a similar way, it
+should be simple to adapt them to work with Mouse.
+
+For instance, this is how you could use it with
+L<Declare::Constraints::Simple> to declare a completely new type.
+
+  type 'HashOfArrayOfObjects',
+      {
+      where => IsHashRef(
+          -keys   => HasLength,
+          -values => IsArrayRef(IsObject)
+      )
+  };
+
+Here is an example of using L<Test::Deep> and it's non-test
+related C<eq_deeply> function.
+
+  type 'ArrayOfHashOfBarsAndRandomNumbers'
+      => where {
+          eq_deeply($_,
+              array_each(subhashof({
+                  bar           => isa('Bar'),
+                  random_number => ignore()
+              })))
+        };
 
 =head1 METHODS
 
@@ -366,6 +547,10 @@ Returns the simple type constraints that Mouse understands.
 
 =back
 
+=head1 THANKS
+
+Much of this documentation was taken from L<Moose::Util::TypeConstraints>
+
 =cut