X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=4ab0006902304a5a835adea991b9e8d9794e4ffb;hb=eea9eb4d0a9d6d7453cfb6fca6bb6aae618254c4;hp=ac6802c1598fb3184891efee934a1f94b8a913e3;hpb=2dd0aea3321408c61af5bb851fb9ca5ad33596ca;p=gitmo%2FMoose.git diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index ac6802c..4ab0006 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -1,17 +1,11 @@ package Moose::Util::TypeConstraints; -use strict; -use warnings; - use Carp (); -use Scalar::Util 'blessed'; +use List::MoreUtils qw( all any ); +use Scalar::Util qw( blessed reftype ); use Moose::Exporter; -our $VERSION = '0.57'; -$VERSION = eval $VERSION; -our $AUTHORITY = 'cpan:STEVAN'; - ## -------------------------------------------------------- # Prototyped subs must be predeclared because we have a # circular dependency with Moose::Meta::Attribute et. al. @@ -19,38 +13,16 @@ our $AUTHORITY = 'cpan:STEVAN'; # ensures the prototypes are in scope when consumers are # compiled. -# creation and location -sub find_type_constraint ($); -sub register_type_constraint ($); -sub find_or_create_type_constraint ($;$); -sub find_or_parse_type_constraint ($); -sub find_or_create_isa_type_constraint ($); -sub find_or_create_does_type_constraint ($); -sub create_type_constraint_union (@); -sub create_parameterized_type_constraint ($); -sub create_class_type_constraint ($;$); -sub create_role_type_constraint ($;$); -sub create_enum_type_constraint ($$); - # dah sugah! -sub type ($$;$$); -sub subtype ($$;$$$); -sub class_type ($;$); -sub coerce ($@); -sub as ($); -sub from ($); -sub where (&); -sub via (&); -sub message (&); +sub where (&); +sub via (&); +sub message (&); sub optimize_as (&); -sub enum ($;@); - -## private stuff ... -sub _create_type_constraint ($$$;$$); -sub _install_type_coercions ($$); +sub inline_as (&); ## -------------------------------------------------------- +use Moose::Deprecated; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeConstraint::Union; use Moose::Meta::TypeConstraint::Parameterized; @@ -58,21 +30,22 @@ 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; -use Moose::Util::TypeConstraints::OptimizedConstraints; Moose::Exporter->setup_import_methods( as_is => [ qw( - type subtype class_type role_type as where message optimize_as + type subtype class_type role_type maybe_type duck_type + as where message optimize_as inline_as coerce from via enum find_type_constraint - register_type_constraint ) + register_type_constraint + match_on_type ) ], - _export_to_main => 1, ); ## -------------------------------------------------------- @@ -81,84 +54,88 @@ Moose::Exporter->setup_import_methods( my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new; -sub get_type_constraint_registry { $REGISTRY } -sub list_all_type_constraints { keys %{$REGISTRY->type_constraints} } +sub get_type_constraint_registry {$REGISTRY} +sub list_all_type_constraints { keys %{ $REGISTRY->type_constraints } } + sub export_type_constraints_as_functions { my $pkg = caller(); no strict 'refs'; - foreach my $constraint (keys %{$REGISTRY->type_constraints}) { - my $tc = $REGISTRY->get_type_constraint($constraint)->_compiled_type_constraint; - *{"${pkg}::${constraint}"} = sub { $tc->($_[0]) ? 1 : undef }; # the undef is for compat + foreach my $constraint ( keys %{ $REGISTRY->type_constraints } ) { + my $tc = $REGISTRY->get_type_constraint($constraint) + ->_compiled_type_constraint; + *{"${pkg}::${constraint}"} + = sub { $tc->( $_[0] ) ? 1 : undef }; # the undef is for compat } } -sub create_type_constraint_union (@) { +sub create_type_constraint_union { my @type_constraint_names; - if (scalar @_ == 1 && _detect_type_constraint_union($_[0])) { - @type_constraint_names = _parse_type_constraint_union($_[0]); + if ( scalar @_ == 1 && _detect_type_constraint_union( $_[0] ) ) { + @type_constraint_names = _parse_type_constraint_union( $_[0] ); } else { @type_constraint_names = @_; } - (scalar @type_constraint_names >= 2) - || Moose->throw_error("You must pass in at least 2 type names to make a union"); + ( scalar @type_constraint_names >= 2 ) + || __PACKAGE__->_throw_error( + "You must pass in at least 2 type names to make a union"); - ($REGISTRY->has_type_constraint($_)) - || Moose->throw_error("Could not locate type constraint ($_) for the union") - foreach @type_constraint_names; + my @type_constraints = map { + find_or_parse_type_constraint($_) + || __PACKAGE__->_throw_error( + "Could not locate type constraint ($_) for the union"); + } @type_constraint_names; return Moose::Meta::TypeConstraint::Union->new( - type_constraints => [ - map { - $REGISTRY->get_type_constraint($_) - } @type_constraint_names - ], - ); + type_constraints => \@type_constraints ); } -sub create_parameterized_type_constraint ($) { +sub create_parameterized_type_constraint { my $type_constraint_name = shift; + my ( $base_type, $type_parameter ) + = _parse_parameterized_type_constraint($type_constraint_name); - my ($base_type, $type_parameter_str) = _parse_parameterized_type_constraint($type_constraint_name); + ( defined $base_type && defined $type_parameter ) + || __PACKAGE__->_throw_error( + "Could not parse type name ($type_constraint_name) correctly"); - (defined $base_type && defined $type_parameter_str) - || Moose->throw_error("Could not parse type name ($type_constraint_name) correctly"); - - if ($REGISTRY->has_type_constraint($base_type)) { + if ( $REGISTRY->has_type_constraint($base_type) ) { my $base_type_tc = $REGISTRY->get_type_constraint($base_type); return _create_parameterized_type_constraint( - $type_constraint_name, $base_type_tc, - $type_parameter_str, + $type_parameter ); - } else { - Moose->throw_error("Could not locate the base type ($base_type)"); + } + else { + __PACKAGE__->_throw_error( + "Could not locate the base type ($base_type)"); } } sub _create_parameterized_type_constraint { - my ($tc_name, $base_type_tc, $type_parameter_str) = @_; - my @type_parameters_tc = map {find_or_create_isa_type_constraint($_)} ($type_parameter_str); - if($base_type_tc->can('parameterize')) { - return $base_type_tc->parameterize($tc_name,@type_parameters_tc); - } else { + my ( $base_type_tc, $type_parameter ) = @_; + if ( $base_type_tc->can('parameterize') ) { + return $base_type_tc->parameterize($type_parameter); + } + else { return Moose::Meta::TypeConstraint::Parameterized->new( - name => $tc_name, - parent => $base_type_tc, - type_parameter => $type_parameters_tc[0], + name => $base_type_tc->name . '[' . $type_parameter . ']', + parent => $base_type_tc, + type_parameter => + find_or_create_isa_type_constraint($type_parameter), ); - } + } } #should we also support optimized checks? -sub create_class_type_constraint ($;$) { +sub create_class_type_constraint { my ( $class, $options ) = @_; - # too early for this check - #find_type_constraint("ClassName")->check($class) - # || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name"); +# too early for this check +#find_type_constraint("ClassName")->check($class) +# || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name"); my %options = ( class => $class, @@ -168,15 +145,15 @@ sub create_class_type_constraint ($;$) { $options{name} ||= "__ANON__"; - Moose::Meta::TypeConstraint::Class->new( %options ); + Moose::Meta::TypeConstraint::Class->new(%options); } -sub create_role_type_constraint ($;$) { +sub create_role_type_constraint { my ( $role, $options ) = @_; - # too early for this check - #find_type_constraint("ClassName")->check($class) - # || Moose->throw_error("Can't create a class type constraint because '$class' is not a class name"); +# too early for this check +#find_type_constraint("ClassName")->check($class) +# || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name"); my %options = ( role => $role, @@ -186,17 +163,18 @@ sub create_role_type_constraint ($;$) { $options{name} ||= "__ANON__"; - Moose::Meta::TypeConstraint::Role->new( %options ); + Moose::Meta::TypeConstraint::Role->new(%options); } - -sub find_or_create_type_constraint ($;$) { +sub find_or_create_type_constraint { my ( $type_constraint_name, $options_for_anon_type ) = @_; - if ( my $constraint = find_or_parse_type_constraint($type_constraint_name) ) { + if ( my $constraint + = find_or_parse_type_constraint($type_constraint_name) ) { return $constraint; } elsif ( defined $options_for_anon_type ) { + # NOTE: # if there is no $options_for_anon_type # specified, then we assume they don't @@ -217,39 +195,58 @@ sub find_or_create_type_constraint ($;$) { return; } -sub find_or_create_isa_type_constraint ($) { +sub find_or_create_isa_type_constraint { my $type_constraint_name = shift; - find_or_parse_type_constraint($type_constraint_name) || create_class_type_constraint($type_constraint_name) + find_or_parse_type_constraint($type_constraint_name) + || create_class_type_constraint($type_constraint_name); } -sub find_or_create_does_type_constraint ($) { +sub find_or_create_does_type_constraint { my $type_constraint_name = shift; - find_or_parse_type_constraint($type_constraint_name) || create_role_type_constraint($type_constraint_name) + find_or_parse_type_constraint($type_constraint_name) + || create_role_type_constraint($type_constraint_name); } -sub find_or_parse_type_constraint ($) { - my $type_constraint_name = shift; +sub find_or_parse_type_constraint { + my $type_constraint_name = normalize_type_constraint_name(shift); my $constraint; - - if ($constraint = find_type_constraint($type_constraint_name)) { + + if ( $constraint = find_type_constraint($type_constraint_name) ) { return $constraint; - } elsif (_detect_type_constraint_union($type_constraint_name)) { + } + elsif ( _detect_type_constraint_union($type_constraint_name) ) { $constraint = create_type_constraint_union($type_constraint_name); - } elsif (_detect_parameterized_type_constraint($type_constraint_name)) { - $constraint = create_parameterized_type_constraint($type_constraint_name); - } else { + } + elsif ( _detect_parameterized_type_constraint($type_constraint_name) ) { + $constraint + = create_parameterized_type_constraint($type_constraint_name); + } + else { return; } - + $REGISTRY->add_type_constraint($constraint); return $constraint; } +sub normalize_type_constraint_name { + my $type_constraint_name = shift; + $type_constraint_name =~ s/\s//g; + return $type_constraint_name; +} + +sub _confess { + my $error = shift; + + local $Carp::CarpLevel = $Carp::CarpLevel + 1; + Carp::confess($error); +} + ## -------------------------------------------------------- ## exported functions ... ## -------------------------------------------------------- -sub find_type_constraint ($) { +sub find_type_constraint { my $type = shift; if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) { @@ -261,39 +258,57 @@ sub find_type_constraint ($) { } } -sub register_type_constraint ($) { +sub register_type_constraint { my $constraint = shift; - Moose->throw_error("can't register an unnamed type constraint") unless defined $constraint->name; + __PACKAGE__->_throw_error("can't register an unnamed type constraint") + unless defined $constraint->name; $REGISTRY->add_type_constraint($constraint); return $constraint; } # type constructors -sub type ($$;$$) { - splice(@_, 1, 0, undef); - goto &_create_type_constraint; +sub type { + my $name = shift; + + my %p = map { %{$_} } @_; + + return _create_type_constraint( + $name, undef, $p{where}, $p{message}, + $p{optimize_as}, $p{inline_as}, + ); } -sub subtype ($$;$$$) { - # NOTE: - # this adds an undef for the name - # if this is an anon-subtype: - # subtype(Num => where { $_ % 2 == 0 }) # anon 'even' subtype - # but if the last arg is not a code - # ref then it is a subtype alias: - # subtype(MyNumbers => as Num); # now MyNumbers is the same as Num - # ... yeah I know it's ugly code - # - SL - unshift @_ => undef if scalar @_ <= 2 && ('CODE' eq ref($_[1])); - goto &_create_type_constraint; +sub subtype { + if ( @_ == 1 && !ref $_[0] ) { + __PACKAGE__->_throw_error( + 'A subtype cannot consist solely of a name, it must have a parent' + ); + } + + # The blessed check is mostly to accommodate MooseX::Types, which + # uses an object which overloads stringification as a type name. + my $name = ref $_[0] && !blessed $_[0] ? undef : shift; + + my %p = map { %{$_} } @_; + + # subtype Str => where { ... }; + if ( !exists $p{as} ) { + $p{as} = $name; + $name = undef; + } + + return _create_type_constraint( + $name, $p{as}, $p{where}, $p{message}, + $p{optimize_as}, $p{inline_as}, + ); } -sub class_type ($;$) { +sub class_type { register_type_constraint( create_class_type_constraint( $_[0], - ( defined($_[1]) ? $_[1] : () ), + ( defined( $_[1] ) ? $_[1] : () ), ) ); } @@ -302,37 +317,81 @@ sub role_type ($;$) { register_type_constraint( create_role_type_constraint( $_[0], - ( defined($_[1]) ? $_[1] : () ), + ( defined( $_[1] ) ? $_[1] : () ), ) ); } -sub coerce ($@) { - my ($type_name, @coercion_map) = @_; - _install_type_coercions($type_name, \@coercion_map); +sub maybe_type { + my ($type_parameter) = @_; + + register_type_constraint( + $REGISTRY->get_type_constraint('Maybe')->parameterize($type_parameter) + ); } -sub as ($) { $_[0] } -sub from ($) { $_[0] } -sub where (&) { $_[0] } -sub via (&) { $_[0] } +sub duck_type { + my ( $type_name, @methods ) = @_; + if ( ref $type_name eq 'ARRAY' && !@methods ) { + @methods = @$type_name; + $type_name = undef; + } + if ( @methods == 1 && ref $methods[0] eq 'ARRAY' ) { + @methods = @{ $methods[0] }; + } -sub message (&) { +{ message => $_[0] } } -sub optimize_as (&) { +{ optimized => $_[0] } } + register_type_constraint( + create_duck_type_constraint( + $type_name, + \@methods, + ) + ); +} + +sub coerce { + my ( $type_name, @coercion_map ) = @_; + _install_type_coercions( $type_name, \@coercion_map ); +} + +# The trick of returning @_ lets us avoid having to specify a +# prototype. Perl will parse this: +# +# subtype 'Foo' +# => as 'Str' +# => where { ... } +# +# as this: +# +# subtype( 'Foo', as( 'Str', where { ... } ) ); +# +# If as() returns all its extra arguments, this just works, and +# preserves backwards compatibility. +sub as { { as => shift }, @_ } +sub where (&) { { where => $_[0] } } +sub message (&) { { message => $_[0] } } +sub optimize_as (&) { { optimize_as => $_[0] } } +sub inline_as (&) { { inline_as => $_[0] } } + +sub from {@_} +sub via (&) { $_[0] } + +sub enum { + my ( $type_name, @values ) = @_; -sub enum ($;@) { - my ($type_name, @values) = @_; # NOTE: # if only an array-ref is passed then # you get an anon-enum # - SL - if (ref $type_name eq 'ARRAY' && !@values) { + if ( ref $type_name eq 'ARRAY' ) { + @values == 0 + || __PACKAGE__->_throw_error("enum called with an array reference and additional arguments. Did you mean to parenthesize the enum call's parameters?"); + @values = @$type_name; $type_name = undef; } - (scalar @values >= 2) - || Moose->throw_error("You must have at least two values to enumerate through"); - my %valid = map { $_ => 1 } @values; + if ( @values == 1 && ref $values[0] eq 'ARRAY' ) { + @values = @{ $values[0] }; + } register_type_constraint( create_enum_type_constraint( @@ -342,73 +401,109 @@ sub enum ($;@) { ); } -sub create_enum_type_constraint ($$) { +sub create_enum_type_constraint { my ( $type_name, $values ) = @_; Moose::Meta::TypeConstraint::Enum->new( - name => $type_name || '__ANON__', + name => $type_name || '__ANON__', values => $values, ); } +sub create_duck_type_constraint { + my ( $type_name, $methods ) = @_; + + Moose::Meta::TypeConstraint::DuckType->new( + name => $type_name || '__ANON__', + methods => $methods, + ); +} + +sub match_on_type { + my ($to_match, @cases) = @_; + my $default; + if (@cases % 2 != 0) { + $default = pop @cases; + (ref $default eq 'CODE') + || __PACKAGE__->_throw_error("Default case must be a CODE ref, not $default"); + } + while (@cases) { + my ($type, $action) = splice @cases, 0, 2; + + unless (blessed $type && $type->isa('Moose::Meta::TypeConstraint')) { + $type = find_or_parse_type_constraint($type) + || __PACKAGE__->_throw_error("Cannot find or parse the type '$type'") + } + + (ref $action eq 'CODE') + || __PACKAGE__->_throw_error("Match action must be a CODE ref, not $action"); + + if ($type->check($to_match)) { + local $_ = $to_match; + return $action->($to_match); + } + } + (defined $default) + || __PACKAGE__->_throw_error("No cases matched for $to_match"); + { + local $_ = $to_match; + return $default->($to_match); + } +} + + ## -------------------------------------------------------- ## desugaring functions ... ## -------------------------------------------------------- sub _create_type_constraint ($$$;$$) { - my $name = shift; - my $parent = shift; - my $check = shift; - - my ($message, $optimized); - for (@_) { - $message = $_->{message} if exists $_->{message}; - $optimized = $_->{optimized} if exists $_->{optimized}; - } + my $name = shift; + my $parent = shift; + my $check = shift; + my $message = shift; + my $optimized = shift; + my $inlined = shift; - my $pkg_defined_in = scalar(caller(0)); + my $pkg_defined_in = scalar( caller(1) ); - if (defined $name) { + if ( defined $name ) { my $type = $REGISTRY->get_type_constraint($name); - ($type->_package_defined_in eq $pkg_defined_in) - || confess ("The type constraint '$name' has already been created in " - . $type->_package_defined_in . " and cannot be created again in " - . $pkg_defined_in) - if defined $type; + ( $type->_package_defined_in eq $pkg_defined_in ) + || _confess( + "The type constraint '$name' has already been created in " + . $type->_package_defined_in + . " and cannot be created again in " + . $pkg_defined_in ) + if defined $type; + + $name =~ /^[\w:\.]+$/ + or die qq{$name contains invalid characters for a type name.} + . qq{ Names can contain alphanumeric character, ":", and "."\n}; } - my $class = "Moose::Meta::TypeConstraint"; - - # FIXME should probably not be a special case - if ( defined $parent and $parent = find_or_parse_type_constraint($parent) ) { - $class = "Moose::Meta::TypeConstraint::Parameterizable" - if $parent->isa("Moose::Meta::TypeConstraint::Parameterizable"); - } - - my $constraint = $class->new( - name => $name || '__ANON__', + my %opts = ( + name => $name, package_defined_in => $pkg_defined_in, - ($parent ? (parent => $parent ) : ()), - ($check ? (constraint => $check) : ()), - ($message ? (message => $message) : ()), - ($optimized ? (optimized => $optimized) : ()), + ( $check ? ( constraint => $check ) : () ), + ( $message ? ( message => $message ) : () ), + ( $optimized ? ( optimized => $optimized ) : () ), + ( $inlined ? ( inlined => $inlined ) : () ), ); - # NOTE: - # if we have a type constraint union, and no - # type check, this means we are just aliasing - # the union constraint, which means we need to - # handle this differently. - # - SL - if (not(defined $check) - && $parent->isa('Moose::Meta::TypeConstraint::Union') - && $parent->has_coercion - ){ - $constraint->coercion(Moose::Meta::TypeCoercion::Union->new( - type_constraint => $parent - )); + my $constraint; + if ( + defined $parent + and $parent + = blessed $parent + ? $parent + : find_or_create_isa_type_constraint($parent) + ) { + $constraint = $parent->create_child_type(%opts); + } + else { + $constraint = Moose::Meta::TypeConstraint->new(%opts); } $REGISTRY->add_type_constraint($constraint) @@ -418,11 +513,12 @@ sub _create_type_constraint ($$$;$$) { } sub _install_type_coercions ($$) { - my ($type_name, $coercion_map) = @_; + my ( $type_name, $coercion_map ) = @_; my $type = find_type_constraint($type_name); - (defined $type) - || Moose->throw_error("Cannot find type '$type_name', perhaps you forgot to load it."); - if ($type->has_coercion) { + ( defined $type ) + || __PACKAGE__->_throw_error( + "Cannot find type '$type_name', perhaps you forgot to load it"); + if ( $type->has_coercion ) { $type->coercion->add_type_coercions(@$coercion_map); } else { @@ -439,6 +535,7 @@ sub _install_type_coercions ($$) { ## -------------------------------------------------------- { + # All I have to say is mugwump++ cause I know # do not even have enough regexp-fu to be able # to have written this (I can only barely @@ -447,49 +544,85 @@ sub _install_type_coercions ($$) { use re "eval"; - my $valid_chars = qr{[\w:]}; - my $type_atom = qr{ $valid_chars+ }; - - my $any; - - my $type = qr{ $valid_chars+ (?: \[ (??{$any}) \] )? }x; - my $type_capture_parts = qr{ ($valid_chars+) (?: \[ ((??{$any})) \] )? }x; - my $type_with_parameter = qr{ $valid_chars+ \[ (??{$any}) \] }x; - - my $op_union = qr{ \s* \| \s* }x; - my $union = qr{ $type (?: $op_union $type )+ }x; + my $valid_chars = qr{[\w:\.]}; + my $type_atom = qr{ (?>$valid_chars+) }x; + my $ws = qr{ (?>\s*) }x; + my $op_union = qr{ $ws \| $ws }x; + + my ($type, $type_capture_parts, $type_with_parameter, $union, $any); + if (Class::MOP::IS_RUNNING_ON_5_10) { + my $type_pattern + = q{ (?&type_atom) (?: \[ (?&ws) (?&any) (?&ws) \] )? }; + my $type_capture_parts_pattern + = q{ ((?&type_atom)) (?: \[ (?&ws) ((?&any)) (?&ws) \] )? }; + my $type_with_parameter_pattern + = q{ (?&type_atom) \[ (?&ws) (?&any) (?&ws) \] }; + my $union_pattern + = q{ (?&type) (?> (?: (?&op_union) (?&type) )+ ) }; + my $any_pattern + = q{ (?&type) | (?&union) }; + + my $defines = qr{(?(DEFINE) + (? $valid_chars) + (? $type_atom) + (? $ws) + (? $op_union) + (? $type_pattern) + (? $type_capture_parts_pattern) + (? $type_with_parameter_pattern) + (? $union_pattern) + (? $any_pattern) + )}x; + + $type = qr{ $type_pattern $defines }x; + $type_capture_parts = qr{ $type_capture_parts_pattern $defines }x; + $type_with_parameter = qr{ $type_with_parameter_pattern $defines }x; + $union = qr{ $union_pattern $defines }x; + $any = qr{ $any_pattern $defines }x; + } + else { + $type + = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x; + $type_capture_parts + = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x; + $type_with_parameter + = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x; + $union + = qr{ $type (?> (?: $op_union $type )+ ) }x; + $any + = qr{ $type | $union }x; + } - $any = qr{ $type | $union }x; sub _parse_parameterized_type_constraint { - { no warnings 'void'; $any; } # force capture of interpolated lexical + { no warnings 'void'; $any; } # force capture of interpolated lexical $_[0] =~ m{ $type_capture_parts }x; - return ($1, $2); + return ( $1, $2 ); } sub _detect_parameterized_type_constraint { - { no warnings 'void'; $any; } # force capture of interpolated lexical + { no warnings 'void'; $any; } # force capture of interpolated lexical $_[0] =~ m{ ^ $type_with_parameter $ }x; } sub _parse_type_constraint_union { - { no warnings 'void'; $any; } # force capture of interpolated lexical + { no warnings 'void'; $any; } # force capture of interpolated lexical my $given = shift; my @rv; while ( $given =~ m{ \G (?: $op_union )? ($type) }gcx ) { push @rv => $1; } - (pos($given) eq length($given)) - || Moose->throw_error("'$given' didn't parse (parse-pos=" - . pos($given) - . " and str-length=" - . length($given) - . ")"); + ( pos($given) eq length($given) ) + || __PACKAGE__->_throw_error( "'$given' didn't parse (parse-pos=" + . pos($given) + . " and str-length=" + . length($given) + . ")" ); @rv; } sub _detect_type_constraint_union { - { no warnings 'void'; $any; } # force capture of interpolated lexical + { no warnings 'void'; $any; } # force capture of interpolated lexical $_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x; } } @@ -498,141 +631,44 @@ sub _install_type_coercions ($$) { # define some basic built-in types ## -------------------------------------------------------- -type 'Any' => where { 1 }; # meta-type including all -type 'Item' => where { 1 }; # base-type - -subtype 'Undef' => as 'Item' => where { !defined($_) }; -subtype 'Defined' => as 'Item' => where { defined($_) }; - -subtype 'Bool' - => as 'Item' - => where { !defined($_) || $_ eq "" || "$_" eq '1' || "$_" eq '0' }; - -subtype 'Value' - => as 'Defined' - => where { !ref($_) } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Value; - -subtype 'Ref' - => as 'Defined' - => where { ref($_) } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref; - -subtype 'Str' - => as 'Value' - => where { 1 } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str; - -subtype 'Num' - => as 'Value' - => where { Scalar::Util::looks_like_number($_) } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Num; - -subtype 'Int' - => as 'Num' - => where { "$_" =~ /^-?[0-9]+$/ } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Int; - -subtype 'ScalarRef' => as 'Ref' => where { ref($_) eq 'SCALAR' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef; -subtype 'CodeRef' => as 'Ref' => where { ref($_) eq 'CODE' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::CodeRef; -subtype 'RegexpRef' => as 'Ref' => where { ref($_) eq 'Regexp' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::RegexpRef; -subtype 'GlobRef' => as 'Ref' => where { ref($_) eq 'GLOB' } => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::GlobRef; - -# NOTE: -# scalar filehandles are GLOB refs, -# but a GLOB ref is not always a filehandle -subtype 'FileHandle' - => as 'GlobRef' - => where { Scalar::Util::openhandle($_) || ( blessed($_) && $_->isa("IO::Handle") ) } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::FileHandle; - -# NOTE: -# blessed(qr/.../) returns true,.. how odd -subtype 'Object' - => as 'Ref' - => where { blessed($_) && blessed($_) ne 'Regexp' } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Object; - -subtype 'Role' - => as 'Object' - => where { $_->can('does') } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role; - -my $_class_name_checker = sub { -}; - -subtype 'ClassName' - => as 'Str' - => where { Class::MOP::is_class_loaded($_) } - => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName; - -## -------------------------------------------------------- -# parameterizable types ... - -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'ArrayRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'ARRAY' }, - optimized => \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - foreach my $x (@$_) { - ($check->($x)) || return - } 1; - } - } - ) +# By making these classes immutable before creating all the types in +# Moose::Util::TypeConstraints::Builtin , we avoid repeatedly calling the slow +# MOP-based accessors. +$_->make_immutable( + inline_constructor => 1, + constructor_name => "_new", + + # these are Class::MOP accessors, so they need inlining + inline_accessors => 1 + ) for grep { $_->is_mutable } + map { Class::MOP::class_of($_) } + qw( + Moose::Meta::TypeConstraint + Moose::Meta::TypeConstraint::Union + Moose::Meta::TypeConstraint::Parameterized + Moose::Meta::TypeConstraint::Parameterizable + Moose::Meta::TypeConstraint::Class + Moose::Meta::TypeConstraint::Role + Moose::Meta::TypeConstraint::Enum + Moose::Meta::TypeConstraint::DuckType + Moose::Meta::TypeConstraint::Registry ); -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'HashRef', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), - constraint => sub { ref($_) eq 'HASH' }, - optimized => \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - foreach my $x (values %$_) { - ($check->($x)) || return - } 1; - } - } - ) -); +require Moose::Util::TypeConstraints::Builtins; +Moose::Util::TypeConstraints::Builtins::define_builtins($REGISTRY); -$REGISTRY->add_type_constraint( - Moose::Meta::TypeConstraint::Parameterizable->new( - name => 'Maybe', - package_defined_in => __PACKAGE__, - parent => find_type_constraint('Item'), - constraint => sub { 1 }, - constraint_generator => sub { - my $type_parameter = shift; - my $check = $type_parameter->_compiled_type_constraint; - return sub { - return 1 if not(defined($_)) || $check->($_); - return; - } - } - ) -); +my @PARAMETERIZABLE_TYPES + = map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe]; -my @PARAMETERIZABLE_TYPES = map { - $REGISTRY->get_type_constraint($_) -} qw[ArrayRef HashRef Maybe]; +sub get_all_parameterizable_types {@PARAMETERIZABLE_TYPES} -sub get_all_parameterizable_types { @PARAMETERIZABLE_TYPES } sub add_parameterizable_type { my $type = shift; - (blessed $type && $type->isa('Moose::Meta::TypeConstraint::Parameterizable')) - || Moose->throw_error("Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type"); + ( blessed $type + && $type->isa('Moose::Meta::TypeConstraint::Parameterizable') ) + || __PACKAGE__->_throw_error( + "Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type" + ); push @PARAMETERIZABLE_TYPES => $type; } @@ -642,79 +678,84 @@ sub add_parameterizable_type { { my @BUILTINS = list_all_type_constraints(); - sub list_all_builtin_type_constraints { @BUILTINS } + sub list_all_builtin_type_constraints {@BUILTINS} +} + +sub _throw_error { + shift; + require Moose; + unshift @_, 'Moose'; + goto &Moose::throw_error; } 1; +# ABSTRACT: Type constraint system for Moose + __END__ =pod -=head1 NAME - -Moose::Util::TypeConstraints - Type constraint system for Moose - =head1 SYNOPSIS use Moose::Util::TypeConstraints; - type 'Num' => where { Scalar::Util::looks_like_number($_) }; + subtype 'Natural', + as 'Int', + where { $_ > 0 }; - subtype 'Natural' - => as 'Int' - => where { $_ > 0 }; + subtype 'NaturalLessThanTen', + as 'Natural', + where { $_ < 10 }, + message { "This number ($_) is not less than ten!" }; - subtype 'NaturalLessThanTen' - => as 'Natural' - => where { $_ < 10 } - => message { "This number ($_) is not less than ten!" }; + coerce 'Num', + from 'Str', + via { 0+$_ }; - coerce 'Num' - => from 'Str' - => via { 0+$_ }; + enum 'RGBColors', [qw(red green blue)]; - enum 'RGBColors' => qw(red green blue); + no Moose::Util::TypeConstraints; =head1 DESCRIPTION This module provides Moose with the ability to create custom type -contraints to be used in attribute definition. +constraints to be used in attribute definition. =head2 Important Caveat This is B a type system for Perl 5. These are type constraints, and they are not used by Moose unless you tell it to. No type -inference is performed, expression are not typed, etc. etc. etc. +inference is performed, expressions are not typed, etc. etc. etc. -This is simply a means of creating small constraint functions which -can be used to simplify your own type-checking code, with the added -side benefit of making your intentions clearer through self-documentation. +A type constraint is at heart a small "check if a value is valid" +function. A constraint can be associated with an attribute. This +simplifies parameter validation, and makes your code clearer to read, +because you can refer to constraints by name. =head2 Slightly Less Important Caveat -It is B a good idea to quote your type and subtype names. +It is B a good idea to quote your type names. -This is to prevent perl from trying to execute the call as an indirect -object call. This issue only seems to come up when you have a subtype -the same name as a valid class, but when the issue does arise it tends -to be quite annoying to debug. +This prevents Perl from trying to execute the call as an indirect +object call. This can be an issue when you have a subtype with the +same name as a valid class. -So for instance, this: +For instance: subtype DateTime => as Object => where { $_->isa('DateTime') }; -will I, while this: +will I, while this: use DateTime; subtype DateTime => as Object => where { $_->isa('DateTime') }; will fail silently and cause many headaches. The simple way to solve this, as well as future proof your subtypes from classes which have -yet to have been created yet, is to simply do this: +yet to have been created, is to quote the type name: use DateTime; - subtype 'DateTime' => as 'Object' => where { $_->isa('DateTime') }; + subtype 'DateTime', as 'Object', where { $_->isa('DateTime') }; =head2 Default Type Constraints @@ -728,73 +769,86 @@ that hierarchy represented visually. Undef Defined Value - Num - Int Str - ClassName + Num + Int + ClassName + RoleName Ref - ScalarRef + ScalarRef[`a] ArrayRef[`a] HashRef[`a] CodeRef RegexpRef GlobRef - FileHandle + FileHandle Object - Role B Any type followed by a type parameter C<[`a]> can be parameterized, this means you can say: - ArrayRef[Int] # an array of intergers + ArrayRef[Int] # an array of integers HashRef[CodeRef] # a hash of str to CODE ref mappings + ScalarRef[Int] # a reference to an integer Maybe[Str] # value may be a string, may be undefined -B Unless you parameterize a type, then it is invalid to -include the square brackets. I.e. C will be -literally interpreted as a type name. +If Moose finds a name in brackets that it does not recognize as an +existing type, it assumes that this is a class name, for example +C. + +B Unless you parameterize a type, then it is invalid to include +the square brackets. I.e. C will be treated as a new type +name, I as a parameterization of C. B The C type constraint for the most part works correctly now, but edge cases may still exist, please use it -sparringly. +sparingly. B The C type constraint does a complex package -existence check. This means that your class B be loaded for -this type constraint to pass. I know this is not ideal for all, -but it is a saner restriction than most others. +existence check. This means that your class B be loaded for this +type constraint to pass. + +B The C constraint checks a string is a I which is a role, like C<'MyApp::Role::Comparable'>. =head2 Type Constraint Naming +Type name declared via this module can only contain alphanumeric +characters, colons (:), and periods (.). + Since the types created by this module are global, it is suggested that you namespace your types just as you would namespace your -modules. So instead of creating a I type for your B -module, you would call the type I instead. +modules. So instead of creating a I type for your +B module, you would call the type +I instead. =head2 Use with Other Constraint Modules -This module should play fairly nicely with other constraint -modules with only some slight tweaking. The C clause -in types is expected to be a C reference which checks -it's first argument and returns a boolean. Since most constraint -modules work in a similar way, it should be simple to adapt -them to work with Moose. +This module can play nicely with other constraint modules with some +slight tweaking. The C clause in types is expected to be a +C reference which checks its first argument and returns a +boolean. Since most constraint modules work in a similar way, it +should be simple to adapt them to work with Moose. For instance, this is how you could use it with L to declare a completely new type. - type 'HashOfArrayOfObjects' - => IsHashRef( - -keys => HasLength, - -values => IsArrayRef( IsObject )); + type 'HashOfArrayOfObjects', + where { + IsHashRef( + -keys => HasLength, + -values => IsArrayRef(IsObject) + )->(@_); + }; -For more examples see the F -test file. +For more examples see the F test +file. -Here is an example of using L and it's non-test +Here is an example of using L and its non-test related C function. - type 'ArrayOfHashOfBarsAndRandomNumbers' - => where { + type 'ArrayOfHashOfBarsAndRandomNumbers', + where { eq_deeply($_, array_each(subhashof({ bar => isa('Bar'), @@ -803,262 +857,439 @@ related C function. }; For a complete example see the -F test file. +F test file. + +=head2 Error messages + +Type constraints can also specify custom error messages, for when they fail to +validate. This is provided as just another coderef, which receives the invalid +value in C<$_>, as in: + + subtype 'PositiveInt', + as 'Int', + where { $_ > 0 }, + message { "$_ is not a positive integer!" }; + +If no message is specified, a default message will be used, which indicates +which type constraint was being used and what value failed. If +L (version 0.14 or higher) is installed, it will be used to +display the invalid value, otherwise it will just be printed as is. =head1 FUNCTIONS =head2 Type Constraint Constructors -The following functions are used to create type constraints. -They will then register the type constraints in a global store -where Moose can get to them if it needs to. +The following functions are used to create type constraints. They +will also register the type constraints your create in a global +registry that is used to look types up by name. -See the L for an example of how to use these. +See the L for an example of how to use these. =over 4 -=item B +=item B<< subtype 'Name', as 'Parent', where { } ... >> -This creates a base type, which has no parent. +This creates a named subtype. -=item B +If you provide a parent that Moose does not recognize, it will +automatically create a new class type constraint for this name. -This creates a named subtype. +When creating a named type, the C function should either be +called with the sugar helpers (C, C, etc), or with a +name and a hashref of parameters: + + subtype( 'Foo', { where => ..., message => ... } ); + +The valid hashref keys are C (the parent), C, C, +and C. -=item B +=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 L. +When creating an anonymous type, the C function should either +be called with the sugar helpers (C, C, etc), or with +just a hashref of parameters: + + subtype( { where => ..., message => ... } ); + =item B -Creates a type constraint with the name C<$class> and the metaclass -L. +Creates a new subtype of C with the name C<$class> and the +metaclass L. =item B -Creates a type constraint with the name C<$role> and the metaclass -L. +Creates a C type constraint with the name C<$role> and the +metaclass L. + +=item B + +Creates a type constraint for either C or something of the +given type. + +=item B + +This will create a subtype of Object and test to make sure the value +C do the methods in C<\@methods>. + +This is intended as an easy way to accept non-Moose objects that +provide a certain interface. If you're using Moose classes, we +recommend that you use a C-only Role instead. + +=item B + +If passed an ARRAY reference as the only parameter instead of the +C<$name>, C<\@methods> pair, this will create an unnamed duck type. +This can be used in an attribute definition like so: + + has 'cache' => ( + is => 'ro', + isa => duck_type( [qw( get_set )] ), + ); -=item B +=item B This will create a basic subtype for a given set of strings. The resulting constraint will be a subtype of C and -will match any of the items in C<@values>. It is case sensitive. -See the L for a simple example. +will match any of the items in C<\@values>. It is case sensitive. +See the L for a simple example. -B This is not a true proper enum type, it is simple -a convient constraint builder. +B This is not a true proper enum type, it is simply +a convenient constraint builder. =item B -If passed an ARRAY reference instead of the C<$name>, C<@values> pair, -this will create an unnamed enum. This can then be used in an attribute -definition like so: +If passed an ARRAY reference as the only parameter instead of the +C<$name>, C<\@values> pair, this will create an unnamed enum. This +can then be used in an attribute definition like so: has 'sort_order' => ( is => 'ro', isa => enum([qw[ ascending descending ]]), ); -=item B +=item B This is just sugar for the type constraint construction syntax. -=item B +It takes a single argument, which is the name of a parent type. + +=item B This is just sugar for the type constraint construction syntax. -Takes a block/code ref as an argument. When the type constraint is -tested, the supplied code is run with the value to be tested in -$_. This block should return true or false to indicate whether or not -the constraint check passed. +It takes a subroutine reference as an argument. When the type +constraint is tested, the reference is run with the value to be tested +in C<$_>. This reference should return true or false to indicate +whether or not the constraint check passed. -=item B +=item B This is just sugar for the type constraint construction syntax. -Takes a block/code ref as an argument. When the type constraint fails, -then the code block is run (with the value provided in $_). This code -ref should return a string, which will be used in the text of the -exception thrown. +It takes a subroutine reference as an argument. When the type +constraint fails, then the code block is run with the value provided +in C<$_>. This reference should return a string, which will be used in +the text of the exception thrown. + +=item B + +This can be used to define a "hand optimized" inlinable version of your type +constraint. + +You provide a subroutine which will be called I on a +L object. It will receive a single parameter, the +name of the variable to check, typically something like C<"$_"> or C<"$_[0]">. + +The subroutine should return a code string suitable for inlining. You can +assume that the check will be wrapped in parentheses when it is inlined. -=item B +The inlined code should include any checks that your type's parent types +do. For example, the C type's inlining sub looks like this: + + sub { + 'defined(' . $_[1] . ')' + . ' && !ref(' . $_[1] . ')' + } + +Note that it checks if the variable is defined, since it is a subtype of +the C type. However, to avoid repeating code, this can be optimized as: + + sub { + $_[0]->parent()->_inline_check($_[1]) + . ' && !ref(' . $_[1] . ')' + } + +=item B + +B instead.> This can be used to define a "hand optimized" version of your type constraint which can be used to avoid traversing a subtype -constraint heirarchy. +constraint hierarchy. -B You should only use this if you know what you are doing, -all the built in types use this, so your subtypes (assuming they +B 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. -=back +=item B<< type 'Name', where { } ... >> -=head2 Type Coercion Constructors +This creates a base type, which has no parent. -Type constraints can also contain type coercions as well. If you -ask your accessor to coerce, then Moose will run the type-coercion -code first, followed by the type constraint check. This feature -should be used carefully as it is very powerful and could easily -take off a limb if you are not careful. +The C function should either be called with the sugar helpers +(C, C, etc), or with a name and a hashref of +parameters: -See the L for an example of how to use these. + type( 'Foo', { where => ..., message => ... } ); -=over 4 +The valid hashref keys are C, C, and C. -=item B - -=item B +=back -This is just sugar for the type coercion construction syntax. +=head2 Type Constraint Utilities -=item B +=over 4 -This is just sugar for the type coercion construction syntax. +=item B<< match_on_type $value => ( $type => \&action, ... ?\&default ) >> + +This is a utility function for doing simple type based dispatching similar to +match/case in OCaml and case/of in Haskell. It is not as featureful as those +languages, nor does not it support any kind of automatic destructuring +bind. Here is a simple Perl pretty printer dispatching over the core Moose +types. + + sub ppprint { + my $x = shift; + match_on_type $x => ( + HashRef => sub { + my $hash = shift; + '{ ' + . ( + join ", " => map { $_ . ' => ' . ppprint( $hash->{$_} ) } + sort keys %$hash + ) . ' }'; + }, + ArrayRef => sub { + my $array = shift; + '[ ' . ( join ", " => map { ppprint($_) } @$array ) . ' ]'; + }, + CodeRef => sub {'sub { ... }'}, + RegexpRef => sub { 'qr/' . $_ . '/' }, + GlobRef => sub { '*' . B::svref_2object($_)->NAME }, + Object => sub { $_->can('to_string') ? $_->to_string : $_ }, + ScalarRef => sub { '\\' . ppprint( ${$_} ) }, + Num => sub {$_}, + Str => sub { '"' . $_ . '"' }, + Undef => sub {'undef'}, + => sub { die "I don't know what $_ is" } + ); + } + +Or a simple JSON serializer: + + sub to_json { + my $x = shift; + match_on_type $x => ( + HashRef => sub { + my $hash = shift; + '{ ' + . ( + join ", " => + map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } + sort keys %$hash + ) . ' }'; + }, + ArrayRef => sub { + my $array = shift; + '[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]'; + }, + Num => sub {$_}, + Str => sub { '"' . $_ . '"' }, + Undef => sub {'null'}, + => sub { die "$_ is not acceptable json type" } + ); + } + +The matcher is done by mapping a C<$type> to an C<\&action>. The C<$type> can +be either a string type or a L object, and +C<\&action> is a subroutine reference. This function will dispatch on the +first match for C<$value>. It is possible to have a catch-all by providing an +additional subroutine reference as the final argument to C. =back -=head2 Type Constraint Construction & Locating +=head2 Type Coercion Constructors + +You can define coercions for type constraints, which allow you to +automatically transform values to something valid for the type +constraint. If you ask your accessor to coerce, then Moose will run +the type-coercion code first, followed by the type constraint +check. This feature should be used carefully as it is very powerful +and could easily take off a limb if you are not careful. + +See the L for an example of how to use these. =over 4 -=item B +=item B<< coerce 'Name', from 'OtherName', via { ... } >> -Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>, -this will return a L instance. +This defines a coercion from one type to another. The C argument +is the type you are coercing I. -=item B +To define multiple coercions, supply more sets of from/via pairs: -Given a C<$type_name> in the form of: + coerce 'Name', + from 'OtherName', via { ... }, + from 'ThirdName', via { ... }; - BaseType[ContainerType] +=item B -this will extract the base type and container type and build an instance of -L for it. +This is just sugar for the type coercion construction syntax. -=item B +It takes a single type name (or type object), which is the type being +coerced I. -Given a class name it will create a new L -object for that class name. +=item B -=item B +This is just sugar for the type coercion construction syntax. -Given a role name it will create a new L -object for that role name. +It takes a subroutine reference. This reference will be called with +the value to be coerced in C<$_>. It is expected to return a new value +of the proper type for the coercion. -=item B +=back -=item B +=head2 Creating and Finding Type Constraints -This will attempt to find or create a type constraint given the a C<$type_name>. -If it cannot find it in the registry, it will see if it should be a union or -container type an create one if appropriate +These are additional functions for creating and finding type +constraints. Most of these functions are not available for +importing. The ones that are importable as specified. -=item B +=over 4 -This function will first call C with the type name. +=item B -If no type is found or created, but C<$options_for_anon_type> are provided, it -will create the corresponding type. +This function can be used to locate the L +object for a named type. -This was used by the C and C parameters to L -and are now superseded by C and -C. +This function is importable. -=item B +=item B -=item B +This function will register a L with the +global type registry. -Attempts to parse the type name using L and if -no appropriate constraint is found will create a new anonymous one. +This function is importable. -The C variant will use C and the C -variant will use C. +=item B -=item B +This method takes a type constraint name and returns the normalized +form. This removes any whitespace in the string. -This function can be used to locate a specific type constraint -meta-object, of the class L or a -derivative. What you do with it from there is up to you :) +=item B -=item B +This can take a union type specification like C<'Int|ArrayRef[Int]'>, +or a list of names. It returns a new +L object. -This function will register a named type constraint with the type registry. +=item B -=item B +Given a C<$type_name> in the form of C<'BaseType[ContainerType]'>, +this will create a new L +object. The C must exist already exist as a parameterizable +type. -Fetch the L object which -keeps track of all type constraints. +=item B -=item B +Given a class name this function will create a new +L object for that class name. -This will return a list of type constraint names, you can then -fetch them using C if you -want to. +The C<$options> is a hash reference that will be passed to the +L constructor (as a hash). -=item B +=item B -This will return a list of builtin type constraints, meaning, -those which are defined in this module. See the section -labeled L for a complete list. +Given a role name this function will create a new +L object for that role name. -=item B +The C<$options> is a hash reference that will be passed to the +L constructor (as a hash). -This will export all the current type constraints as functions -into the caller's namespace. Right now, this is mostly used for -testing, but it might prove useful to others. +=item B -=item B +Given a enum name this function will create a new +L object for that enum name. -This returns all the parameterizable types that have been registered. +=item B -=item B +Given a duck type name this function will create a new +L object for that enum name. -Adds C<$type> to the list of parameterizable types +=item B -=back +Given a type name, this first attempts to find a matching constraint +in the global registry. -=head1 Error Management +If the type name is a union or parameterized type, it will create a +new object of the appropriate, but if given a "regular" type that does +not yet exist, it simply returns false. -=over 4 +When given a union or parameterized type, the member or base type must +already exist. -=item B +If it creates a new union or parameterized type, it will add it to the +global registry. -If the caller is a Moose metaclass, use its L -routine, otherwise use L. +=item B -=back +=item B -=head2 Namespace Management +These functions will first call C. If +that function does not return a type, a new type object will +be created. -=over 4 +The C variant will use C and the +C variant will use C. -=item B +=item B -This will remove all the type constraint keywords from the -calling class namespace. +Returns the L object which +keeps track of all type constraints. -=back +=item B -=head1 BUGS +This will return a list of type constraint names in the global +registry. You can then fetch the actual type object using +C. + +=item B -All complex software has bugs lurking in it, and this module is no -exception. If you find a bug please either email me, or add the bug -to cpan-RT. +This will return a list of builtin type constraints, meaning those +which are defined in this module. See the L +section for a complete list. -=head1 AUTHOR +=item B + +This will export all the current type constraints as functions into +the caller's namespace (C, C, etc). Right now, this is +mostly used for testing, but it might prove useful to others. -Stevan Little Estevan@iinteractive.comE +=item B -=head1 COPYRIGHT AND LICENSE +This returns all the parameterizable types that have been registered, +as a list of type objects. -Copyright 2006-2008 by Infinity Interactive, Inc. +=item B -L +Adds C<$type> to the list of parameterizable types + +=back + +=head1 BUGS -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. +See L for details on reporting bugs. =cut