use MooseX::Meta::TypeConstraint::Structured;
use MooseX::Meta::TypeConstraint::Structured::Optional;
use MooseX::Types::Structured::OverflowHandler;
+use MooseX::Types::Structured::TypeError;
use MooseX::Types -declare => [qw(Dict Map Tuple Optional)];
use Sub::Exporter -setup => [ qw(Dict Map Tuple Optional slurpy) ];
use Devel::PartialDump;
my @values = defined $values ? @$values: ();
## Perform the checking
+ my $slot = 0;
while(@type_constraints) {
my $type_constraint = shift @type_constraints;
if(@values) {
my $value = shift @values;
unless($type_constraint->check($value)) {
- $_[2]->{message} = $type_constraint->get_message($value)
+ $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+ constraint => $type_constraint,
+ value => $value,
+ index => $slot,
+ )
if ref $_[2];
return;
}
} else {
## Test if the TC supports null values
unless ($type_constraint->is_subtype_of($Optional)) {
- $_[2]->{message} = $type_constraint->get_message('NULL')
+ $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+ constraint => $type_constraint,
+ index => $slot,
+ )
if ref $_[2];
return;
}
}
+ ++$slot;
}
## Make sure there are no leftovers.
if(@values) {
my $value = $values{$key};
delete $values{$key};
unless($type_constraint->check($value)) {
- $_[2]->{message} = $type_constraint->get_message($value)
+ $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+ constraint => $type_constraint,
+ index => $key,
+ value => $value,
+ )
if ref $_[2];
return;
}
} else {
## Test to see if the TC supports null values
unless ($type_constraint->is_subtype_of($Optional)) {
- $_[2]->{message} = $type_constraint->get_message('NULL')
+ $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+ constraint => $type_constraint,
+ index => $key,
+ )
if ref $_[2];
return;
}