having to use the sugar layer. This should also clean up their APIs
as well, which will make it easier to subclass them.
-- create an official TC registry API
-
-Right now the registration of the TC is a by-product of creation in the sugar
-layer, this is bad and make extension of TCs difficult. I am not sure if this
-registry API should exist as part of Moose::Util::TypeConstraints, or of we
-should create a complete registry object itself.
-
-This registry should be a singleton, but M::U::TC should enforce that lifecycle
-choice so that you can use your own registry if you really want too.
-
-I mean parent of the registry. So that I can create my own registry
-object for a given class, and any retrieval of a type constraint from
-this object would automatically search parent registries as well.
-
-- refactor the various TC internals to make it more subclassing friendly
-
-This also includes the coercion stuff as well. This should give you what you
-need to make your object/class bound stuff.
-
-- move the container TCs from MooseX::AttributeHelpers into Moose core
-
-These have proven so useful for me in the latest $work project that I think
-they should really be core.
-
- allow a switch of some kind to optionally turn TC checking off at runtime
The type checks can get expensive and some people have suggested that allowing
my $Foo = subtype Bar => where { ... };
+# ----------
+
+[17:10] <autarch> stevan: it should do it if I pass coerce => 1 as part of the attribute definition
+[17:12] <stevan> autarch: what I am not 100% sure of is how to tell it to deep coerce and when to not
+[17:13] <stevan> cause a basic coerce is from A to B
+[17:13] <autarch> hmm
+[17:13] <stevan> which is valid for collection types too
+[17:13] <stevan> deep coercion is what you are asking for
+[17:13] <autarch> yeah
+[17:13] <stevan> so perhaps we add deep_coerce => 1
+[17:13] <stevan> which will do it
+[17:13] <autarch> that's fine for me
+[17:13] <stevan> k
+
+-----------------------------------------------------------
+- TC stuff DONE
+-----------------------------------------------------------
+
+- create an official TC registry API (DONE)
+
+Right now the registration of the TC is a by-product of creation in the sugar
+layer, this is bad and make extension of TCs difficult. I am not sure if this
+registry API should exist as part of Moose::Util::TypeConstraints, or of we
+should create a complete registry object itself.
+
+This registry should be a singleton, but M::U::TC should enforce that lifecycle
+choice so that you can use your own registry if you really want too.
+
+I mean parent of the registry. So that I can create my own registry
+object for a given class, and any retrieval of a type constraint from
+this object would automatically search parent registries as well.
+
+- refactor the various TC internals to make it more subclassing friendly (DONE)
+
+This also includes the coercion stuff as well. This should give you what you
+need to make your object/class bound stuff.
+
+- move the container TCs from MooseX::AttributeHelpers into Moose core (DONE)
+
+These have proven so useful for me in the latest $work project that I think
+they should really be core.
-----------------------------------------------------------
-- Roles refactor
our $VERSION = '0.14';
our $AUTHORITY = 'cpan:STEVAN';
-# Prototyped subs must be predeclared because we have a circular dependency
-# with Moose::Meta::Attribute et. al. so in case of us being use'd first the
-# predeclaration ensures the prototypes are in scope when consumers are
-# compiled
-
-sub find_type_constraint ($);
-sub _create_type_constraint ($$$;$$);
-sub _install_type_coercions ($$);
-sub create_type_constraint_union (@);
-sub type ($$;$$);
-sub subtype ($$;$$$);
-sub coerce ($@);
-sub as ($);
-sub from ($);
-sub where (&);
-sub via (&);
-sub message (&);
-sub optimize_as (&);
-sub enum ($;@);
+## --------------------------------------------------------
+# Prototyped subs must be predeclared because we have a
+# circular dependency with Moose::Meta::Attribute et. al.
+# so in case of us being use'd first the predeclaration
+# ensures the prototypes are in scope when consumers are
+# compiled.
+
+# creation and location
+sub find_type_constraint ($);
+sub find_or_create_type_constraint ($;$);
+sub create_type_constraint_union (@);
+sub create_container_type_constraint ($);
+
+# dah sugah!
+sub type ($$;$$);
+sub subtype ($$;$$$);
+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;
use Moose::Meta::TypeConstraint::Union;
}
}
+## --------------------------------------------------------
+## type registry and some useful functions for it
+## --------------------------------------------------------
+
my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new;
-sub _get_type_constraint_registry { $REGISTRY }
-sub _dump_type_constraints { $REGISTRY->dump }
+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}) {
+ *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
+ ->_compiled_type_constraint;
+ }
+}
-# NOTE:
-# this method breaks down the sugar
-# from the functions below.
-sub _create_type_constraint ($$$;$$) {
- my $name = shift;
- my $parent = shift;
- my $check = shift || sub { 1 };
+sub create_type_constraint_union (@) {
+ my @type_constraint_names;
- my ($message, $optimized);
- for (@_) {
- $message = $_->{message} if exists $_->{message};
- $optimized = $_->{optimized} if exists $_->{optimized};
+ if (scalar @_ == 1 && $_[0] =~ /\|/) {
+ @type_constraint_names = (split /\s*\|\s*/ => $_[0]);
+ }
+ else {
+ @type_constraint_names = @_;
}
-
- my $pkg_defined_in = scalar(caller(0));
-
- 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;
- }
-
- $parent = $REGISTRY->get_type_constraint($parent) if defined $parent;
- my $constraint = Moose::Meta::TypeConstraint->new(
- name => $name || '__ANON__',
- parent => $parent,
- constraint => $check,
- message => $message,
- optimized => $optimized,
- package_defined_in => $pkg_defined_in,
- );
-
- $REGISTRY->add_type_constraint($constraint)
- if defined $name;
-
- return $constraint;
-}
-
-sub _install_type_coercions ($$) {
- my ($type_name, $coercion_map) = @_;
- my $type = $REGISTRY->get_type_constraint($type_name);
- (!$type->has_coercion)
- || confess "The type coercion for '$type_name' has already been registered";
- my $type_coercion = Moose::Meta::TypeCoercion->new(
- type_coercion_map => $coercion_map,
- type_constraint => $type
- );
- $type->coercion($type_coercion);
-}
-
-sub create_type_constraint_union (@) {
- my (@type_constraint_names) = @_;
(scalar @type_constraint_names >= 2)
- || confess "You must pass in at least 2 type names to make a union";
+ || confess "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;
+
return Moose::Meta::TypeConstraint::Union->new(
type_constraints => [
map {
);
}
-sub export_type_constraints_as_functions {
- my $pkg = caller();
- no strict 'refs';
- foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
- *{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
- ->_compiled_type_constraint;
- }
+sub create_container_type_constraint ($) {
+ my $type_constraint_name = shift;
+
+ my ($base_type, $container_type) = ($type_constraint_name =~ /^(.*)\[(.*)\]$/);
+
+ (defined $base_type && defined $container_type)
+ || 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)";
+
+ ($REGISTRY->has_type_constraint($container_type))
+ || confess "Could not locate the container type ($container_type)";
+
+ return Moose::Meta::TypeConstraint::Container->new(
+ name => $type_constraint_name,
+ parent => $REGISTRY->get_type_constraint($base_type),
+ container_type => $REGISTRY->get_type_constraint($container_type),
+ );
}
-*Moose::Util::TypeConstraints::export_type_contstraints_as_functions = \&export_type_constraints_as_functions;
-
-sub list_all_type_constraints { keys %{$REGISTRY->type_constraints} }
+sub find_or_create_type_constraint ($;$) {
+ my ($type_constraint_name, $options_for_anon_type) = @_;
+
+ return $REGISTRY->get_type_constraint($type_constraint_name)
+ if $REGISTRY->has_type_constraint($type_constraint_name);
+
+ my $constraint;
+
+ if ($type_constraint_name =~ /\|/) {
+ $constraint = create_type_constraint_union($type_constraint_name);
+ }
+ elsif ($type_constraint_name =~ /^.*?\[.*?\]$/) {
+ $constraint = create_container_type_constraint($type_constraint_name);
+ }
+ else {
+ # NOTE:
+ # otherwise assume that we should create
+ # an ANON type with the $options_for_anon_type
+ # options which can be passed in. It should
+ # be noted that these don't get registered
+ # so we need to return it.
+ # - SL
+ return Moose::Meta::TypeConstraint->new(
+ name => '__ANON__',
+ %{$options_for_anon_type}
+ );
+ }
+
+ $REGISTRY->add_type_constraint($constraint);
+ return $constraint;
+}
## --------------------------------------------------------
## exported functions ...
);
}
-# define some basic types
+## --------------------------------------------------------
+## desugaring functions ...
+## --------------------------------------------------------
+
+sub _create_type_constraint ($$$;$$) {
+ my $name = shift;
+ my $parent = shift;
+ my $check = shift || sub { 1 };
+
+ my ($message, $optimized);
+ for (@_) {
+ $message = $_->{message} if exists $_->{message};
+ $optimized = $_->{optimized} if exists $_->{optimized};
+ }
+
+ my $pkg_defined_in = scalar(caller(0));
+
+ 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;
+ }
+
+ $parent = $REGISTRY->get_type_constraint($parent) if defined $parent;
+
+ my $constraint = Moose::Meta::TypeConstraint->new(
+ name => $name || '__ANON__',
+ parent => $parent,
+ constraint => $check,
+ message => $message,
+ optimized => $optimized,
+ package_defined_in => $pkg_defined_in,
+ );
+
+ $REGISTRY->add_type_constraint($constraint)
+ if defined $name;
+
+ return $constraint;
+}
+
+sub _install_type_coercions ($$) {
+ my ($type_name, $coercion_map) = @_;
+ my $type = $REGISTRY->get_type_constraint($type_name);
+ (!$type->has_coercion)
+ || confess "The type coercion for '$type_name' has already been registered";
+ my $type_coercion = Moose::Meta::TypeCoercion->new(
+ type_coercion_map => $coercion_map,
+ type_constraint => $type
+ );
+ $type->coercion($type_coercion);
+}
+
+## --------------------------------------------------------
+# define some basic built-in types
+## --------------------------------------------------------
type 'Any' => where { 1 }; # meta-type including all
type 'Item' => where { 1 }; # base-type
=> where { eval { $_->isa('UNIVERSAL') } }
=> optimize_as { !ref($_[0]) && eval { $_[0]->isa('UNIVERSAL') } };
+## --------------------------------------------------------
+# end of built-in types ...
+## --------------------------------------------------------
+
{
my @BUILTINS = list_all_type_constraints();
sub list_all_builtin_type_constraints { @BUILTINS }
=head1 FUNCTIONS
-=head2 Type Constraint Registry
+=head2 Type Constraint Construction & Locating
=over 4
-=item B<find_type_constraint ($type_name)>
+=item B<create_type_constraint_union ($pipe_seperated_types | @type_constraint_names)>
-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 :)
+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.
-=item B<create_type_constraint_union (@type_constraint_names)>
+=item B<create_container_type_constraint ($type_name)>
-Given a list of C<@type_constraint_names>, this will return a
-B<Moose::Meta::TypeConstraint::Union> instance.
+Given a C<$type_name> in the form of:
-=item B<export_type_constraints_as_functions>
+ BaseType[ContainerType]
-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.
+this will extract the base type and container type and build an instance of
+L<Moose::Meta::TypeConstraint::Container> for it.
+
+=item B<find_or_create_type_constraint ($type_name, ?$options_for_anon_type)>
-=item B<export_type_contstraints_as_functions>
+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.
-Alias for the above function.
+=item B<find_type_constraint ($type_name)>
+
+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 :)
+
+=item B<get_type_constraint_registry>
+
+Fetch the L<Moose::Meta::TypeConstraint::Registry> object which
+keeps track of all type constraints.
=item B<list_all_type_constraints>
those which are defined in this module. See the section
labeled L<Default Type Constraints> 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. Right now, this is mostly used for
+testing, but it might prove useful to others.
+
=back
=head2 Type Constraint Constructors
projects / gitmo/Moose.git / commitdiff