more refactoring and first go at getting the tests to work again
john napiorkowski [Mon, 18 May 2009 21:40:06 +0000 (17:40 -0400)]
MANIFEST.SKIP
Makefile.PL
lib/MooseX/Dependent/Meta/TypeConstraint/Dependent.pm
lib/MooseX/Dependent/Types.pm
t/01-basic.t [deleted file]
t/01-dependent.t [new file with mode: 0644]

index b055a14..f4c504e 100644 (file)
@@ -4,6 +4,7 @@
 \bCVS\b
 ,v$
 \B\.svn\b
+\B\.git\b
 
 # Avoid Makemaker generated and utility files.
 \bMakefile$
index de65056..c25ab1b 100644 (file)
@@ -15,6 +15,7 @@ requires 'Scalar::Util' => '1.19';
 requires 'Devel::PartialDump' => '0.07';
 
 build_requires 'Test::More' => '0.86';
+build_requires 'Test::Exception' => '0.27';
 
 auto_install;
 tests_recursive;
index be3c2b8..ab439b6 100644 (file)
@@ -1,19 +1,17 @@
 package ## Hide from PAUSE
- MooseX::Meta::TypeConstraint::Dependent;
+ MooseX::Dependent::Meta::TypeConstraint::Dependent;
 
 use Moose;
 use Moose::Util::TypeConstraints ();
-use MooseX::Meta::TypeCoercion::Dependent;
-use Devel::PartialDump;
 extends 'Moose::Meta::TypeConstraint';
 
 =head1 NAME
 
-MooseX::Meta::TypeConstraint::Dependent - Metaclass for Dependent type constraints.
+MooseX::Dependent::Meta::TypeConstraint::Dependent - Metaclass for Dependent type constraints.
 
 =head1 DESCRIPTION
 
-see L<MooseX::Types::Dependent> for examples and details of how to use dependent
+see L<MooseX::Dependent> for examples and details of how to use dependent
 types.  This class is a subclass of L<Moose::Meta::TypeConstraint> which
 provides the gut functionality to enable dependent type constraints.
 
@@ -21,60 +19,49 @@ provides the gut functionality to enable dependent type constraints.
 
 This class defines the following attributes.
 
-=head2 dependent_type_constraint
+=head2 parent_type_constraint
 
-The type constraint whose validity is being made dependent on a value that is a
-L</constraining_type_constraint>
+The type constraint whose validity is being made dependent.
 
 =cut
 
