toward better error messages

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

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Structured.pm
index 9a76e4c..33ed2c8 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured.pm
@@ -66,18 +66,31 @@ Messing with validate so that we can support niced error messages.
 =cut
 
 override 'validate' => sub {
-    my ($self, @args) = @_;
-    my $message = bless {message=>undef}, 'MooseX::Types::Structured::Message';
+    my ($self, $value, $message) = @_;
+    $message = bless {message=>undef, level=>0}, 'MooseX::Types::Structured::Message'
+      unless $message;
 
-    if ($self->_compiled_type_constraint->(@args, $message)) {
+    $message->{level}++;
+
+    if ($self->_compiled_type_constraint->($value, $message)) {
         ## 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);
+        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}) {
+                return $self->get_message($args);
+            } else {
+                return $self->get_message("$args, Internal Validation Error is: $message_str");
+            }
         } else {
+            $message->{level}--;
+
             return $self->get_message($args);
         }
     }