bump version to 0.91

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

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index daef718..b0ecf5c 100644 (file)
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -1,15 +1,12 @@
 
 package Moose::Util::TypeConstraints;
 
-use strict;
-use warnings;
-
 use Carp ();
 use List::MoreUtils qw( all any );
 use Scalar::Util qw( blessed reftype );
 use Moose::Exporter;
 
-our $VERSION = '0.73';
+our $VERSION = '0.91';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
@@ -35,6 +32,7 @@ use Moose::Meta::TypeConstraint::Parameterizable;
 use Moose::Meta::TypeConstraint::Class;
 use Moose::Meta::TypeConstraint::Role;
 use Moose::Meta::TypeConstraint::Enum;
+use Moose::Meta::TypeConstraint::DuckType;
 use Moose::Meta::TypeCoercion;
 use Moose::Meta::TypeCoercion::Union;
 use Moose::Meta::TypeConstraint::Registry;
@@ -362,26 +360,16 @@ sub maybe_type {
 }
 
 sub duck_type {
-    my ($type_name, @methods) = @_;
+    my ( $type_name, @methods ) = @_;
     if ( ref $type_name eq 'ARRAY' && !@methods ) {
-        @methods    = @$type_name;
+        @methods   = @$type_name;
         $type_name = undef;
     }
 
     register_type_constraint(
-        _create_type_constraint(
-            $type_name, 'Object',
-            sub {
-                my $obj = $_;
-                my @missing_methods = grep { !$obj->can($_) } @methods;
-                return ! scalar @missing_methods;
-            },
-            sub {
-                my $obj = $_;
-                my @missing_methods = grep { !$obj->can($_) } @methods;
-                return
-                    "${\blessed($obj)} is missing methods '@missing_methods'";
-            },
+        create_duck_type_constraint(
+            $type_name,
+            \@methods,
         )
     );
 }
@@ -445,6 +433,15 @@ sub create_enum_type_constraint {
     );
 }
 
+sub create_duck_type_constraint {
+    my ( $type_name, $methods ) = @_;
+
+    Moose::Meta::TypeConstraint::DuckType->new(
+        name => $type_name || '__ANON__',
+        methods => $methods,
+    );
+}
+
 ## --------------------------------------------------------
 ## desugaring functions ...
 ## --------------------------------------------------------
@@ -508,7 +505,7 @@ sub _install_type_coercions ($$) {
     my $type = find_type_constraint($type_name);
     ( defined $type )
         || __PACKAGE__->_throw_error(
-        "Cannot find type '$type_name', perhaps you forgot to load it.");
+        "Cannot find type '$type_name', perhaps you forgot to load it");
     if ( $type->has_coercion ) {
         $type->coercion->add_type_coercions(@$coercion_map);
     }
@@ -597,7 +594,7 @@ $_->make_immutable(
     # these are Class::MOP accessors, so they need inlining
     inline_accessors => 1
     ) for grep { $_->is_mutable }
-    map { $_->meta }
+    map { Class::MOP::class_of($_) }
     qw(
     Moose::Meta::TypeConstraint
     Moose::Meta::TypeConstraint::Union
@@ -606,11 +603,12 @@ $_->make_immutable(
     Moose::Meta::TypeConstraint::Class
     Moose::Meta::TypeConstraint::Role
     Moose::Meta::TypeConstraint::Enum
+    Moose::Meta::TypeConstraint::DuckType
     Moose::Meta::TypeConstraint::Registry
 );
 
 type 'Any'  => where {1};    # meta-type including all
-type 'Item' => where {1};    # base-type
+subtype 'Item' => as 'Any';  # base-type
 
 subtype 'Undef'   => as 'Item' => where { !defined($_) };
 subtype 'Defined' => as 'Item' => where { defined($_) };
@@ -627,7 +625,7 @@ subtype 'Ref' => as 'Defined' => where { ref($_) } =>
 subtype 'Str' => as 'Value' => where {1} =>
     optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
 
-subtype 'Num' => as 'Value' =>
+subtype 'Num' => as 'Str' =>
     where { Scalar::Util::looks_like_number($_) } =>
     optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num;
 
@@ -659,6 +657,7 @@ subtype 'Object' => as 'Ref' =>
     where { blessed($_) && blessed($_) ne 'Regexp' } =>
     optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object;
 
+# This type is deprecated.
 subtype 'Role' => as 'Object' => where { $_->can('does') } =>
     optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
 
@@ -669,8 +668,7 @@ subtype 'ClassName' => as 'Str' =>
     \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
 
 subtype 'RoleName' => as 'ClassName' => where {
-    ( ( $_->can('meta') || return )->($_) || return )
-        ->isa('Moose::Meta::Role');
+    (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
 } => optimize_as
     \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName;
 
@@ -851,10 +849,10 @@ that hierarchy represented visually.
       Defined
           Value
               Num
-                Int
+                  Int
               Str
-                ClassName
-                RoleName
+                  ClassName
+                  RoleName
           Ref
               ScalarRef
               ArrayRef[`a]
@@ -862,9 +860,8 @@ that hierarchy represented visually.
               CodeRef
               RegexpRef
               GlobRef
-                FileHandle
+                  FileHandle
               Object
-                Role
 
 B<NOTE:> Any type followed by a type parameter C<[`a]> can be
 parameterized, this means you can say:
@@ -890,8 +887,7 @@ 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.
+name> which is a role, like C<'MyApp::Role::Comparable'>.
 
 =head2 Type Constraint Naming
 
@@ -953,7 +949,7 @@ See the L<SYNOPSIS> for an example of how to use these.
 
 =over 4
 
-=item B<subtype 'Name' => as 'Parent' => where { } ...>
+=item B<< subtype 'Name' => as 'Parent' => where { } ... >>
 
 This creates a named subtype.
 
@@ -969,7 +965,7 @@ name and a hashref of parameters:
 The valid hashref keys are C<as> (the parent), C<where>, C<message>,
 and C<optimize_as>.
 
-=item B<subtype as 'Parent' => where { } ...>
+=item B<< subtype as 'Parent' => where { } ... >>
 
 This creates an unnamed subtype and will return the type
 constraint meta-object, which will be an instance of
@@ -1009,7 +1005,7 @@ recommend that you use a C<requires>-only Role instead.
 
 If passed an ARRAY reference instead of the C<$name>, C<@methods>
 pair, this will create an unnamed duck type. This can be used in an
-attribute definiton like so:
+attribute definition like so:
 
   has 'cache' => (
       is  => 'ro',
@@ -1071,7 +1067,7 @@ B<NOTE:> You should only use this if you know what you are doing,
 all the built in types use this, so your subtypes (assuming they
 are shallow) will not likely need to use this.
 
-=item B<type 'Name' => where { } ... >
+=item B<< type 'Name' => where { } ... >>
 
 This creates a base type, which has no parent.
 
@@ -1181,6 +1177,11 @@ L<Moose::Meta::TypeConstraint::Role> constructor (as a hash).
 Given a enum name this function will create a new
 L<Moose::Meta::TypeConstraint::Enum> object for that enum name.
 
+=item B<create_duck_type_constraint($name, $methods)>
+
+Given a duck type name this function will create a new
+L<Moose::Meta::TypeConstraint::DuckType> object for that enum name.
+
 =item B<find_or_parse_type_constraint($type_name)>
 
 Given a type name, this first attempts to find a matching constraint