X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FMeta%2FTypeConstraint%2FStructured.pm;h=166794772a135c590616709040463bdfdc79631a;hb=8b810e835ea88682b4858363749fa201e9b45126;hp=9a76e4cbf84ca5c149acf828948a54c0c76c0bf0;hpb=8dbdca20076b8b21e23c3235ee1655d047065e6e;p=gitmo%2FMooseX-Types-Structured.git

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Structured.pm
index 9a76e4c..1667947 100644
--- a/lib/MooseX/Meta/TypeConstraint/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured.pm
@@ -1,6 +1,6 @@
 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;
@@ -13,12 +13,12 @@ extends 'Moose::Meta::TypeConstraint';
 
 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
@@ -35,6 +35,8 @@ has '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.
 
@@ -61,22 +63,39 @@ sub _build_coercion {
 
 =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);
         }
@@ -92,14 +111,11 @@ of values (to be passed at check time)
 
 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.
@@ -122,6 +138,8 @@ sub parameterize {
 
 =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.
 
@@ -185,7 +203,8 @@ Override the base class behavior.
 
 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__);
 
@@ -198,7 +217,8 @@ sub equals {
 
 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) ) {
@@ -216,7 +236,8 @@ sub is_a_type_of {
 
 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) ) {