package Moose::Util::TypeConstraints;
-use strict;
-use warnings;
+use Carp ();
+use List::MoreUtils qw( all any );
+use Scalar::Util qw( blessed reftype );
+use Moose::Exporter;
-use Carp 'confess';
-use Scalar::Util 'blessed', 'reftype';
-use Sub::Exporter;
-
-our $VERSION = '0.21';
+our $VERSION = '0.95';
+$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 create_type_constraint_union (@);
-sub create_parameterized_type_constraint ($);
-sub create_class_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 ($$);
## --------------------------------------------------------
use Moose::Meta::TypeConstraint::Union;
use Moose::Meta::TypeConstraint::Parameterized;
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;
-my @exports = qw/
- type subtype class_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 duck_type
+ as where message optimize_as
+ coerce from via
+ enum
+ find_type_constraint
+ register_type_constraint
+ match_on_type )
+ ],
+);
## --------------------------------------------------------
## type registry and some useful functions for it
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 };
+ 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)
- || confess "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($_))
- || 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 )
+ || __PACKAGE__->_throw_error(
+ "Could not parse type name ($type_constraint_name) correctly");
+
+ 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)");
+ }
+}
- my ($base_type, $type_parameter) = _parse_parameterized_type_constraint($type_constraint_name);
+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),
+ );
+ }
+}
- (defined $base_type && defined $type_parameter)
- || confess "Could not parse type name ($type_constraint_name) correctly";
+#should we also support optimized checks?
+sub create_class_type_constraint {
+ my ( $class, $options ) = @_;
- ($REGISTRY->has_type_constraint($base_type))
- || confess "Could not locate the base type ($base_type)";
+# 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");
- return Moose::Meta::TypeConstraint::Parameterized->new(
- name => $type_constraint_name,
- parent => $REGISTRY->get_type_constraint($base_type),
- type_parameter => find_or_create_type_constraint(
- $type_parameter => {
- parent => $REGISTRY->get_type_constraint('Object'),
- constraint => sub { $_[0]->isa($type_parameter) }
- }
- ),
+ my %options = (
+ class => $class,
+ name => $class,
+ %{ $options || {} },
);
+
+ $options{name} ||= "__ANON__";
+
+ Moose::Meta::TypeConstraint::Class->new(%options);
}
-sub create_class_type_constraint ($) {
- my $class = shift;
+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";
+# 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");
- Moose::Meta::TypeConstraint::Class->new( name => $class );
-}
+ my %options = (
+ role => $role,
+ name => $role,
+ %{ $options || {} },
+ );
-sub find_or_create_type_constraint ($;$) {
- my ($type_constraint_name, $options_for_anon_type) = @_;
+ $options{name} ||= "__ANON__";
- return $REGISTRY->get_type_constraint($type_constraint_name)
- if $REGISTRY->has_type_constraint($type_constraint_name);
+ Moose::Meta::TypeConstraint::Role->new(%options);
+}
- my $constraint;
+sub find_or_create_type_constraint {
+ my ( $type_constraint_name, $options_for_anon_type ) = @_;
- if (_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);
+ if ( my $constraint
+ = find_or_parse_type_constraint($type_constraint_name) ) {
+ return $constraint;
}
- else {
+ elsif ( defined $options_for_anon_type ) {
+
# NOTE:
- # if there is no $options_for_anon_type
- # specified, then we assume they don't
+ # if there is no $options_for_anon_type
+ # specified, then we assume they don't
# want to create one, and return nothing.
- return unless defined $options_for_anon_type;
- # NOTE:
# otherwise assume that we should create
# an ANON type with the $options_for_anon_type
# options which can be passed in. It should
);
}
+ return;
+}
+
+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 {
+ 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 = normalize_type_constraint_name(shift);
+ my $constraint;
+
+ 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) ) {
+ $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 ($) { $REGISTRY->get_type_constraint(@_) }
+sub find_type_constraint {
+ my $type = shift;
-sub register_type_constraint ($) {
+ if ( blessed $type and $type->isa("Moose::Meta::TypeConstraint") ) {
+ return $type;
+ }
+ else {
+ return unless $REGISTRY->has_type_constraint($type);
+ return $REGISTRY->get_type_constraint($type);
+ }
+}
+
+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(@_);
+ }
+
+ 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}
+ );
}
-sub class_type ($) {
- register_type_constraint( create_class_type_constraint(shift) );
+sub class_type {
+ register_type_constraint(
+ create_class_type_constraint(
+ $_[0],
+ ( defined( $_[1] ) ? $_[1] : () ),
+ )
+ );
}
-sub coerce ($@) {
- my ($type_name, @coercion_map) = @_;
- _install_type_coercions($type_name, \@coercion_map);
+sub role_type ($;$) {
+ register_type_constraint(
+ create_role_type_constraint(
+ $_[0],
+ ( defined( $_[1] ) ? $_[1] : () ),
+ )
+ );
}
-sub as ($) { $_[0] }
-sub from ($) { $_[0] }
-sub where (&) { $_[0] }
-sub via (&) { $_[0] }
+sub maybe_type {
+ my ($type_parameter) = @_;
-sub message (&) { +{ message => $_[0] } }
-sub optimize_as (&) { +{ optimized => $_[0] } }
+ register_type_constraint(
+ $REGISTRY->get_type_constraint('Maybe')->parameterize($type_parameter)
+ );
+}
+
+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 enum ($;@) {
- my ($type_name, @values) = @_;
- (scalar @values >= 2)
- || confess "You must have at least two values to enumerate through";
+ 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 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
+ # you get an anon-enum
+ # - SL
+ if ( ref $type_name eq 'ARRAY' && !@values ) {
+ @values = @$type_name;
+ $type_name = undef;
+ }
+ if ( @values == 1 && ref $values[0] eq 'ARRAY' ) {
+ @values = @{ $values[0] };
+ }
+ ( scalar @values >= 2 )
+ || __PACKAGE__->_throw_error(
+ "You must have at least two values to enumerate through");
my %valid = map { $_ => 1 } @values;
- _create_type_constraint(
- $type_name,
- 'Str',
- sub { $valid{$_} }
+
+ register_type_constraint(
+ create_enum_type_constraint(
+ $type_name,
+ \@values,
+ )
);
}
+sub create_enum_type_constraint {
+ my ( $type_name, $values ) = @_;
+
+ Moose::Meta::TypeConstraint::Enum->new(
+ 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 $name = shift;
+ my $parent = shift;
+ my $check = shift;
+ my $message = shift;
+ my $optimized = shift;
- my ($message, $optimized);
- for (@_) {
- $message = $_->{message} if exists $_->{message};
- $optimized = $_->{optimized} if exists $_->{optimized};
- }
-
- 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_create_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)
if defined $name;
}
sub _install_type_coercions ($$) {
- my ($type_name, $coercion_map) = @_;
- my $type = $REGISTRY->get_type_constraint($type_name);
- (defined $type)
- || confess "Cannot find type '$type_name', perhaps you forgot to load it.";
- if ($type->has_coercion) {
+ my ( $type_name, $coercion_map ) = @_;
+ my $type = find_type_constraint($type_name);
+ ( 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 {
## --------------------------------------------------------
{
+
# 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
use re "eval";
- my $valid_chars = qr{[\w:]};
- my $type_atom = qr{ $valid_chars+ };
+ my $valid_chars = qr{[\w:\.]};
+ my $type_atom = qr{ (?>$valid_chars+) }x;
+ my $ws = qr{ (?>\s*) }x;
- 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 $op_union = qr{ \s* \| \s* }x;
- my $union = qr{ $type (?: $op_union $type )+ }x;
+ my $type = qr{ $type_atom (?: \[ $ws (??{$any}) $ws \] )? }x;
+ my $type_capture_parts
+ = qr{ ($type_atom) (?: \[ $ws ((??{$any})) $ws \] )? }x;
+ my $type_with_parameter
+ = qr{ $type_atom \[ $ws (??{$any}) $ws \] }x;
- our $any = qr{ $type | $union }x;
+ my $op_union = qr{ $ws \| $ws }x;
+ my $union = qr{ $type (?> (?: $op_union $type )+ ) }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);
+ 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;
+ push @rv => $1;
}
- (pos($given) eq length($given))
- || confess "'$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
$_[0] =~ m{^ $type $op_union $type ( $op_union .* )? $}x;
}
}
# define some basic built-in types
## --------------------------------------------------------
-type 'Any' => where { 1 }; # meta-type including all
-type 'Item' => where { 1 }; # base-type
+# 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 { 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
+);
+
+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 { 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;
+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 '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;
+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 '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;
+# This type is deprecated.
+subtype 'Role' => as 'Object' => 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]);
+my $_class_name_checker = sub { };
- # walk the symbol table tree to avoid autovififying
- # \*{${main::}{"Foo::"}} == \*main::Foo::
+subtype 'ClassName' => as 'Str' =>
+ where { Class::MOP::is_class_loaded($_) } => optimize_as
+ \&Moose::Util::TypeConstraints::OptimizedConstraints::ClassName;
- 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;
-};
-
-subtype 'ClassName'
- => as 'Str'
- => $_class_name_checker # where ...
- => { optimize => $_class_name_checker };
+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 => 'ArrayRef',
- package_defined_in => __PACKAGE__,
- parent => find_type_constraint('Ref'),
- constraint => sub { ref($_) eq 'ARRAY' },
- optimized => \&Moose::Util::TypeConstraints::OptimizedConstraints::ArrayRef,
+ 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 (@$_) {
- ($type_parameter->check($x)) || return
- } 1;
- }
+ ( $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,
+ 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 $type_parameter = shift;
+ my $check = $type_parameter->_compiled_type_constraint;
return sub {
- foreach my $x (values %$_) {
- ($type_parameter->check($x)) || return
- } 1;
- }
+ foreach my $x ( values %$_ ) {
+ ( $check->($x) ) || return;
+ }
+ 1;
+ }
}
)
);
name => 'Maybe',
package_defined_in => __PACKAGE__,
parent => find_type_constraint('Item'),
- constraint => sub { 1 },
+ constraint => sub {1},
constraint_generator => sub {
- my $type_parameter = shift;
+ my $type_parameter = shift;
+ my $check = $type_parameter->_compiled_type_constraint;
return sub {
- return 1 if not(defined($_)) || $type_parameter->check($_);
+ return 1 if not( defined($_) ) || $check->($_);
return;
- }
+ }
}
)
);
-my @PARAMETERIZABLE_TYPES = map {
- $REGISTRY->get_type_constraint($_)
-} qw[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 {
+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";
+ ( 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;
-}
+}
## --------------------------------------------------------
# end of built-in types ...
{
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;
use Moose::Util::TypeConstraints;
- type 'Num' => where { Scalar::Util::looks_like_number($_) };
-
subtype 'Natural'
- => as 'Num'
+ => as 'Int'
=> where { $_ > 0 };
subtype 'NaturalLessThanTen'
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<NOT> 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.
+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 almost always a good idea to quote your type and subtype 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.
+It is B<always> a good idea to quote your type names.
-So for instance, this:
+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.
+
+For instance:
subtype DateTime => as Object => where { $_->isa('DateTime') };
-will I<Just Work>, while this:
+will I<just work>, 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') };
=head2 Default Type Constraints
-This module also provides a simple hierarchy for Perl 5 types, this
-could probably use some work, but it works for me at the moment.
+This module also provides a simple hierarchy for Perl 5 types, here is
+that hierarchy represented visually.
Any
Item
Undef
Defined
Value
- Num
- Int
Str
- ClassName
+ Num
+ Int
+ ClassName
+ RoleName
Ref
ScalarRef
ArrayRef[`a]
CodeRef
RegexpRef
GlobRef
- FileHandle
+ FileHandle
Object
- Role
-
-Suggestions for improvement are welcome.
-B<NOTE:> Any type followed by a type parameter C<[`a]> can be
+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
-B<NOTE:> The C<Undef> type constraint for the most part works
-correctly now, but edge cases may still exist, please use it
-sparringly.
+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 treated as a new type
+name, I<not> as a parameterization of C<ArrayRef>.
+
+B<NOTE:> The C<Undef> type constraint for the most part works
+correctly now, but edge cases may still exist, please use it
+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.
+existence check. This means that your class B<must> be loaded for this
+type constraint to pass.
+
+B<NOTE:> The C<RoleName> constraint checks a string is a I<package
+name> 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<Color> type for your
+B<My::Graphics> module, you would call the type
+I<My::Graphics::Types::Color> instead.
=head2 Use with Other Constraint Modules
-This module should play fairly nicely with other constraint
-modules with only 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 bool. 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<where> clause in types is expected to be a
+C<CODE> 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.
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/204_example_w_DCS.t> test file.
+For more examples see the F<t/200_examples/004_example_w_DCS.t> test
+file.
Here is an example of using L<Test::Deep> and it's non-test
related C<eq_deeply> function.
})))
};
-For a complete example see the F<t/205_example_w_TestDeep.t>
-test file.
+For a complete example see the
+F<t/200_examples/005_example_w_TestDeep.t> test file.
=head1 FUNCTIONS
-=head2 Type Constraint Construction & Locating
+=head2 Type Constraint Constructors
-=over 4
+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.
-=item B<create_type_constraint_union ($pipe_seperated_types | @type_constraint_names)>
+See the L<SYNOPSIS> for an example of how to use these.
-Given string with C<$pipe_seperated_types> or a list of C<@type_constraint_names>,
-this will return a L<Moose::Meta::TypeConstraint::Union> instance.
+=over 4
-=item B<create_parameterized_type_constraint ($type_name)>
+=item B<< subtype 'Name' => as 'Parent' => where { } ... >>
-Given a C<$type_name> in the form of:
+This creates a named subtype.
- BaseType[ContainerType]
+If you provide a parent that Moose does not recognize, it will
+automatically create a new class type constraint for this name.
-this will extract the base type and container type and build an instance of
-L<Moose::Meta::TypeConstraint::Parameterized> for it.
+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:
-=item B<create_class_type_constraint ($class)>
+ subtype( 'Foo', { where => ..., message => ... } );
-Given a class name it will create a new L<Moose::Meta::TypeConstraint::Class>
-object for that class name.
+The valid hashref keys are C<as> (the parent), C<where>, C<message>,
+and C<optimize_as>.
-=item B<find_or_create_type_constraint ($type_name, ?$options_for_anon_type)>
+=item B<< subtype as 'Parent' => where { } ... >>
-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, and lastly if nothing can be
-found or created that way, it will create an anon-type using the
-C<$options_for_anon_type> HASH ref to populate it. If the C<$options_for_anon_type>
-is not specified (it is C<undef>), then it will not create anything and simply
-return.
+This creates an unnamed subtype and will return the type
+constraint meta-object, which will be an instance of
+L<Moose::Meta::TypeConstraint>.
-=item B<find_type_constraint ($type_name)>
+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:
-This function can be used to locate a specific type constraint
-meta-object, of the class L<Moose::Meta::TypeConstraint> or a
-derivative. What you do with it from there is up to you :)
+ subtype( { where => ..., message => ... } );
-=item B<register_type_constraint ($type_object)>
+=item B<class_type ($class, ?$options)>
-This function will register a named type constraint with the type registry.
+Creates a new subtype of C<Object> with the name C<$class> and the
+metaclass L<Moose::Meta::TypeConstraint::Class>.
-=item B<get_type_constraint_registry>
+=item B<role_type ($role, ?$options)>
-Fetch the L<Moose::Meta::TypeConstraint::Registry> object which
-keeps track of all type constraints.
+Creates a C<Role> type constraint with the name C<$role> and the
+metaclass L<Moose::Meta::TypeConstraint::Role>.
-=item B<list_all_type_constraints>
+=item B<maybe_type ($type)>
-This will return a list of type constraint names, you can then
-fetch them using C<find_type_constraint ($type_name)> if you
-want to.
+Creates a type constraint for either C<undef> or something of the
+given type.
-=item B<list_all_builtin_type_constraints>
+=item B<duck_type ($name, \@methods)>
-This will return a list of builtin type constraints, meaning,
-those which are defined in this module. See the section
-labeled L<Default Type Constraints> for a complete list.
+This will create a subtype of Object and test to make sure the value
+C<can()> do the methods in C<\@methods>.
-=item B<export_type_constraints_as_functions>
+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<requires>-only Role instead.
-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<duck_type (\@methods)>
-=item B<get_all_parameterizable_types>
+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:
-This returns all the parameterizable types that have been registered.
+ has 'cache' => (
+ is => 'ro',
+ isa => duck_type( [qw( get_set )] ),
+ );
-=item B<add_parameterizable_type ($type)>
+=item B<enum ($name, \@values)>
-Adds C<$type> to the list of parameterizable types
+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.
-=back
+B<NOTE:> This is not a true proper enum type, it is simply
+a convenient constraint builder.
-=head2 Type Constraint Constructors
+=item B<enum (\@values)>
-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.
+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:
-See the L<SYNOPSIS> for an example of how to use these.
+ has 'sort_order' => (
+ is => 'ro',
+ isa => enum([qw[ ascending descending ]]),
+ );
-=over 4
+=item B<as 'Parent'>
-=item B<type ($name, $where_clause)>
+This is just sugar for the type constraint construction syntax.
-This creates a base type, which has no parent.
+It takes a single argument, which is the name of a parent type.
-=item B<subtype ($name, $parent, $where_clause, ?$message)>
+=item B<where { ... }>
-This creates a named subtype.
+This is just sugar for the type constraint construction syntax.
-=item B<subtype ($parent, $where_clause, ?$message)>
+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.
-This creates an unnamed subtype and will return the type
-constraint meta-object, which will be an instance of
-L<Moose::Meta::TypeConstraint>.
+=item B<message { ... }>
-=item B<class_type ($class)>
+This is just sugar for the type constraint construction syntax.
-Creates a type constraint with the name C<$class> and the metaclass
-L<Moose::Meta::TypeConstraint::Class>.
+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<enum ($name, @values)>
+=item B<optimize_as { ... }>
-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.
+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:> This is not a true proper enum type, it is simple
-a convient constraint builder.
+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<as>
+=item B<< type 'Name' => where { } ... >>
-This is just sugar for the type constraint construction syntax.
+This creates a base type, which has no parent.
-=item B<where>
+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:
-This is just sugar for the type constraint construction syntax.
+ type( 'Foo', { where => ..., message => ... } );
-=item B<message>
+The valid hashref keys are C<where>, C<message>, and C<optimize_as>.
-This is just sugar for the type constraint construction syntax.
+=back
-=item B<optimize_as>
+=head2 Type Constraint Utilities
-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.
+=over 4
-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<< 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<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
=head2 Type Coercion Constructors
-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.
+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<SYNOPSIS> for an example of how to use these.
=over 4
-=item B<coerce>
+=item B<< coerce 'Name' => from 'OtherName' => via { ... } >>
-=item B<from>
+This defines a coercion from one type to another. The C<Name> argument
+is the type you are coercing I<to>.
+
+=item B<from 'OtherName'>
This is just sugar for the type coercion construction syntax.
-=item B<via>
+It takes a single type name (or type object), which is the type being
+coerced I<from>.
+
+=item B<via { ... }>
This is just sugar for the type coercion construction syntax.
+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.
+
=back
-=head2 Namespace Management
+=head2 Creating and Finding Type Constraints
+
+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.
=over 4
-=item B<unimport>
+=item B<find_type_constraint($type_name)>
+
+This function can be used to locate the L<Moose::Meta::TypeConstraint>
+object for a named type.
+
+This function is importable.
+
+=item B<register_type_constraint($type_object)>
+
+This function will register a L<Moose::Meta::TypeConstraint> with the
+global type registry.
+
+This function is importable.
+
+=item B<normalize_type_constraint_name($type_constraint_name)>
+
+This method takes a type constraint name and returns the normalized
+form. This removes any whitespace in the string.
+
+=item B<create_type_constraint_union($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<create_parameterized_type_constraint($type_name)>
+
+Given a C<$type_name> in the form of C<'BaseType[ContainerType]'>,
+this will create a new L<Moose::Meta::TypeConstraint::Parameterized>
+object. The C<BaseType> must exist already exist as a parameterizable
+type.
+
+=item B<create_class_type_constraint($class, $options)>
+
+Given a class name this function will create a new
+L<Moose::Meta::TypeConstraint::Class> object for that class name.
+
+The C<$options> is a hash reference that will be passed to the
+L<Moose::Meta::TypeConstraint::Class> constructor (as a hash).
+
+=item B<create_role_type_constraint($role, $options)>
-This will remove all the type constraint keywords from the
-calling class namespace.
+Given a role name this function will create a new
+L<Moose::Meta::TypeConstraint::Role> object for that role name.
+
+The C<$options> is a hash reference that will be passed to the
+L<Moose::Meta::TypeConstraint::Role> constructor (as a hash).
+
+=item B<create_enum_type_constraint($name, $values)>
+
+Given a enum name this function will create a new
+L<Moose::Meta::TypeConstraint::Enum> object for that enum name.
+
+=item B<create_duck_type_constraint($name, $methods)>
+
+Given a duck type name this function will create a new
+L<Moose::Meta::TypeConstraint::DuckType> object for that enum name.
+
+=item B<find_or_parse_type_constraint($type_name)>
+
+Given a type name, this first attempts to find a matching constraint
+in the global registry.
+
+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.
+
+When given a union or parameterized type, the member or base type must
+already exist.
+
+If it creates a new union or parameterized type, it will add it to the
+global registry.
+
+=item B<find_or_create_isa_type_constraint($type_name)>
+
+=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
+be created.
+
+The C<isa> variant will use C<create_class_type_constraint> and the
+C<does> variant will use C<create_role_type_constraint>.
+
+=item B<get_type_constraint_registry>
+
+Returns the L<Moose::Meta::TypeConstraint::Registry> object which
+keeps track of all type constraints.
+
+=item B<list_all_type_constraints>
+
+This will return a list of type constraint names in the global
+registry. You can then fetch the actual type object using
+C<find_type_constraint($type_name)>.
+
+=item B<list_all_builtin_type_constraints>
+
+This will return a list of builtin type constraints, meaning those
+which are defined in this module. See the L<Default Type Constraints>
+section for a complete list.
+
+=item B<export_type_constraints_as_functions>
+
+This will export all the current type constraints as functions into
+the caller's namespace (C<Int()>, C<Str()>, etc). Right now, this is
+mostly used for testing, but it might prove useful to others.
+
+=item B<get_all_parameterizable_types>
+
+This returns all the parameterizable types that have been registered,
+as a list of type objects.
+
+=item B<add_parameterizable_type($type)>
+
+Adds C<$type> to the list of parameterizable types
=back
=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.
+See L<Moose/BUGS> for details on reporting bugs.
=head1 AUTHOR
=head1 COPYRIGHT AND LICENSE
-Copyright 2006-2008 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
projects / gitmo/Moose.git / blobdiff