package ## Hide from PAUSE
MooseX::Meta::TypeConstraint::Structured;
-# ABSTRACT: MooseX::Meta::TypeConstraint::Structured - Structured type constraints.
+# ABSTRACT: Structured type constraints.
use Moose;
use Devel::PartialDump;
A structure is a set of L<Moose::Meta::TypeConstraint> that are 'aggregated' in
such a way as that they are all applied to an incoming list of arguments. The
-idea here is that a Type Constraint could be something like, "An Int followed by
-an Int and then a Str" and that this could be done so with a declaration like:
+idea here is that a Type Constraint could be something like, "An C<Int> followed by
+an C<Int> and then a C<Str>" and that this could be done so with a declaration like:
Tuple[Int,Int,Str]; ## Example syntax
-So a structure is a list of Type constraints (the "Int,Int,Str" in the above
+So a structure is a list of type constraints (the C<Int,Int,Str> in the above
example) which are intended to function together.
=attr type_constraints
=attr constraint_generator
+=for stopwords subref
+
A subref or closure that contains the way we validate incoming values against
a set of type constraints.
=method validate
-Messing with validate so that we can support niced error messages.
+Messing with validate so that we can support nicer error messages.
=cut
+sub _clean_message {
+ my $message = shift @_;
+ $message =~s/MooseX::Types::Structured:://g;
+ return $message;
+}
+
override 'validate' => sub {
- my ($self, @args) = @_;
- my $message = bless {message=>undef}, 'MooseX::Types::Structured::Message';
+ my ($self, $value, $message_stack) = @_;
+ unless ($message_stack) {
+ $message_stack = MooseX::Types::Structured::MessageStack->new();
+ }
+
+ $message_stack->inc_level;
- if ($self->_compiled_type_constraint->(@args, $message)) {
+ if ($self->_compiled_type_constraint->($value, $message_stack)) {
## Everything is good, no error message to return
return undef;
} else {
## Whoops, need to figure out the right error message
- my $args = Devel::PartialDump::dump(@args);
- if(my $message = $message->{message}) {
- return $self->get_message("$args, Internal Validation Error is: $message");
+ my $args = Devel::PartialDump::dump($value);
+ $message_stack->dec_level;
+ if($message_stack->has_messages) {
+ if($message_stack->level) {
+ ## we are inside a deeply structured constraint
+ return $self->get_message($args);
+ } else {
+ my $message_str = $message_stack->as_string;
+ return _clean_message($self->get_message("$args, Internal Validation Error is: $message_str"));
+ }
} else {
return $self->get_message($args);
}
sub generate_constraint_for {
my ($self, $type_constraints) = @_;
- return sub {
- my $arg = shift @_;
- my $constraint_generator = $self->constraint_generator;
- my $result = $constraint_generator->($type_constraints, $arg, $_[0]);
- return $result;
- };
+ return $self->constraint_generator->($self, $type_constraints);
}
+=for stopwords parameterize
+
=method parameterize (@type_constraints)
Given a ref of type constraints, create a structured type.
=method __infer_constraint_generator
+=for stopwords servicable
+
This returns a CODEREF which generates a suitable constraint generator. Not
user servicable, you'll never call this directly.
sub equals {
my ( $self, $type_or_name ) = @_;
- my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
+ my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+ or return;
return unless $other->isa(__PACKAGE__);
sub is_a_type_of {
my ( $self, $type_or_name ) = @_;
- my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
+ my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+ or return;
if ( $other->isa(__PACKAGE__) and @{ $other->type_constraints || [] }) {
if ( $self->parent->is_a_type_of($other->parent) ) {
sub is_subtype_of {
my ( $self, $type_or_name ) = @_;
- my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name);
+ my $other = Moose::Util::TypeConstraints::find_type_constraint($type_or_name)
+ or return;
if ( $other->isa(__PACKAGE__) ) {
if ( $other->type_constraints and $self->type_constraints ) {
if ( $self->parent->is_a_type_of($other->parent) ) {