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, $value, $message) = @_;
- $message = bless {message=>undef, level=>0}, 'MooseX::Types::Structured::Message'
- unless $message;
+ my ($self, $value, $message_stack) = @_;
+ unless ($message_stack) {
+ $message_stack = MooseX::Types::Structured::MessageStack->new();
+ }
- $message->{level}++;
+ $message_stack->inc_level;
- if ($self->_compiled_type_constraint->($value, $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($value);
- if(my $messages = $message->{message}) {
- my $level = $message->{level};
- my $message_str = ref $messages ? join("\n".(" "x$level)."[+] ",reverse @$messages) : $messages;
- $message->{level}--;
-
- if($message->{level}) {
+ $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 {
- return $self->get_message("$args, Internal Validation Error is: $message_str");
+ my $message_str = $message_stack->as_string;
+ return _clean_message($self->get_message("$args, Internal Validation Error is: $message_str"));
}
} else {
- $message->{level}--;
-
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) ) {