X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FPurePerl.pm;h=32616b09bc2788d4ec4e17cabbb877876ec92fb0;hp=b2c4b67a5b4b90ffeab5bf673fa399df121a936b;hb=619338ac4245c7c523d67645d6cd51cb982d4841;hpb=916eb82f3c42778bdb39cf0d9b1922ca1a264723 diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index b2c4b67..32616b0 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -124,6 +124,41 @@ sub Object { blessed($_[0]) && blessed($_[0]) ne 'Regexp' } sub ClassName { Mouse::Util::is_class_loaded($_[0]) } sub RoleName { (Mouse::Util::class_of($_[0]) || return 0)->isa('Mouse::Meta::Role') } +sub _parameterize_ArrayRef_for { + my($type_parameter) = @_; + my $check = $type_parameter->_compiled_type_constraint; + + return sub { + foreach my $value (@{$_}) { + return undef unless $check->($value); + } + return 1; + } +} + +sub _parameterize_HashRef_for { + 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 +sub _parameterize_Maybe_for { + my($type_parameter) = @_; + my $check = $type_parameter->_compiled_type_constraint; + + return sub{ + return !defined($_) || $check->($_); + }; +}; + + package Mouse::Meta::Module;