Got the basic requirement in place!

diff --git a/lib/MooseX/Meta/TypeConstraint/Dependent.pm b/lib/MooseX/Meta/TypeConstraint/Dependent.pm
index 01853fe..50e2a9c 100644 (file)
--- a/lib/MooseX/Meta/TypeConstraint/Dependent.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Dependent.pm
@@ -29,7 +29,12 @@ L</constraining_type_constraint>
 
 has 'dependent_type_constraint' => (
     is=>'ro',
+    isa=>'Object',
     predicate=>'has_dependent_type_constraint',
+    required=>1,
+    handles=>{
+        check_dependent=>'check',  
+    },
 );
 
 =head2 constraining_type_constraint
@@ -41,10 +46,15 @@ constraining value of the depending type.
 
 has 'constraining_type_constraint' => (
     is=>'ro',
+    isa=>'Object',
     predicate=>'has_constraining_type_constraint',
+    required=>1,
+    handles=>{
+        check_constraining=>'check',  
+    },
 );
 
-=head2 comparision_callback
+=head2 comparison_callback
 
 This is a callback which returns a boolean value.  It get's passed the value
 L</constraining_type_constraint> validates as well as the check value.
@@ -57,10 +67,11 @@ not as a sneaky way to mess with the constraining value.
 
 =cut
 
