X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=2b2d558c4f04efe7f795e1050a91661a6412a1cc;hp=be2ddafb7007166fb2c606439433c4f772c4472b;hb=f152b0997e523b60b2dbcefff8d102fc1096bf49;hpb=e3540312c014bf730083fab1d0af13c002691115 diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index be2ddaf..2b2d558 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -184,16 +184,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]} }, @@ -217,38 +213,9 @@ sub _find_or_create_regular_type{ } } -$TYPE{ArrayRef}{constraint_generator} = sub { - my($type_parameter) = @_; - my $check = $type_parameter->_compiled_type_constraint; - - return sub{ - foreach my $value (@{$_}) { - return undef unless $check->($value); - } - return 1; - } -}; -$TYPE{HashRef}{constraint_generator} = sub { - my($type_parameter) = @_; - my $check = $type_parameter->_compiled_type_constraint; - - return sub{ - foreach my $value(values %{$_}){ - return undef unless $check->($value); - } - return 1; - }; -}; - -# 'Maybe' type accepts 'Any', so it requires parameters -$TYPE{Maybe}{constraint_generator} = sub { - my($type_parameter) = @_; - my $check = $type_parameter->_compiled_type_constraint; - - return sub{ - return !defined($_) || $check->($_); - }; -}; +$TYPE{ArrayRef}{constraint_generator} = \&_parameterize_ArrayRef_for; +$TYPE{HashRef}{constraint_generator} = \&_parameterize_HashRef_for; +$TYPE{Maybe}{constraint_generator} = \&_parameterize_Maybe_for; sub _find_or_create_parameterized_type{ my($base, $param) = @_; @@ -371,7 +338,6 @@ sub find_or_create_isa_type_constraint { } 1; - __END__ =head1 NAME @@ -380,7 +346,7 @@ Mouse::Util::TypeConstraints - Type constraint system for Mouse =head1 VERSION -This document describes Mouse version 0.40_03 +This document describes Mouse version 0.43 =head2 SYNOPSIS @@ -448,18 +414,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] @@ -467,7 +433,7 @@ that hierarchy represented visually. CodeRef RegexpRef GlobRef - FileHandle + FileHandle Object B Any type followed by a type parameter C<[`a]> can be