-has 'dependent_type_constraint' => (
+has 'parent_type_constraint' => (
     is=>'ro',
     isa=>'Object',
-    predicate=>'has_dependent_type_constraint',
-    handles=>{
-        check_dependent=>'check',
-        get_message_dependent=>'get_message',
+    predicate=>'has_parent_type_constraint',
+    default=> sub {
+        Moose::Util::TypeConstraints::find_type_constraint("Any");
     },
+    required=>1,
 );
 
-=head2 constraining_type_constraint
+=head2 constraining_value_type_constraint
 
 This is a type constraint which defines what kind of value is allowed to be the
-constraining value of the depending type.
+constraining value of the dependent type.
 
 =cut
 
-has 'constraining_type_constraint' => (
+has 'constraining_value_type_constraint' => (
     is=>'ro',
     isa=>'Object',
-    predicate=>'has_constraining_type_constraint',
-    handles=>{
-        check_constraining=>'check',
-        get_message_constraining=>'get_message',
+    predicate=>'has_constraining_value_type_constraint',
+    default=> sub {
+        Moose::Util::TypeConstraints::find_type_constraint("Any");
     },
+    required=>1,
 );
 
-=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.
-
-This callback is executed in addition to anything you put into a 'where' clause.
-However, the 'where' clause only get's the check value.
+=head2 constrainting_value
 
-Exercise some sanity, this should be limited to actual comparision operations,
-not as a sneaky way to mess with the constraining value.
-
-This should return a Bool, suitable for ->check (That is true for valid, false
-for fail).
+This is the actual value that constraints the L</parent_type_constraint>
 
 =cut
 
-has 'comparison_callback' => (
-    is=>'ro',
-    isa=>'CodeRef',
-    predicate=>'has_comparison_callback',
+has 'constraining_value' => (
+    reader=>'constraining_value',
+    writer=>'_set_constraining_value',
+    predicate=>'has_constraining_value',
 );
 
 =head2 constraint_generator
@@ -82,7 +69,6 @@ has 'comparison_callback' => (
 A subref or closure that contains the way we validate incoming values against
 a set of type constraints.
 
-=cut
 
 has 'constraint_generator' => (
     is=>'ro',
@@ -95,27 +81,10 @@ has 'constraint_generator' => (
 
 This class defines the following methods.
 
-=head2 new
-
-Initialization stuff.
-
-=cut
-
-around 'new' => sub {
-    my ($new, $class, @args)  = @_;
-    my $self = $class->$new(@args);
-    $self->coercion(MooseX::Meta::TypeCoercion::Dependent->new(
-        type_constraint => $self,
-    ));
-    return $self;
-};
-
 =head2 validate
 
 We intercept validate in order to custom process the message.
 
-=cut
-
 override 'validate' => sub {
     my ($self, @args) = @_;
     my $compiled_type_constraint = $self->_compiled_type_constraint;
@@ -139,7 +108,6 @@ override 'validate' => sub {
 Given some type constraints, use them to generate validation rules for an ref
 of values (to be passed at check time)
 
-=cut
 
 sub generate_constraint_for {
     my ($self, $callback) = @_;
@@ -177,6 +145,9 @@ Given a ref of type constraints, create a structured type.
 
 sub parameterize {
     my ($self, $dependent_tc, $callback, $constraining_tc) = @_;
+    
+    die 'something';
+    
     my $class = ref $self;
     my $name = $self->_generate_subtype_name($dependent_tc,  $callback, $constraining_tc);
     my $constraint_generator = $self->__infer_constraint_generator;
@@ -198,10 +169,10 @@ Returns a name for the dependent type that should be unique
 =cut
 
 sub _generate_subtype_name {
-    my ($self, $dependent_tc, $callback, $constraining_tc) = @_;
+    my ($self, $parent_tc, $constraining_tc) = @_;
     return sprintf(
-        "%s_depends_on_%s_via_%s",
-        $dependent_tc, $constraining_tc, $callback,
+        "%s_depends_on_%s",
+        $parent_tc, $constraining_tc,
     );
 }
 
@@ -228,8 +199,6 @@ sub __infer_constraint_generator {
             my $tc = shift @_;
             my $merged_tc = [
                 @$tc,
-                $self->comparison_callback,
-                $self->constraining_type_constraint,
             ];
             
             $self->constraint->($merged_tc, @_);            
@@ -267,7 +236,7 @@ around 'create_child_type' => sub {
     my ($create_child_type, $self, %opts) = @_;
     return $self->$create_child_type(
         %opts,
-        constraint_generator => $self->__infer_constraint_generator,
+        #constraint_generator => $self->__infer_constraint_generator,
     );
 };
 
@@ -275,8 +244,6 @@ around 'create_child_type' => sub {
 
 Override the base class behavior.
 
-=cut
-
 sub equals {
     my ( $self, $type_or_name ) = @_;
     my $other = Moose::Util::TypeConstraints::find_type_constraint("$type_or_name");
@@ -296,13 +263,23 @@ sub equals {
 
 Give you a better peek into what's causing the error.
 
-=cut
-
 around 'get_message' => sub {
     my ($get_message, $self, $value) = @_;
     return $self->$get_message($value);
 };
 
+=head2 _throw_error ($error)
+
+Given a string, delegate to the Moose exception object
+
+=cut
+
+sub _throw_error {
+    my $self = shift @_;
+    my $err = defined $_[0] ? $_[0] : 'Exception Thrown without Message';
+    require Moose; Moose->throw_error($err);
+}
+
 =head1 SEE ALSO
 
 The following modules or resources may be of interest.
index 8ad9ad4..a3dd92f 100644 (file)
@@ -1,14 +1,9 @@
 package MooseX::Dependent::Types;
 
-use 5.008;
-
 use Moose::Util::TypeConstraints;
-use MooseX::Dependent::Meta::TypeConstraint::Parameterizable;
+use MooseX::Dependent::Meta::TypeConstraint::Dependent;
 use MooseX::Types -declare => [qw(Dependent)];
 
-our $VERSION = '0.01';
-our $AUTHORITY = 'cpan:JJNAPIORK';
-
 =head1 NAME
 
 MooseX::Dependent::Types - L<MooseX::Types> constraints that depend on values.
@@ -200,13 +195,9 @@ will cause an exception.
 =cut
 
 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
-    MooseX::Dependent::Meta::TypeConstraint::Parameterizable->new(
+    MooseX::Dependent::Meta::TypeConstraint::Dependent->new(
         name => 'MooseX::Dependent::Types::Dependent',
-        parent => find_type_constraint('ArrayRef'),
-        constraint_generator=> sub { 
-                       my ($dependent_val, $callback, $constraining_val) = @_;
-                       return $callback->($dependent_val, $constraining_val);
-        },
+        parent => find_type_constraint('Any'),
     )
 );
 
@@ -222,3 +213,40 @@ it under the same terms as Perl itself.
 =cut
 
 1;
+
+__END__
+
+oose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
+    Moose::Meta::TypeConstraint::Parameterizable->new(
+        name => 'MooseX::Dependent::Types::Dependent',
+        parent => find_type_constraint('Any'),
+               constraint => sub { 0 },
+        constraint_generator=> sub { 
+                       my ($dependent_val, $callback, $constraining_val) = @_;
+                       return $callback->($dependent_val, $constraining_val);
+        },
+    )
+);
+
+
+
+$REGISTRY->add_type_constraint(
+    Moose::Meta::TypeConstraint::Parameterizable->new(
+        name               => 'HashRef',
+        package_defined_in => __PACKAGE__,
+        parent             => find_type_constraint('Ref'),
+        constraint         => sub { ref($_) eq 'HASH' },
+        optimized =>
+            \&Moose::Util::TypeConstraints::OptimizedConstraints::HashRef,
+        constraint_generator => sub {
+            my $type_parameter = shift;
+            my $check          = $type_parameter->_compiled_type_constraint;
+            return sub {
+                foreach my $x ( values %$_ ) {
+                    ( $check->($x) ) || return;
+                }
+                1;
+                }
+        }
+    )
+);
\ No newline at end of file
diff --git a/t/01-basic.t b/t/01-basic.t
deleted file mode 100644 (file)
index 86b12e0..0000000
+++ /dev/null
@@ -1,38 +0,0 @@
-
-use Test::More tests=>9; {
-       
-       use strict;
-       use warnings;
-       
-       use_ok 'MooseX::Meta::TypeConstraint::Dependent';
-       use_ok 'Moose::Util::TypeConstraints';
-
-       ## 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'),
-               dependent_type_constraint=>$int,
-               comparison_callback=>sub {
-                       my ($dependent_val, $constraining_val) = @_;
-                       return ($dependent_val > $constraining_val) ? 1:undef;
-               },
-               constraining_type_constraint =>$int,
-               constraint_generator=> sub {
-                       my ($dependent_val, $callback, $constraining_val) = @_;
-                       return $callback->($dependent_val, $constraining_val);
-               },
-       );
-
-       isa_ok $dep_tc, 'MooseX::Meta::TypeConstraint::Dependent';
-       
-       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.";
-}
diff --git a/t/01-dependent.t b/t/01-dependent.t
new file mode 100644 (file)
index 0000000..78fbb38
--- /dev/null
@@ -0,0 +1,15 @@
+
+use Test::More tests=>2; {
+       
+       use strict;
+       use warnings;
+       
+       use MooseX::Dependent::Types qw(Dependent);
+       use MooseX::Types -declare=>[qw(SubDependent)];
+       use Moose::Util::TypeConstraints;
+
+       ## Raw tests on dependent.
+       ok subtype( SubDependent, as Dependent ), 'Create a useless subtype';
+       ok ((Dependent->check(1)), 'Dependent is basically an Any');
+
+}