X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=1ccdae16c8f0ebdc852b2cd4eb05eb955077fc15;hb=2a96ea8598dea995d57fa05e73cf2d42cf567e28;hp=f860c9c18478aa96a17c85277243dbb464ce7e50;hpb=f7e41edaceee0d549a2d664378cfcf85dcf9454b;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index f860c9c..1ccdae1 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_08 +This document describes Mouse version 0.44 =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