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 )
#find_type_constraint("ClassName")->check($class)
# || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
+ my $pkg_defined_in = $options->{package_defined_in} || scalar( caller(1) );
+
+ if (my $type = $REGISTRY->get_type_constraint($class)) {
+ if (!($type->isa('Moose::Meta::TypeConstraint::Class') && $type->class eq $class)) {
+ _confess(
+ "The type constraint '$class' has already been created in "
+ . $type->_package_defined_in
+ . " and cannot be created again in "
+ . $pkg_defined_in )
+ }
+ else {
+ return $type;
+ }
+ }
+
my %options = (
- class => $class,
- name => $class,
+ class => $class,
+ name => $class,
+ package_defined_in => $pkg_defined_in,
%{ $options || {} },
);
$options{name} ||= "__ANON__";
- Moose::Meta::TypeConstraint::Class->new(%options);
+ my $tc = Moose::Meta::TypeConstraint::Class->new(%options);
+ $REGISTRY->add_type_constraint($tc);
+ return $tc;
}
sub create_role_type_constraint {
#find_type_constraint("ClassName")->check($class)
# || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
+ my $pkg_defined_in = $options->{package_defined_in} || scalar( caller(1) );
+
+ if (my $type = $REGISTRY->get_type_constraint($role)) {
+ if (!($type->isa('Moose::Meta::TypeConstraint::Role') && $type->role eq $role)) {
+ _confess(
+ "The type constraint '$role' has already been created in "
+ . $type->_package_defined_in
+ . " and cannot be created again in "
+ . $pkg_defined_in )
+ }
+ else {
+ return $type;
+ }
+ }
+
my %options = (
- role => $role,
- name => $role,
+ role => $role,
+ name => $role,
+ package_defined_in => $pkg_defined_in,
%{ $options || {} },
);
$options{name} ||= "__ANON__";
- Moose::Meta::TypeConstraint::Role->new(%options);
+ my $tc = Moose::Meta::TypeConstraint::Role->new(%options);
+ $REGISTRY->add_type_constraint($tc);
+ return $tc;
}
sub find_or_create_type_constraint {
}
sub find_or_create_isa_type_constraint {
- my $type_constraint_name = shift;
+ my ($type_constraint_name, $options) = @_;
find_or_parse_type_constraint($type_constraint_name)
- || create_class_type_constraint($type_constraint_name);
+ || create_class_type_constraint($type_constraint_name, $options);
}
sub find_or_create_does_type_constraint {
- my $type_constraint_name = shift;
+ my ($type_constraint_name, $options) = @_;
find_or_parse_type_constraint($type_constraint_name)
- || create_role_type_constraint($type_constraint_name);
+ || create_role_type_constraint($type_constraint_name, $options);
}
sub find_or_parse_type_constraint {
# 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. This will be an error in Moose 2.0200.'
- );
-
- return _create_type_constraint( $_[0], undef, $_[1] );
- }
-
my $name = shift;
my %p = map { %{$_} } @_;
}
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. This will be an error in Moose 2.0200.'
- );
-
- 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. This will be an error in Moose 2.0200.'
- );
-
- 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. This will be an error in Moose 2.0200.'
- );
-
- return _create_type_constraint(@_);
- }
-
if ( @_ == 1 && !ref $_[0] ) {
__PACKAGE__->_throw_error(
'A subtype cannot consist solely of a name, it must have a parent'
}
sub class_type {
- register_type_constraint(
- create_class_type_constraint(
- $_[0],
- ( defined( $_[1] ) ? $_[1] : () ),
- )
- );
+ create_class_type_constraint(@_);
}
sub role_type ($;$) {
- register_type_constraint(
- create_role_type_constraint(
- $_[0],
- ( defined( $_[1] ) ? $_[1] : () ),
- )
- );
+ create_role_type_constraint(@_);
}
sub maybe_type {
);
}
+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 ) = @_;
from 'Str',
via { 0+$_ };
+ class_type 'DateTimeClass', { class => 'DateTime' };
+
+ role_type 'Barks', { role => 'Some::Library::Role::Barks' };
+
enum 'RGBColors', [qw(red green blue)];
+ union 'StringOrArray', [qw( String Array )];
+
no Moose::Util::TypeConstraints;
=head1 DESCRIPTION
CodeRef
RegexpRef
GlobRef
- FileHandle
+ FileHandle
Object
B<NOTE:> Any type followed by a type parameter C<[`a]> can be
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';
+
+By default, the name of the type and the name of the class are the same, but
+you can specify both separately.
+
+ # Create a type called 'Box' which tests for objects which ->isa('ObjectLibrary::Box');
+ class_type 'Box', { class => 'ObjectLibrary::Box' };
+
=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';
+
+By default, the name of the type and the name of the role are the same, but
+you can specify both separately.
+
+ # Create a type called 'Walks' which tests for objects which ->does('MooseX::Role::Walks');
+ role_type 'Walks', { role => 'MooseX::Role::Walks' };
+
=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. If your parent type constraint defines its own inlining, you can simply use
+that to avoid repeating code. For example, here is the inlining code for the
+C<Value> type, which is a subtype of C<Defined>:
+
+ 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.
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
=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.
projects / gitmo/Moose.git / blobdiff