X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=a3645e1eaaf3d8edcbfef711f3c4a24ac74ac22c;hb=5d3ab42b8c257acdf05ce9ac602ec16a5923a879;hp=b47a93b6a3355e839ff9f29f8817b48af248fc62;hpb=1e5823974a557bd35b4aa4a5c1d1aecf1e5483d2;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index b47a93b..a3645e1 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -11,7 +11,11 @@ Mouse::Exporter->setup_import_methods( as_is => [qw( as where message optimize_as from via - type subtype coerce class_type role_type enum + + type subtype class_type role_type duck_type + enum + coerce + find_type_constraint )], ); @@ -172,6 +176,22 @@ sub role_type { ); } +sub duck_type { + my($name, @methods); + + if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){ + $name = shift; + } + + @methods = (@_ == 1 && ref($_[0]) eq 'ARRAY') ? @{$_[0]} : @_; + + return _create_type 'type', $name => ( + optimized_as => Mouse::Util::generate_can_predicate_for(\@methods), + + type => 'DuckType', + ); +} + sub typecast_constraints { # DEPRECATED my($class, $pkg, $type, $value) = @_; Carp::croak("wrong arguments count") unless @_ == 4; @@ -184,16 +204,12 @@ sub typecast_constraints { # DEPRECATED sub enum { my($name, %valid); - # enum ['small', 'medium', 'large'] - if (ref($_[0]) eq 'ARRAY') { - %valid = map{ $_ => undef } @{ $_[0] }; - $name = sprintf '(%s)', join '|', sort @{$_[0]}; - } - # enum size => 'small', 'medium', 'large' - else{ - $name = shift; - %valid = map{ $_ => undef } @_; + if(!(@_ == 1 && ref($_[0]) eq 'ARRAY')){ + $name = shift; } + + %valid = map{ $_ => undef } (@_ == 1 && ref($_[0]) eq 'ARRAY' ? @{$_[0]} : @_); + return _create_type 'type', $name => ( optimized_as => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} }, @@ -342,7 +358,6 @@ sub find_or_create_isa_type_constraint { } 1; - __END__ =head1 NAME @@ -351,7 +366,7 @@ Mouse::Util::TypeConstraints - Type constraint system for Mouse =head1 VERSION -This document describes Mouse version 0.40_06 +This document describes Mouse version 0.43 =head2 SYNOPSIS @@ -419,18 +434,18 @@ yet to have been created, is to quote the type name: This module also provides a simple hierarchy for Perl 5 types, here is that hierarchy represented visually. - Any + Any Item Bool Maybe[`a] Undef Defined Value - Num - Int Str - ClassName - RoleName + Num + Int + ClassName + RoleName Ref ScalarRef ArrayRef[`a] @@ -438,7 +453,7 @@ that hierarchy represented visually. CodeRef RegexpRef GlobRef - FileHandle + FileHandle Object B Any type followed by a type parameter C<[`a]> can be @@ -524,16 +539,26 @@ Returns the names of all the type constraints. =over 4 -=item C<< subtype 'Name' => as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >> +=item C<< type $name => where { } ... -> Mouse::Meta::TypeConstraint >> -=item C<< subtype as 'Parent' => where { } ... -> Mouse::Meta::TypeConstraint >> +=item C<< subtype $name => as $parent => where { } ... -> Mouse::Meta::TypeConstraint >> + +=item C<< subtype as $parent => where { } ... -> Mouse::Meta::TypeConstraint >> =item C<< class_type ($class, ?$options) -> Mouse::Meta::TypeConstraint >> =item C<< role_type ($role, ?$options) -> Mouse::Meta::TypeConstraint >> +=item C<< duck_type($name, @methods | \@methods) -> Mouse::Meta::TypeConstraint >> + +=item C<< duck_type(\@methods) -> Mouse::Meta::TypeConstraint >> + +=item C<< enum($name, @values | \@values) -> Mouse::Meta::TypeConstraint >> + =item C<< enum (\@values) -> Mouse::Meta::TypeConstraint >> +=item C<< coerce $type => from $another_type, via { }, ... >> + =back =over 4