[Moose-commits] r7867 - in MooseX-Types-Dependent/trunk: .
lib/MooseX/Meta/TypeConstraint lib/MooseX/Types t
jnapiorkowski at code2.0beta.co.uk
jnapiorkowski at code2.0beta.co.uk
Mon Mar 30 00:13:13 BST 2009
Author: jnapiorkowski
Date: 2009-03-29 16:13:13 -0700 (Sun, 29 Mar 2009)
New Revision: 7867
Added:
MooseX-Types-Dependent/trunk/t/02-depending.t
Modified:
MooseX-Types-Dependent/trunk/Makefile.PL
MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
MooseX-Types-Dependent/trunk/lib/MooseX/Types/Dependent.pm
MooseX-Types-Dependent/trunk/t/00-load.t
MooseX-Types-Dependent/trunk/t/01-basic.t
Log:
create a basic type, clarified and regularized some of the naming conventions for vars.
Modified: MooseX-Types-Dependent/trunk/Makefile.PL
===================================================================
--- MooseX-Types-Dependent/trunk/Makefile.PL 2009-03-29 19:57:33 UTC (rev 7866)
+++ MooseX-Types-Dependent/trunk/Makefile.PL 2009-03-29 23:13:13 UTC (rev 7867)
@@ -9,6 +9,7 @@
## Module dependencies
requires 'Moose' => '0.73';
+requires 'MooseX::Types' => '.10';
requires 'Scalar::Util' => '1.19';
## Testing dependencies
Modified: MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
===================================================================
--- MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm 2009-03-29 19:57:33 UTC (rev 7866)
+++ MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm 2009-03-29 23:13:13 UTC (rev 7867)
@@ -31,7 +31,6 @@
is=>'ro',
isa=>'Object',
predicate=>'has_dependent_type_constraint',
- required=>1,
handles=>{
check_dependent=>'check',
},
@@ -48,7 +47,6 @@
is=>'ro',
isa=>'Object',
predicate=>'has_constraining_type_constraint',
- required=>1,
handles=>{
check_constraining=>'check',
},
@@ -71,7 +69,6 @@
is=>'ro',
isa=>'CodeRef',
predicate=>'has_comparison_callback',
- required=>1,
);
=head2 constraint_generator
@@ -107,17 +104,6 @@
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, @args) = @_;
- return $self->$check(@args);
-};
-
=head2 generate_constraint_for ($type_constraints)
Given some type constraints, use them to generate validation rules for an ref
@@ -126,25 +112,25 @@
=cut
sub generate_constraint_for {
- my ($self, $callback, $constraining) = @_;
+ my ($self, $callback) = @_;
return sub {
my ($dependent_pair) = @_;
- my ($check_value, $constraining_value) = @$dependent_pair;
+ my ($dependent, $constraining) = @$dependent_pair;
## First need to test the bits
- unless($self->check_dependent($check_value)) {
+ unless($self->check_dependent($dependent)) {
return;
}
- unless($self->check_constraining($constraining_value)) {
+ unless($self->check_constraining($constraining)) {
return;
}
my $constraint_generator = $self->constraint_generator;
return $constraint_generator->(
+ $dependent,
$callback,
- $check_value,
- $constraining_value,
+ $constraining,
);
};
}
@@ -156,18 +142,18 @@
=cut
sub parameterize {
- my ($self, $dependent, $callback, $constraining) = @_;
+ my ($self, $dependent_tc, $callback, $constraining_tc) = @_;
my $class = ref $self;
- my $name = $self->_generate_subtype_name($dependent, $callback, $constraining);
+ my $name = $self->_generate_subtype_name($dependent_tc, $callback, $constraining_tc);
my $constraint_generator = $self->__infer_constraint_generator;
return $class->new(
name => $name,
parent => $self,
- dependent_type_constraint=>$dependent,
+ dependent_type_constraint=>$dependent_tc,
comparison_callback=>$callback,
constraint_generator => $constraint_generator,
- constraining_type_constraint => $constraining,
+ constraining_type_constraint => $constraining_tc,
);
}
@@ -178,10 +164,10 @@
=cut
sub _generate_subtype_name {
- my ($self, $dependent, $callback, $constraining) = @_;
+ my ($self, $dependent_tc, $callback, $constraining_tc) = @_;
return sprintf(
"%s_depends_on_%s_via_%s",
- $dependent, $constraining, $callback
+ $dependent_tc, $constraining_tc, $callback,
);
}
@@ -199,6 +185,7 @@
if($self->has_constraint_generator) {
return $self->constraint_generator;
} else {
+ warn "I'm doing the questioning infer generator thing";
return sub {
## I'm not sure about this stuff but everything seems to work
my $tc = shift @_;
@@ -226,7 +213,6 @@
$self->has_constraining_type_constraint) {
my $generated_constraint = $self->generate_constraint_for(
$self->comparison_callback,
- $self->constraining_type_constraint,
);
$self->_set_constraint($generated_constraint);
}
@@ -238,6 +224,8 @@
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(
Modified: MooseX-Types-Dependent/trunk/lib/MooseX/Types/Dependent.pm
===================================================================
--- MooseX-Types-Dependent/trunk/lib/MooseX/Types/Dependent.pm 2009-03-29 19:57:33 UTC (rev 7866)
+++ MooseX-Types-Dependent/trunk/lib/MooseX/Types/Dependent.pm 2009-03-29 23:13:13 UTC (rev 7867)
@@ -15,38 +15,20 @@
=head1 SYNOPSIS
- TDB: Syntax to be determined. Canonical is:
-
- subtype UniqueInt,
- as Depending[
- Int,
- sub {
- shift->exists(shift) ? 0:1;
- },
- Set,
- ];
-
- possible sugar options
-
- as Depending {
- shift->exists(shift) ? 0:1;
- } [Int, Set];
-
- May have some ready to go, such as
- as isGreaterThan[
- Int,
- Int,
- ];
-
- as isMemberOf[
- Int
- Set,
- ]
-
- ## using object for comparison
-
- as Dependent[Int, CompareCmd, Int];
+ subtype UniqueInt,
+ as Depending[
+ Int,
+ sub {
+ shift->exists(shift) ? 0:1;
+ },
+ Set,
+ ];
+ subtype UniqueInt,
+ as Depending {
+ shift->exists(shift) ? 0:1;
+ } [Int, Set];
+
Please see the test cases for more examples.
=head1 DEFINITIONS
@@ -72,12 +54,12 @@
=head2 Subtyping a Dependent type constraints
- TDB: Need discussion and examples.
+TDB: Need discussion and examples.
=head2 Coercions
- TBD: Need discussion and example of coercions working for both the
- constrainted and dependent type constraint.
+TBD: Need discussion and example of coercions working for both the
+constrainted and dependent type constraint.
=head2 Recursion
@@ -86,8 +68,6 @@
Recursion is support in both the dependent and constraining type constraint. For
example:
- TBD
-
=head1 TYPE CONSTRAINTS
This type library defines the following constraints.
@@ -95,7 +75,7 @@
=head2 Depending[$dependent_tc, $codref, $constraining_tc]
Create a subtype of $dependent_tc that is constrainted by a value that is a
-valid $constraining_tc using $coderef. For example;
+valid $constraining_tc using $coderef. For example:
subtype GreaterThanInt,
as Depending[
@@ -107,34 +87,37 @@
Int,
];
+Note that the coderef is passed the constraining value and the check value as an
+Array NOT an ArrayRef.
+
This would create a type constraint that takes an integer and checks it against
a second integer, requiring that the check value is greater. For example:
- GreaterThanInt->check(5,10); ## Fails, 5 is less than 10
- GreaterThanInt->check('a',10); ## Fails, 'a' is not an Int.
- GreaterThanInt->check(5,'b'); ## Fails, 'b' is not an Int either.
- GreaterThanInt->check(10,5); ## Success, 10 is greater than 5.
+ GreaterThanInt->check([5,10]); ## Fails, 5 is less than 10
+ GreaterThanInt->check(['a',10]); ## Fails, 'a' is not an Int.
+ GreaterThanInt->check([5,'b']); ## Fails, 'b' is not an Int either.
+ GreaterThanInt->check([10,5]); ## Success, 10 is greater than 5.
=head1 EXAMPLES
Here are some additional example usage for structured types. All examples can
be found also in the 't/examples.t' test. Your contributions are also welcomed.
- TBD
+TBD
=cut
Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
- MooseX::Meta::TypeConstraint::Dependent->new(
- name => "MooseX::Types::Dependent::Depending" ,
- parent => find_type_constraint('ArrayRef'),
- constraint_generator=> sub {
- my ($callback, $constraining_value, $check_value) = @_;
- return $callback->($constraining_value, $check_value) ? 1:0;
- },
- )
+ MooseX::Meta::TypeConstraint::Dependent->new(
+ name => "MooseX::Types::Dependent::Depending" ,
+ parent => find_type_constraint('ArrayRef'),
+ constraint_generator=> sub {
+ my ($dependent_val, $callback, $constraining_val) = @_;
+ return $callback->($dependent_val, $constraining_val);
+ },
+ )
);
-
+
=head1 SEE ALSO
The following modules or resources may be of interest.
@@ -165,5 +148,5 @@
it under the same terms as Perl itself.
=cut
-
+
1;
Modified: MooseX-Types-Dependent/trunk/t/00-load.t
===================================================================
--- MooseX-Types-Dependent/trunk/t/00-load.t 2009-03-29 19:57:33 UTC (rev 7866)
+++ MooseX-Types-Dependent/trunk/t/00-load.t 2009-03-29 23:13:13 UTC (rev 7867)
@@ -1,11 +1,11 @@
-use Test::More tests=>2; {
+use Test::More tests=>3; {
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';
}
Modified: MooseX-Types-Dependent/trunk/t/01-basic.t
===================================================================
--- MooseX-Types-Dependent/trunk/t/01-basic.t 2009-03-29 19:57:33 UTC (rev 7866)
+++ MooseX-Types-Dependent/trunk/t/01-basic.t 2009-03-29 23:13:13 UTC (rev 7867)
@@ -18,14 +18,13 @@
parent => find_type_constraint('ArrayRef'),
dependent_type_constraint=>$int,
comparison_callback=>sub {
- my ($constraining_value, $check_value) = @_;
- return $check_value > $constraining_value ? 0:1;
+ my ($dependent_val, $constraining_val) = @_;
+ return ($dependent_val > $constraining_val) ? 1:undef;
},
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);
+ my ($dependent_val, $callback, $constraining_val) = @_;
+ return $callback->($dependent_val, $constraining_val);
},
);
Added: MooseX-Types-Dependent/trunk/t/02-depending.t
===================================================================
--- MooseX-Types-Dependent/trunk/t/02-depending.t (rev 0)
+++ MooseX-Types-Dependent/trunk/t/02-depending.t 2009-03-29 23:13:13 UTC (rev 7867)
@@ -0,0 +1,32 @@
+use Test::More tests=>8; {
+
+ use strict;
+ use warnings;
+
+ use Test::Exception;
+ use MooseX::Types::Dependent qw(Depending);
+ use MooseX::Types::Moose qw(Int Str Object ArrayRef HashRef Maybe);
+ use MooseX::Types -declare => [qw(
+ IntGreaterThanInt
+ )];
+
+ subtype IntGreaterThanInt,
+ as Depending[
+ Int,
+ sub {
+ my ($dependent_val, $constraining_val) = @_;
+ return ($dependent_val > $constraining_val) ? 1:undef;
+ },
+ Int,
+ ];
+
+ isa_ok IntGreaterThanInt, 'MooseX::Meta::TypeConstraint::Dependent';
+
+ ok !IntGreaterThanInt->check(['a',10]), "Fails, 'a' is not an Int.";
+ ok !IntGreaterThanInt->check([5,'b']), "Fails, 'b' is not an Int either.";
+ ok !IntGreaterThanInt->check({4,1}), "Fails, since this isn't an arrayref";
+ ok !IntGreaterThanInt->check([5,10]), "Fails, 5 is less than 10";
+ ok IntGreaterThanInt->check([11,6]), "Success, 11 is greater than 6.";
+ ok IntGreaterThanInt->check([12,1]), "Success, 12 is greater than1.";
+ ok IntGreaterThanInt->check([0,-10]), "Success, 0 is greater than -10.";
+}
More information about the Moose-commits
mailing list