use Scalar::Util qw( blessed reftype );
use Moose::Exporter;
-our $VERSION = '0.91';
-$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
## --------------------------------------------------------
## --------------------------------------------------------
+use Moose::Deprecated;
use Moose::Meta::TypeConstraint;
use Moose::Meta::TypeConstraint::Union;
use Moose::Meta::TypeConstraint::Parameterized;
register_type_constraint
match_on_type )
],
- _export_to_main => 1,
);
## --------------------------------------------------------
# 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] );
}
#
# 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 }, 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(@_);
}
@methods = @$type_name;
$type_name = undef;
}
+ if ( @methods == 1 && ref $methods[0] eq 'ARRAY' ) {
+ @methods = @{ $methods[0] };
+ }
register_type_constraint(
create_duck_type_constraint(
# 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 )
- || __PACKAGE__->_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(
use re "eval";
my $valid_chars = qr{[\w:\.]};
- my $type_atom = qr{ $valid_chars+ };
-
- my $any;
-
- my $type = qr{ $valid_chars+ (?: \[ \s* (??{$any}) \s* \] )? }x;
- my $type_capture_parts
- = qr{ ($valid_chars+) (?: \[ \s* ((??{$any})) \s* \] )? }x;
- my $type_with_parameter
- = qr{ $valid_chars+ \[ \s* (??{$any}) \s* \] }x;
-
- my $op_union = qr{ \s* \| \s* }x;
- my $union = qr{ $type (?: $op_union $type )+ }x;
+ 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> $valid_chars)
+ (?<type_atom> $type_atom)
+ (?<ws> $ws)
+ (?<op_union> $op_union)
+ (?<type> $type_pattern)
+ (?<type_capture_parts> $type_capture_parts_pattern)
+ (?<type_with_parameter> $type_with_parameter_pattern)
+ (?<union> $union_pattern)
+ (?<any> $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
subtype 'Ref' => as 'Defined' => where { ref($_) } =>
optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Ref;
-subtype 'Str' => as 'Value' => where {1} =>
+subtype 'Str' => as 'Value' => where { ref(\$_) eq 'SCALAR' } =>
optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Str;
subtype 'Num' => as 'Str' =>
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' } =>
$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'),
);
my @PARAMETERIZABLE_TYPES
- = map { $REGISTRY->get_type_constraint($_) } qw[ArrayRef HashRef Maybe];
+ = map { $REGISTRY->get_type_constraint($_) } qw[ScalarRef ArrayRef HashRef Maybe];
sub get_all_parameterizable_types {@PARAMETERIZABLE_TYPES}
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;
Undef
Defined
Value
- Num
- Int
Str
+ Num
+ Int
ClassName
RoleName
Ref
- ScalarRef
+ ScalarRef[`a]
ArrayRef[`a]
HashRef[`a]
CodeRef
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
If Moose finds a name in brackets that it does not recognize as an
will also register the type constraints your create in a global
registry that is used to look types up by name.
-See the L<SYNOPSIS> for an example of how to use these.
+See the L</SYNOPSIS> for an example of how to use these.
=over 4
Creates a type constraint for either C<undef> or something of the
given type.
-=item B<duck_type ($name, @methods)>
+=item B<duck_type ($name, \@methods)>
This will create a subtype of Object and test to make sure the value
-C<can()> do the methods in C<@methods>.
+C<can()> 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
=item B<duck_type (\@methods)>
-If passed an ARRAY reference 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:
+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<enum ($name, @values)>
+=item B<enum ($name, \@values)>
This will create a basic subtype for a given set of strings.
The resulting constraint will be a subtype of C<Str> and
-will match any of the items in C<@values>. It is case sensitive.
-See the L<SYNOPSIS> for a simple example.
+will match any of the items in C<\@values>. It is case sensitive.
+See the L</SYNOPSIS> for a simple example.
B<NOTE:> This is not a true proper enum type, it is simply
a convenient constraint builder.
=item B<enum (\@values)>
-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',
=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 O'Caml and case/of in Haskell. It does not
-claim to be as featureful as either of those and does not support any
-kind of automatic destructuring bind. However it is suitable for a fair
-amount of your dispatching needs, for instance, here is a simple
-Perl pretty printer dispatching over the core Moose types.
+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 {
+ match_on_type $x => (
+ HashRef => sub {
my $hash = shift;
- '{ ' . (join ", " => map {
- $_ . ' => ' . ppprint( $hash->{ $_ } )
- } sort keys %$hash ) . ' }' },
- ArrayRef => sub {
+ '{ '
+ . (
+ 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 },
+ '[ ' . ( 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" };
+ 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" }
+ );
}
-Based on a mapping of C<$type> to C<\&action>, where C<$type> can be
-either a string type or a L<Moose::Meta::TypeConstraint> object, and
-C<\&action> is a CODE ref, this function will dispatch on the first
-match for C<$value>. It is possible to have a catch-all at the end
-in the form of a C<\&default> CODE ref
+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<Moose::Meta::TypeConstraint> 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<match_on_type>.
=back
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<SYNOPSIS> for an example of how to use these.
+See the L</SYNOPSIS> for an example of how to use these.
=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.
=head1 BUGS
-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.
-
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2006-2009 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.
+See L<Moose/BUGS> for details on reporting bugs.
=cut
projects / gitmo/Moose.git / blobdiff