use strict;
use warnings;
-use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype';
-use Sub::Exporter;
+use Carp ();
+use List::MoreUtils qw( all any );
+use Scalar::Util qw( blessed reftype );
+use Moose::Exporter;
-our $VERSION = '0.22';
+our $VERSION = '0.71_01';
+$VERSION = eval $VERSION;
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 optimize_as (&);
-sub enum ($;@);
-
-## private stuff ...
-sub _create_type_constraint ($$$;$$);
-sub _install_type_coercions ($$);
## --------------------------------------------------------
use Moose::Meta::TypeConstraint::Registry;
use Moose::Util::TypeConstraints::OptimizedConstraints;
-my @exports = qw/
- type subtype class_type role_type as where message optimize_as
- coerce from via
- enum
- find_type_constraint
- register_type_constraint
-/;
-
-Sub::Exporter::setup_exporter({
- exports => \@exports,
- groups => { default => [':all'] }
-});
-
-sub unimport {
- no strict 'refs';
- my $class = caller();
- # loop through the exports ...
- foreach my $name (@exports) {
- # if we find one ...
- if (defined &{$class . '::' . $name}) {
- my $keyword = \&{$class . '::' . $name};
-
- # make sure it is from Moose
- my ($pkg_name) = Class::MOP::get_code_info($keyword);
- next if $@;
- next if $pkg_name ne 'Moose::Util::TypeConstraints';
-
- # and if it is from Moose then undef the slot
- delete ${$class . '::'}{$name};
- }
- }
-}
+Moose::Exporter->setup_import_methods(
+ as_is => [
+ qw(
+ type subtype class_type role_type maybe_type
+ as where message optimize_as
+ coerce from via
+ enum
+ find_type_constraint
+ register_type_constraint )
+ ],
+ _export_to_main => 1,
+);
## --------------------------------------------------------
## type registry and some useful functions for it
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 };
+ *{"${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])) {
else {
@type_constraint_names = @_;
}
-
+
(scalar @type_constraint_names >= 2)
- || confess "You must pass in at least 2 type names to make a union";
+ || __PACKAGE__->_throw_error("You must pass in at least 2 type names to make a union");
- ($REGISTRY->has_type_constraint($_))
- || confess "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);
(defined $base_type && defined $type_parameter)
- || confess "Could not parse type name ($type_constraint_name) correctly";
-
- ($REGISTRY->has_type_constraint($base_type))
- || confess "Could not locate the base type ($base_type)";
+ || __PACKAGE__->_throw_error("Could not parse type name ($type_constraint_name) correctly");
- return Moose::Meta::TypeConstraint::Parameterized->new(
- name => $type_constraint_name,
- parent => $REGISTRY->get_type_constraint($base_type),
- type_parameter => find_or_create_isa_type_constraint($type_parameter),
- );
+ if ($REGISTRY->has_type_constraint($base_type)) {
+ my $base_type_tc = $REGISTRY->get_type_constraint($base_type);
+ return _create_parameterized_type_constraint(
+ $base_type_tc,
+ $type_parameter
+ );
+ } else {
+ __PACKAGE__->_throw_error("Could not locate the base type ($base_type)");
+ }
}
+sub _create_parameterized_type_constraint {
+ 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 => $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)
- # || confess "Can't create a class type constraint because '$class' is not a class name";
+ # || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
my %options = (
class => $class,
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)
- # || confess "Can't create a class type constraint because '$class' is not a class name";
+ # || __PACKAGE__->_throw_error("Can't create a class type constraint because '$class' is not a class name");
my %options = (
role => $role,
}
-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) ) {
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)
}
-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)
}
-sub find_or_parse_type_constraint ($) {
- my $type_constraint_name = shift;
-
- return $REGISTRY->get_type_constraint($type_constraint_name)
- if $REGISTRY->has_type_constraint($type_constraint_name);
-
+sub find_or_parse_type_constraint {
+ my $type_constraint_name = normalize_type_constraint_name(shift);
my $constraint;
-
- if (_detect_type_constraint_union($type_constraint_name)) {
+
+ if ($constraint = find_type_constraint($type_constraint_name)) {
+ return $constraint;
+ } elsif (_detect_type_constraint_union($type_constraint_name)) {
$constraint = create_type_constraint_union($type_constraint_name);
- }
- elsif (_detect_parameterized_type_constraint($type_constraint_name)) {
+ } elsif (_detect_parameterized_type_constraint($type_constraint_name)) {
$constraint = create_parameterized_type_constraint($type_constraint_name);
} else {
return;
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") ) {
return $type;
- } else {
+ }
+ else {
+ return unless $REGISTRY->has_type_constraint($type);
return $REGISTRY->get_type_constraint($type);
}
}
-sub register_type_constraint ($) {
+sub register_type_constraint {
my $constraint = shift;
- confess "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 {
+ # back-compat version, called without sugar
+ if ( ! any { ( reftype($_) || '' ) eq 'HASH' } @_ ) {
+ 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} );
}
-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 && (reftype($_[1]) || '') eq 'CODE';
- goto &_create_type_constraint;
+sub subtype {
+ # crazy back-compat code for being called without sugar ...
+ #
+ # subtype 'Parent', sub { where };
+ if ( scalar @_ == 2 && ( reftype( $_[1] ) || '' ) eq 'CODE' ) {
+ 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 .. $#_ ] ) {
+ return _create_type_constraint( undef, @_ );
+ }
+
+ # subtype 'Name', 'Parent', ...
+ if ( scalar @_ >= 2 && all { !ref } @_[ 0, 1 ] ) {
+ return _create_type_constraint(@_);
+ }
+
+ # 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} );
}
-sub class_type ($;$) {
+sub class_type {
register_type_constraint(
create_class_type_constraint(
$_[0],
);
}
-sub coerce ($@) {
+sub maybe_type {
+ my ($type_parameter) = @_;
+
+ register_type_constraint(
+ $REGISTRY->get_type_constraint('Maybe')->parameterize($type_parameter)
+ );
+}
+
+sub coerce {
my ($type_name, @coercion_map) = @_;
_install_type_coercions($type_name, \@coercion_map);
}
-sub as ($) { $_[0] }
-sub from ($) { $_[0] }
-sub where (&) { $_[0] }
-sub via (&) { $_[0] }
-
-sub message (&) { +{ message => $_[0] } }
-sub optimize_as (&) { +{ optimized => $_[0] } }
-
-sub enum ($;@) {
+# 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 it's 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 from {@_}
+sub via (&) { $_[0] }
+
+sub enum {
my ($type_name, @values) = @_;
# NOTE:
# if only an array-ref is passed then
$type_name = undef;
}
(scalar @values >= 2)
- || confess "You must have at least two values to enumerate through";
+ || __PACKAGE__->_throw_error("You must have at least two values to enumerate through");
my %valid = map { $_ => 1 } @values;
register_type_constraint(
);
}
-sub create_enum_type_constraint ($$) {
+sub create_enum_type_constraint {
my ( $type_name, $values ) = @_;
-
+
Moose::Meta::TypeConstraint::Enum->new(
name => $type_name || '__ANON__',
values => $values,
## --------------------------------------------------------
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 $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};
}
- $parent = find_or_parse_type_constraint($parent) if defined $parent;
-
- my $constraint = Moose::Meta::TypeConstraint->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 ) : () ),
);
- # 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)
sub _install_type_coercions ($$) {
my ($type_name, $coercion_map) = @_;
- my $type = $REGISTRY->get_type_constraint($type_name);
+ my $type = find_type_constraint($type_name);
(defined $type)
- || confess "Cannot find type '$type_name', perhaps you forgot to load it.";
+ || __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);
}
use re "eval";
- my $valid_chars = qr{[\w:]};
+ my $valid_chars = qr{[\w:\.]};
my $type_atom = qr{ $valid_chars+ };
- 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 $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;
- our $any = qr{ $type | $union }x;
+ $any = qr{ $type | $union }x;
sub _parse_parameterized_type_constraint {
+ { no warnings 'void'; $any; } # force capture of interpolated lexical
$_[0] =~ m{ $type_capture_parts }x;
return ($1, $2);
}
sub _detect_parameterized_type_constraint {
+ { 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
my $given = shift;
my @rv;
while ( $given =~ m{ \G (?: $op_union )? ($type) }gcx ) {
push @rv => $1;
}
(pos($given) eq length($given))
- || confess "'$given' didn't parse (parse-pos="
+ || __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
$_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x;
}
}
# 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.
+$_->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 { $_->meta }
+ 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::Registry
+);
+
type 'Any' => where { 1 }; # meta-type including all
type 'Item' => where { 1 }; # base-type
=> where { $_->can('does') }
=> optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::Role;
-my $_class_name_checker = sub {
- return if ref($_[0]);
- return unless defined($_[0]) && length($_[0]);
-
- # walk the symbol table tree to avoid autovififying
- # \*{${main::}{"Foo::"}} == \*main::Foo::
-
- my $pack = \*::;
- foreach my $part (split('::', $_[0])) {
- return unless exists ${$$pack}{"${part}::"};
- $pack = \*{${$$pack}{"${part}::"}};
- }
-
- # check for $VERSION or @ISA
- return 1 if exists ${$$pack}{VERSION}
- && defined *{${$$pack}{VERSION}}{SCALAR};
- return 1 if exists ${$$pack}{ISA}
- && defined *{${$$pack}{ISA}}{ARRAY};
-
- # check for any method
- foreach ( keys %{$$pack} ) {
- next if substr($_, -2, 2) eq '::';
- return 1 if defined *{${$$pack}{$_}}{CODE};
- }
-
- # fail
- return;
-};
+my $_class_name_checker = sub {};
subtype 'ClassName'
=> as 'Str'
- => $_class_name_checker # where ...
- => { optimize => $_class_name_checker };
+ => where { Class::MOP::is_class_loaded($_) }
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
+
+subtype 'RoleName'
+ => as 'ClassName'
+ => where { (($_->can('meta') || return)->($_) || return)->isa('Moose::Meta::Role') }
+ => optimize_as \&Moose::Util::TypeConstraints::OptimizedConstraints::RoleName; ;
## --------------------------------------------------------
# parameterizable types ...
sub add_parameterizable_type {
my $type = shift;
(blessed $type && $type->isa('Moose::Meta::TypeConstraint::Parameterizable'))
- || confess "Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type";
+ || __PACKAGE__->_throw_error("Type must be a Moose::Meta::TypeConstraint::Parameterizable not $type");
push @PARAMETERIZABLE_TYPES => $type;
}
sub list_all_builtin_type_constraints { @BUILTINS }
}
+sub _throw_error {
+ shift;
+ require Moose;
+ unshift @_, 'Moose';
+ goto &Moose::throw_error;
+}
+
1;
__END__
type 'Num' => where { Scalar::Util::looks_like_number($_) };
subtype 'Natural'
- => as 'Num'
+ => as 'Int'
=> where { $_ > 0 };
subtype 'NaturalLessThanTen'
=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
inference is performed, expression 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
+can be used to simplify your own type-checking code, with the added
side benefit of making your intentions clearer through self-documentation.
=head2 Slightly Less Important Caveat
=head2 Default Type Constraints
-This module also provides a simple hierarchy for Perl 5 types, here is
+This module also provides a simple hierarchy for Perl 5 types, here is
that hierarchy represented visually.
Any
Int
Str
ClassName
+ RoleName
Ref
ScalarRef
ArrayRef[`a]
GlobRef
FileHandle
Object
- Role
+ Role
B<NOTE:> 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
Maybe[Str] # value may be a string, may be undefined
+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<ArrayRef[DateTime]>.
+
+B<NOTE:> Unless you parameterize a type, then it is invalid to
+include the square brackets. I.e. C<ArrayRef[]> will be
+literally interpreted as a type name.
+
B<NOTE:> The C<Undef> type constraint for the most part works
correctly now, but edge cases may still exist, please use it
-sparringly.
+sparingly.
B<NOTE:> The C<ClassName> type constraint does a complex package
existence check. This means that your class B<must> 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.
-=head2 Type Constraint Naming
+B<NOTE:> The C<RoleName> constraint checks a string is I<package name>
+which is a role, like C<'MyApp::Role::Comparable'>. The C<Role>
+constraint checks that an I<object> does the named role.
+
+=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
+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<Color> type for your B<My::Graphics>
-module, you would call the type I<My::Graphics::Color> instead.
+module, you would call the type I<My.Graphics.Color> instead.
=head2 Use with Other Constraint Modules
For instance, this is how you could use it with
L<Declare::Constraints::Simple> to declare a completely new type.
- type 'HashOfArrayOfObjects'
- => IsHashRef(
+ type 'HashOfArrayOfObjects',
+ {
+ where => IsHashRef(
-keys => HasLength,
- -values => IsArrayRef( IsObject ));
+ -values => IsArrayRef(IsObject)
+ )
+ };
-For more examples see the F<t/200_examples/204_example_w_DCS.t>
+For more examples see the F<t/200_examples/204_example_w_DCS.t>
test file.
Here is an example of using L<Test::Deep> and it's non-test
})))
};
-For a complete example see the
+For a complete example see the
F<t/200_examples/205_example_w_TestDeep.t> test file.
=head1 FUNCTIONS
=over 4
-=item B<type ($name, $where_clause)>
+=item B<type 'Name' => where { } ... >
This creates a base type, which has no parent.
-=item B<subtype ($name, $parent, $where_clause, ?$message)>
+The C<type> function should either be called with the sugar helpers
+(C<where>, C<message>, etc), or with a name and a hashref of
+parameters:
+
+ type( 'Foo', { where => ..., message => ... } );
+
+The valid hashref keys are C<where>, C<message>, and C<optimize_as>.
+
+=item B<subtype 'Name' => as 'Parent' => where { } ...>
This creates a named subtype.
-=item B<subtype ($parent, $where_clause, ?$message)>
+If you provide a parent that Moose does not recognize, it will
+automatically create a new class type constraint for this name.
+
+When creating a named type, the C<subtype> function should either be
+called with the sugar helpers (C<where>, C<message>, etc), or with a
+name and a hashref of parameters:
+
+ subtype( 'Foo', { where => ..., message => ... } );
+
+The valid hashref keys are C<as> (the parent), C<where>, C<message>,
+and C<optimize_as>.
+
+=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<Moose::Meta::TypeConstraint>.
+When creating an anonymous type, the C<subtype> function should either
+be called with the sugar helpers (C<where>, C<message>, etc), or with
+just a hashref of parameters:
+
+ subtype( { where => ..., message => ... } );
+
=item B<class_type ($class, ?$options)>
-Creates a type constraint with the name C<$class> and the metaclass
-L<Moose::Meta::TypeConstraint::Class>.
+Creates a new subtype of C<Object> with the name C<$class> and the
+metaclass L<Moose::Meta::TypeConstraint::Class>.
=item B<role_type ($role, ?$options)>
-Creates a type constraint with the name C<$role> and the metaclass
-L<Moose::Meta::TypeConstraint::Role>.
+Creates a C<Role> type constraint with the name C<$role> and the
+metaclass L<Moose::Meta::TypeConstraint::Role>.
+
+=item B<maybe_type ($type)>
+
+Creates a type constraint for either C<undef> or something of the
+given type.
=item B<enum ($name, @values)>
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 simple
-a convient constraint builder.
+B<NOTE:> This is not a true proper enum type, it is simply
+a convenient constraint builder.
=item B<enum (\@values)>
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.
+
=item B<message>
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.
+
=item B<optimize_as>
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<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
=over 4
-=item B<create_type_constraint_union ($pipe_seperated_types | @type_constraint_names)>
+=item B<normalize_type_constraint_name ($type_constraint_name)>
+
+Given a string that is expected to match a type constraint, will normalize the
+string so that extra whitespace and newlines are removed.
+
+=item B<create_type_constraint_union ($pipe_separated_types | @type_constraint_names)>
-Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>,
+Given string with C<$pipe_separated_types> or a list of C<@type_constraint_names>,
this will return a L<Moose::Meta::TypeConstraint::Union> instance.
=item B<create_parameterized_type_constraint ($type_name)>
=item B<find_or_create_does_type_constraint ($type_name)>
-Attempts to parse the type name using L<find_or_parse_type_constraint> and if
+Attempts to parse the type name using C<find_or_parse_type_constraint> and if
no appropriate constraint is found will create a new anonymous one.
The C<isa> variant will use C<create_class_type_constraint> and the C<does>
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2008 by Infinity Interactive, Inc.
+Copyright 2006-2009 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>