Use the new TypeError class to return structured error objects

[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index 2303f17..808985f 100644 (file)
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -6,6 +6,7 @@ use Moose::Util::TypeConstraints;
 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;
@@ -128,7 +129,7 @@ if you are not familiar with it.
 =head2 Comparing Parameterized types to Structured types
 
 Parameterized constraints are built into core Moose and you are probably already
-familar with the type constraints 'HashRef' and 'ArrayRef'.  Structured types
+familiar with the type constraints 'HashRef' and 'ArrayRef'.  Structured types
 have similar functionality, so their syntax is likewise similar. For example,
 you could define a parameterized constraint like:
 
@@ -745,23 +746,32 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 
                        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) {
@@ -809,14 +819,21 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                        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;
                                        }