use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.04';
+our $VERSION = '0.06';
__PACKAGE__->meta->add_attribute('name' => (reader => 'name' ));
__PACKAGE__->meta->add_attribute('parent' => (reader => 'parent' ));
return $self;
}
+sub coerce {
+ ((shift)->coercion || confess "Cannot coerce without a type coercion")->coerce(@_)
+}
+
+sub _collect_all_parents {
+ my $self = shift;
+ my @parents;
+ my $current = $self->parent;
+ while (defined $current) {
+ unshift @parents => $current;
+ $current = $current->parent;
+ }
+ return @parents;
+}
+
sub compile_type_constraint {
my $self = shift;
my $check = $self->constraint;
|| confess "Could not compile type constraint '" . $self->name . "' because no constraint check";
my $parent = $self->parent;
if (defined $parent) {
- # we have a subtype ...
- $parent = $parent->_compiled_type_constraint;
+ # we have a subtype ...
+ # so we gather all the parents in order
+ # and grab their constraints ...
+ my @parents = map { $_->constraint } $self->_collect_all_parents;
+ # then we compile them to run without
+ # having to recurse as we did before
$self->_compiled_type_constraint(subname $self->name => sub {
local $_ = $_[0];
- return undef unless defined $parent->($_[0]) && $check->($_[0]);
+ foreach my $parent (@parents) {
+ return undef unless $parent->($_[0]);
+ }
+ return undef unless $check->($_[0]);
1;
});
+
}
else {
# we have a type ....
|| confess "You must pass in only Moose::Meta::TypeConstraint instances to make unions"
foreach @type_constraints;
return Moose::Meta::TypeConstraint::Union->new(
- type_constraints => \@type_constraints
+ type_constraints => \@type_constraints,
);
}
use warnings;
use metaclass;
-our $VERSION = '0.01';
+our $VERSION = '0.03';
__PACKAGE__->meta->add_attribute('type_constraints' => (
accessor => 'type_constraints',
# conform to the TypeConstraint API
sub parent { undef }
-sub coercion { undef }
-sub has_coercion { 0 }
sub message { undef }
sub has_message { 0 }
-sub check {
+# FIXME:
+# not sure what this should actually do here
+sub coercion { undef }
+
+# this should probably be memoized
+sub has_coercion {
+ my $self = shift;
+ foreach my $type (@{$self->type_constraints}) {
+ return 1 if $type->has_coercion
+ }
+ return 0;
+}
+
+# NOTE:
+# this feels too simple, and may not always DWIM
+# correctly, especially in the presence of
+# close subtype relationships, however it should
+# work for a fair percentage of the use cases
+sub coerce {
my $self = shift;
my $value = shift;
foreach my $type (@{$self->type_constraints}) {
- return 1 if $type->check($value);
+ if ($type->has_coercion) {
+ my $temp = $type->coerce($value);
+ return $temp if $self->check($temp);
+ }
+ }
+ return undef;
+}
+
+sub _compiled_type_constraint {
+ my $self = shift;
+ return sub {
+ my $value = shift;
+ foreach my $type (@{$self->type_constraints}) {
+ return 1 if $type->check($value);
+ }
+ return undef;
}
- return undef;
+}
+
+sub check {
+ my $self = shift;
+ my $value = shift;
+ $self->_compiled_type_constraint->($value);
}
sub validate {
=item B<compile_type_constraint>
+=item B<coerce ($value)>
+
+This will apply the type-coercion if applicable.
+
=item B<check ($value)>
This method will return a true (C<1>) if the C<$value> passes the