use Scalar::Util qw( blessed reftype );
use Moose::Exporter;
-our $VERSION = '1.11';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
## --------------------------------------------------------
# Prototyped subs must be predeclared because we have a
# circular dependency with Moose::Meta::Attribute et. al.
sub via (&);
sub message (&);
sub optimize_as (&);
+sub inline_as (&);
## --------------------------------------------------------
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 maybe_type duck_type
- as where message optimize_as
+ as where message optimize_as inline_as
coerce from via
- enum
+ enum union
find_type_constraint
register_type_constraint
match_on_type )
}
sub create_type_constraint_union {
+ _create_type_constraint_union(\@_);
+}
+
+sub create_named_type_constraint_union {
+ my $name = shift;
+ _create_type_constraint_union($name, \@_);
+}
+
+sub _create_type_constraint_union {
+ my $name;
+ $name = shift if @_ > 1;
+ my @tcs = @{ shift() };
+
my @type_constraint_names;
- if ( scalar @_ == 1 && _detect_type_constraint_union( $_[0] ) ) {
- @type_constraint_names = _parse_type_constraint_union( $_[0] );
+ if ( scalar @tcs == 1 && _detect_type_constraint_union( $tcs[0] ) ) {
+ @type_constraint_names = _parse_type_constraint_union( $tcs[0] );
}
else {
- @type_constraint_names = @_;
+ @type_constraint_names = @tcs;
}
( scalar @type_constraint_names >= 2 )
"Could not locate type constraint ($_) for the union");
} @type_constraint_names;
- return Moose::Meta::TypeConstraint::Union->new(
- type_constraints => \@type_constraints );
+ my %options = (
+ type_constraints => \@type_constraints
+ );
+ $options{name} = $name if defined $name;
+
+ return Moose::Meta::TypeConstraint::Union->new(%options);
}
+
sub create_parameterized_type_constraint {
my $type_constraint_name = shift;
my ( $base_type, $type_parameter )
# type constructors
sub type {
-
- # back-compat version, called without sugar
- if ( !any { ( reftype($_) || '' ) eq 'HASH' } @_ ) {
- Moose::Deprecated::deprecated(
- feature => 'type without sugar',
- message =>
- 'Calling type() with a simple list of parameters is deprecated'
- );
-
- return _create_type_constraint( $_[0], undef, $_[1] );
- }
-
my $name = shift;
my %p = map { %{$_} } @_;
return _create_type_constraint(
$name, undef, $p{where}, $p{message},
- $p{optimize_as}
+ $p{optimize_as}, $p{inline_as},
);
}
sub subtype {
-
- # crazy back-compat code for being called without sugar ...
- #
- # subtype 'Parent', sub { where };
- if ( scalar @_ == 2 && ( reftype( $_[1] ) || '' ) eq 'CODE' ) {
- Moose::Deprecated::deprecated(
- feature => 'subtype without sugar',
- message =>
- 'Calling subtype() with a simple list of parameters is deprecated'
- );
-
- return _create_type_constraint( undef, @_ );
- }
-
- # subtype 'Parent', sub { where }, sub { message };
- # subtype 'Parent', sub { where }, sub { message }, sub { optimized };
- if ( scalar @_ >= 3 && all { ( reftype($_) || '' ) eq 'CODE' }
- @_[ 1 .. $#_ ] ) {
- Moose::Deprecated::deprecated(
- feature => 'subtype without sugar',
- message =>
- 'Calling subtype() with a simple list of parameters is deprecated'
- );
-
- return _create_type_constraint( undef, @_ );
- }
-
- # subtype 'Name', 'Parent', ...
- if ( scalar @_ >= 2 && all { !ref } @_[ 0, 1 ] ) {
- Moose::Deprecated::deprecated(
- feature => 'subtype without sugar',
- message =>
- 'Calling subtype() with a simple list of parameters is deprecated'
- );
-
- return _create_type_constraint(@_);
- }
-
if ( @_ == 1 && !ref $_[0] ) {
__PACKAGE__->_throw_error(
'A subtype cannot consist solely of a name, it must have a parent'
return _create_type_constraint(
$name, $p{as}, $p{where}, $p{message},
- $p{optimize_as}
+ $p{optimize_as}, $p{inline_as},
);
}
#
# subtype( 'Foo', as( 'Str', where { ... } ) );
#
-# If as() returns all it's extra arguments, this just works, and
+# 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 union {
+ my ( $type_name, @constraints ) = @_;
+ if ( ref $type_name eq 'ARRAY' ) {
+ @constraints == 0
+ || __PACKAGE__->_throw_error("union called with an array reference and additional arguments.");
+ @constraints = @$type_name;
+ $type_name = undef;
+ }
+ if ( @constraints == 1 && ref $constraints[0] eq 'ARRAY' ) {
+ @constraints = @{ $constraints[0] };
+ }
+ if ( defined $type_name ) {
+ return register_type_constraint(
+ create_named_type_constraint_union( $type_name, @constraints )
+ );
+ }
+ return create_type_constraint_union( @constraints );
+}
+
sub create_enum_type_constraint {
my ( $type_name, $values ) = @_;
my $check = shift;
my $message = shift;
my $optimized = shift;
+ my $inlined = shift;
my $pkg_defined_in = scalar( caller(1) );
( $check ? ( constraint => $check ) : () ),
( $message ? ( message => $message ) : () ),
( $optimized ? ( optimized => $optimized ) : () ),
+ ( $inlined ? ( inlined => $inlined ) : () ),
);
my $constraint;
# define some basic built-in types
## --------------------------------------------------------
-# By making these classes immutable before creating all the types we
-# below, we avoid repeatedly calling the slow MOP-based accessors.
+# 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",
Moose::Meta::TypeConstraint::Registry
);
-type 'Any' => where {1}; # meta-type including all
-subtype 'Item' => as 'Any'; # 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 { ref(\$_) eq 'SCALAR' } =>
- optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
-
-subtype 'Num' => as 'Str' =>
- 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 '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;
-
-# This type is deprecated.
-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;
-
-subtype 'RoleName' => as 'ClassName' => where {
- (Class::MOP::class_of($_) || return)->isa('Moose::Meta::Role');
-} => optimize_as
- \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName;
-
-## --------------------------------------------------------
-# parameterizable types ...
-
-$REGISTRY->add_type_constraint(
- Moose::Meta::TypeConstraint::Parameterizable->new(
- name => 'ScalarRef',
- package_defined_in => __PACKAGE__,
- parent => find_type_constraint('Ref'),
- constraint => sub { ref($_) eq 'SCALAR' || ref($_) eq 'REF' },
- optimized =>
- \&Moose::Util::TypeConstraints::OptimizedConstraints::ScalarRef,
- constraint_generator => sub {
- my $type_parameter = shift;
- my $check = $type_parameter->_compiled_type_constraint;
- return sub {
- return $check->(${ $_ });
- };
- }
- )
-);
-
-$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;
- }
- }
- )
-);
-
-$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;
- }
- }
- )
-);
-
-$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;
- }
- }
- )
-);
+require Moose::Util::TypeConstraints::Builtins;
+Moose::Util::TypeConstraints::Builtins::define_builtins($REGISTRY);
my @PARAMETERIZABLE_TYPES
= map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe];
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;
- 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!" };
+
+ coerce 'Num',
+ from 'Str',
+ via { 0+$_ };
- subtype 'NaturalLessThanTen'
- => as 'Natural'
- => where { $_ < 10 }
- => message { "This number ($_) is not less than ten!" };
+ class_type 'DateTimeish', { class => 'DateTime' };
- coerce 'Num'
- => from 'Str'
- => via { 0+$_ };
+ role_type 'Barks', { role => 'Some::Library::Role::Barks' };
- enum 'RGBColors' => qw(red green blue);
+ enum 'RGBColors', [qw(red green blue)];
+
+ union 'StringOrArray', [qw( String Array )];
no Moose::Util::TypeConstraints;
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
CodeRef
RegexpRef
GlobRef
- FileHandle
+ FileHandle
Object
B<NOTE:> Any type followed by a type parameter C<[`a]> can be
This module can play nicely with other constraint modules with some
slight tweaking. The C<where> clause in types is expected to be a
-C<CODE> reference which checks it's first argument and returns a
+C<CODE> 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.
L<Declare::Constraints::Simple> to declare a completely new type.
type 'HashOfArrayOfObjects',
- {
- where => IsHashRef(
- -keys => HasLength,
- -values => IsArrayRef(IsObject)
- )
- };
-
-For more examples see the F<t/200_examples/004_example_w_DCS.t> test
+ where {
+ IsHashRef(
+ -keys => HasLength,
+ -values => IsArrayRef(IsObject)
+ )->(@_);
+ };
+
+For more examples see the F<t/examples/example_w_DCS.t> test
file.
-Here is an example of using L<Test::Deep> and it's non-test
+Here is an example of using L<Test::Deep> and its non-test
related C<eq_deeply> function.
- type 'ArrayOfHashOfBarsAndRandomNumbers'
- => where {
+ type 'ArrayOfHashOfBarsAndRandomNumbers',
+ where {
eq_deeply($_,
array_each(subhashof({
bar => isa('Bar'),
};
For a complete example see the
-F<t/200_examples/005_example_w_TestDeep.t> test file.
+F<t/examples/example_w_TestDeep.t> 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<Devel::PartialDump> (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
=over 4
-=item B<< subtype 'Name' => as 'Parent' => where { } ... >>
+=item B<< subtype 'Name', as 'Parent', where { } ... >>
This creates a named subtype.
The valid hashref keys are C<as> (the parent), C<where>, C<message>,
and C<optimize_as>.
-=item B<< subtype as 'Parent' => where { } ... >>
+=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
Creates a new subtype of C<Object> with the name C<$class> and the
metaclass L<Moose::Meta::TypeConstraint::Class>.
+ # Create a type called 'Box' which tests for objects which ->isa('Box')
+ class_type 'Box';
+
+Additionally, you can create a class_type which is a shorthand for another class.
+
+ # Create a type called 'Box' which tests for objects which ->isa('ObjectLibrary::Box');
+ class_type 'Box', { class => 'ObjectLibrary::Box' };
+
+But it's only really necessary to do this if you're working with L<MooseX::Types>.
+
=item B<role_type ($role, ?$options)>
Creates a C<Role> type constraint with the name C<$role> and the
metaclass L<Moose::Meta::TypeConstraint::Role>.
+ # Create a type called 'Walks' which tests for objects which ->does('Walks')
+ role_type 'Walks';
+
+Additionally, you can create a role_type which is a shorthand for another role.
+
+ # Create a type called 'Walks' which tests for objects which ->does('MooseX::Role::Walks');
+ role_type 'Walks', { role => 'MooseX::Role::Walks' };
+
+But it's only really necessary to do this if you're working with L<MooseX::Types>.
+
=item B<maybe_type ($type)>
Creates a type constraint for either C<undef> or something of the
isa => enum([qw[ ascending descending ]]),
);
+=item B<union ($name, \@constraints)>
+
+This will create a basic subtype where any of the provided constraints
+may match in order to satisfy this constraint.
+
+=item B<union (\@constraints)>
+
+If passed an ARRAY reference as the only parameter instead of the
+C<$name>, C<\@constraints> pair, this will create an unnamed union.
+This can then be used in an attribute definition like so:
+
+ has 'items' => (
+ is => 'ro',
+ isa => union([qw[ Str ArrayRef ]]),
+ );
+
+This is similar to the existing string union:
+
+ isa => 'Str|ArrayRef'
+
+except that it supports anonymous elements as child constraints:
+
+ has 'color' => (
+ isa => 'ro',
+ isa => union([ 'Int', enum([qw[ red green blue ]]) ]),
+ );
+
=item B<as 'Parent'>
This is just sugar for the type constraint construction syntax.
in C<$_>. This reference should return a string, which will be used in
the text of the exception thrown.
+=item B<inline_as { ... }>
+
+This can be used to define a "hand optimized" inlinable version of your type
+constraint.
+
+You provide a subroutine which will be called I<as a method> on a
+L<Moose::Meta::TypeConstraint> 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.
+
+The inlined code should include any checks that your type's parent types
+do. For example, the C<Value> 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<Defined> type. However, to avoid repeating code, this can be optimized as:
+
+ sub {
+ $_[0]->parent()->_inline_check($_[1])
+ . ' && !ref(' . $_[1] . ')'
+ }
+
=item B<optimize_as { ... }>
+B<This feature is deprecated, use C<inline_as> 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 hierarchy.
-B<NOTE:> 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<NOTE:> 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.
-=item B<< type 'Name' => where { } ... >>
+=item B<< type 'Name', where { } ... >>
This creates a base type, which has no parent.
type( 'Foo', { where => ..., message => ... } );
-The valid hashref keys are C<where>, C<message>, and C<optimize_as>.
+The valid hashref keys are C<where>, C<message>, and C<inlined_as>.
=back
=over 4
-=item B<< coerce 'Name' => from 'OtherName' => via { ... } >>
+=item B<< coerce 'Name', from 'OtherName', via { ... } >>
This defines a coercion from one type to another. The C<Name> argument
is the type you are coercing I<to>.
+To define multiple coercions, supply more sets of from/via pairs:
+
+ coerce 'Name',
+ from 'OtherName', via { ... },
+ from 'ThirdName', via { ... };
+
=item B<from 'OtherName'>
This is just sugar for the type coercion construction syntax.
=item B<create_type_constraint_union($pipe_separated_types | @type_constraint_names)>
+=item B<create_named_type_constraint_union($name, $pipe_separated_types | @type_constraint_names)>
+
This can take a union type specification like C<'Int|ArrayRef[Int]'>,
or a list of names. It returns a new
L<Moose::Meta::TypeConstraint::Union> object.
=item B<find_or_create_does_type_constraint($type_name)>
These functions will first call C<find_or_parse_type_constraint>. If
-that function does not return a type, a new anonymous type object will
+that function does not return a type, a new type object will
be created.
The C<isa> variant will use C<create_class_type_constraint> and the
See L<Moose/BUGS> for details on reporting bugs.
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2010 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
=cut