-has 'comparision_callback' => (
+has 'comparison_callback' => (
     is=>'ro',
     isa=>'CodeRef',
-    predicate=>'has_comparision_callback',
+    predicate=>'has_comparison_callback',
+    required=>1,
 );
 
 =head2 constraint_generator
@@ -74,6 +85,7 @@ has 'constraint_generator' => (
     is=>'ro',
     isa=>'CodeRef',
     predicate=>'has_constraint_generator',
+    required=>1,
 );
 
 =head1 METHODS
@@ -89,12 +101,32 @@ Initialization stuff.
 around 'new' => sub {
     my ($new, $class, @args)  = @_;
     my $self = $class->$new(@args);
-    $self->coercion(MooseX::Meta::TypeCoercion::Structured->new(
+    $self->coercion(MooseX::Meta::TypeCoercion::Dependent->new(
         type_constraint => $self,
     ));
     return $self;
 };
 
+=head2 check($check_value, $constraining_value)
+
+Make sure when properly dispatch all the right values to the right spots
+
+=cut
+
+around 'check' => sub {
+    my ($check, $self, $check_value, $constraining_value) = @_;
+    
+    unless($self->check_dependent($check_value)) {
+        return;
+    }
+
+    unless($self->check_constraining($constraining_value)) {
+        return;
+    }
+
+    return $self->$check($check_value, $constraining_value);
+};
+
 =head2 generate_constraint_for ($type_constraints)
 
 Given some type constraints, use them to generate validation rules for an ref
@@ -103,33 +135,37 @@ of values (to be passed at check time)
 =cut
 
 sub generate_constraint_for {
-    my ($self, $dependent, $callback, $constraining) = @_;
-    return sub {
-        my (@args) = @_;
+    my ($self, $callback, $constraining) = @_;
+    return sub {   
+        my ($check_value, $constraining_value) = @_;
         my $constraint_generator = $self->constraint_generator;
-        return $constraint_generator->($dependent, $callback, $constraining, @args);
+        return $constraint_generator->(
+            $callback,
+            $check_value,
+            $constraining_value,
+        );
     };
 }
 
-=head2 parameterize (@type_constraints)
+=head2 parameterize ($dependent, $callback, $constraining)
 
 Given a ref of type constraints, create a structured type.
 
 =cut
 
 sub parameterize {
-    
     my ($self, $dependent, $callback, $constraining) = @_;
     my $class = ref $self;
-    my $name = $self->_generate_subtype_name($dependent, $constraining);
+    my $name = $self->_generate_subtype_name($dependent,  $callback, $constraining);
     my $constraint_generator = $self->__infer_constraint_generator;
 
     return $class->new(
         name => $name,
         parent => $self,
         dependent_type_constraint=>$dependent,
-        comparision_callback=>$callback,
+        comparison_callback=>$callback,
         constraint_generator => $constraint_generator,
+        constraining_type_constraint => $constraining,
     );
 }
 
@@ -140,10 +176,10 @@ Returns a name for the dependent type that should be unique
 =cut
 
 sub _generate_subtype_name {
-    my ($self, $dependent, $constraining) = @_;
+    my ($self, $dependent, $callback, $constraining) = @_;
     return sprintf(
-        "%s_depends_on_%s",
-        $dependent, $constraining
+        "%s_depends_on_%s_via_%s",
+        $dependent, $constraining, $callback
     );
 }
 
@@ -166,8 +202,7 @@ sub __infer_constraint_generator {
             my $tc = shift @_;
             my $merged_tc = [
                 @$tc,
-                $self->dependent_type_constraint,
-                $self->comparision_callback,
+                $self->comparison_callback,
                 $self->constraining_type_constraint,
             ];
             
@@ -183,23 +218,24 @@ hook into compile_type_constraint so we can set the correct validation rules.
 =cut
 
 around 'compile_type_constraint' => sub {
-    my ($compile_type_constraint, $self, @args) = @_;
+    my ($compile_type_constraint, $self) = @_;
     
-    if($self->has_type_constraints) {
-        my $type_constraints = $self->type_constraints;
-        my $constraint = $self->generate_constraint_for($type_constraints);
-        $self->_set_constraint($constraint);        
+    if($self->has_comparison_callback &&
+        $self->has_constraining_type_constraint) {
+        my $generated_constraint = $self->generate_constraint_for(
+            $self->comparison_callback,
+             $self->constraining_type_constraint,
+        );
+        $self->_set_constraint($generated_constraint);       
     }
 
-    return $self->$compile_type_constraint(@args);
+    return $self->$compile_type_constraint;
 };
 
 =head2 create_child_type
 
 modifier to make sure we get the constraint_generator
 
-=cut
-
 around 'create_child_type' => sub {
     my ($create_child_type, $self, %opts) = @_;
     return $self->$create_child_type(
@@ -293,4 +329,4 @@ it under the same terms as Perl itself.
 
 =cut
 
-__PACKAGE__->meta->make_immutable;
\ No newline at end of file
+__PACKAGE__->meta->make_immutable;

diff --git a/t/00-load.t b/t/00-load.t
index 062b92b..d685168 100644 (file)
--- a/t/00-load.t
+++ b/t/00-load.t
@@ -1,11 +1,11 @@
 
-use Test::More tests=>3; {
+use Test::More tests=>2; {
     
     use strict;
     use warnings;
     
     ## List all the modules we want to make sure can at least compile
-    use_ok 'MooseX::Types::Dependent';
+    ##use_ok 'MooseX::Types::Dependent';
     use_ok 'MooseX::Meta::TypeConstraint::Dependent';
     use_ok 'MooseX::Meta::TypeCoercion::Dependent';
 }

diff --git a/t/01-basic.t b/t/01-basic.t
index 136928b..611cb06 100644 (file)
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -1,5 +1,5 @@
 
-use Test::More tests=>8; {
+use Test::More tests=>9; {
        
        use strict;
        use warnings;
@@ -7,32 +7,33 @@ use Test::More tests=>8; {
        use_ok 'MooseX::Meta::TypeConstraint::Dependent';
        use_ok 'Moose::Util::TypeConstraints';
 
-       ## A sample dependent type constraint the requires two ints and see which
-       ## is the greater.
+       ## A sample dependent type constraint the requires two ints and sees if
+       ## the dependent value (the first) is greater than the constraining value
+       ## (the second).
        
        ok my $int = find_type_constraint('Int') => 'Got Int';
        
        my $dep_tc = MooseX::Meta::TypeConstraint::Dependent->new(
                name => "MooseX::Types::Dependent::Depending" ,
-               parent => find_type_constraint('ArrayRef'),
+               parent => find_type_constraint('Int'),
                dependent_type_constraint=>$int,
-               comparision_callback=>sub {
+               comparison_callback=>sub {
                        my ($constraining_value, $check_value) = @_;
-                       return $constraining_value > $check_value ? 0:1;
+                       return $check_value > $constraining_value ? 0:1;
                },
-               constraint_generator =>$int,
-               constraint_generator=> sub { 
+               constraining_type_constraint =>$int,
+               constraint_generator=> sub {
+                       ## Because "shift->(shift,shift)" is not very clear, is it :)
                        my ($callback, $constraining_value, $check_value) = @_;
-                       return $callback->($constraining_value, $check_value) ? 1:0;
+                       return $callback->($constraining_value, $check_value);
                },
        );
-       
-       ## Does this work at all?
 
        isa_ok $dep_tc, 'MooseX::Meta::TypeConstraint::Dependent';
-
-       ok !$dep_tc->check([5,10]), "Fails, 5 is less than 10";
-       ok !$dep_tc->check(['a',10]), "Fails, 'a' is not an Int.";
-       ok !$dep_tc->check([5,'b']), "Fails, 'b' is not an Int either.";
-       ok $dep_tc->check([10,5]), "Success, 10 is greater than 5.";
+       
+       ok !$dep_tc->check('a',10), "Fails, 'a' is not an Int.";
+       ok !$dep_tc->check(5,'b'), "Fails, 'b' is not an Int either.";
+       ok !$dep_tc->check([4,1]), "Fails, since this isn't an arrayref";
+       ok !$dep_tc->check(5,10), "Fails, 5 is less than 10";
+       ok $dep_tc->check(11,6), "Success, 11 is greater than 6.";
 }