use 5.008;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
$VERSION = eval $VERSION;
use Moose::Util::TypeConstraints;
## Create a type constraint that is a string but parameterizes an integer
## that is used as a maximum length constraint on that string, similar to
- ## an SQL Varchar type.
+ ## a SQL Varchar database type.
subtype Varchar,
as Parameterizable[Str,Int],
## Dies with an invalid constraint for 'varchar_five'
my $object2 = __PACKAGE__->new(
- varchar_five => '12345678',
+ varchar_five => '12345678', ## too long!
varchar_ten => '123456789',
);
## varchar_five coerces as expected
my $object3 = __PACKAGE__->new(
- varchar_five => [qw/aa bb/],
+ varchar_five => [qw/aa bb/], ## coerces to "aabb"
varchar_ten => '123456789',
);
=head1 DESCRIPTION
-A L<MooseX::Types> library for creating parameterizable types. A parameterizable type
-constraint for all intents and uses is a subclass of a parent type, but adds a
-secondary type parameter which is available to constraint callbacks (such as
-inside the 'where' clause) or in the coercions.
+A L<MooseX::Types> library for creating parameterizable types. A parameterizable
+type constraint for all intents and uses is a subclass of a parent type, but
+adds additional type parameters which are available to constraint callbacks
+(such as inside the 'where' clause of a type constraint definition) or in the
+coercions.
-This allows you to create a type that has additional runtime advice, such as a
-set of numbers within which another number must be unique, or allowable ranges
-for a integer, such as in:
+If you have L<Moose> experience, you probably are familiar with the builtin
+parameterizable type constraints 'ArrayRef' and 'HashRef'. This type constraint
+lets you generate your own versions of parameterized constraints that work
+similarly. See L<Moose::Util::TypeConstraints> for more.
+
+Using this type constraint, you can generate new type constraints that have
+additional runtime advice, such as being able to specify maximum and minimum
+values for an Int (integer) type constraint:
subtype Range,
as Dict[max=>Int, min=>Int],
RangedInt([{min=>10,max=>100}])->check(50); ## OK
RangedInt([{min=>50, max=>75}])->check(99); ## Not OK, 99 exceeds max
-
-This throws a hard Moose exception. You'll need to capture it in an eval or
-related exception catching system (see L<TryCatch> or <Try::Tiny>.)
+
+The type parameter must be valid against the type constraint given. If you pass
+an invalid value this throws a hard Moose exception. You'll need to capture it
+in an eval or related exception catching system (see L<TryCatch> or <Try::Tiny>.)
+For example the following would throw a hard error (and not just return false)
RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range!
=head2 Recursion
- TBD
+ TBD - Need more tests.
=head1 TYPE CONSTRAINTS
-
-use Test::More; {
-
+BEGIN {
use strict;
use warnings;
-
- eval "use MooseX::Types::Structured"; if($@) {
+
+ use Test::More;
+ eval "use MooseX::Types::Structured qw(Tuple Dict slurpy)"; if($@) {
plan skip_all => "MooseX::Types:Structured Required for advanced Tests";
} else {
eval "use Set::Scalar"; if($@) {
plan tests => 37;
}
}
+}
- use MooseX::Types::Structured qw(Tuple Dict slurpy);
- use MooseX::Types::Parameterizable qw(Parameterizable);
- use MooseX::Types::Moose qw(Int Str);
- use Moose::Util::TypeConstraints;
-
- use MooseX::Types -declare=>[qw(
- Set UniqueInt UniqueInSet Range RangedInt PositiveRangedInt1
- PositiveRangedInt2 PositiveInt PositiveRange NameAge NameBetween18and35Age
- )];
-
- ok class_type("Set::Scalar"), 'Created Set::Scalar class_type';
- ok subtype( Set, as "Set::Scalar"), 'Created Set subtype';
-
- ok subtype( UniqueInt,
- as Parameterizable[Int, Set],
- where {
- my ($int, $set) = @_;
- return !$set->has($int);
- }), 'Created UniqueInt Parameterizable Type';
-
- ok( (my $set_obj = Set::Scalar->new(1,2,3,4,5)), 'Create Set Object');
-
- ok !UniqueInt([$set_obj])->check(1), "Not OK, since one isn't unique in $set_obj";
- ok !UniqueInt([$set_obj])->check('AAA'), "Not OK, since AAA is not an Int";
- ok UniqueInt([$set_obj])->check(100), "OK, since 100 isn't in the set";
+use MooseX::Types::Parameterizable qw(Parameterizable);
+use MooseX::Types::Moose qw(Int Str);
+use Moose::Util::TypeConstraints;
+
+use MooseX::Types -declare=>[qw(
+ Set UniqueInt UniqueInSet Range RangedInt PositiveRangedInt1
+ PositiveRangedInt2 PositiveInt PositiveRange NameAge NameBetween18and35Age
+)];
+
+ok class_type("Set::Scalar"), 'Created Set::Scalar class_type';
+ok subtype( Set, as "Set::Scalar"), 'Created Set subtype';
+
+ok subtype( UniqueInt,
+ as Parameterizable[Int, Set],
+ where {
+ my ($int, $set) = @_;
+ return !$set->has($int);
+ }), 'Created UniqueInt Parameterizable Type';
+
+ok( (my $set_obj = Set::Scalar->new(1,2,3,4,5)), 'Create Set Object');
+
+ok !UniqueInt([$set_obj])->check(1), "Not OK, since one isn't unique in $set_obj";
+ok !UniqueInt([$set_obj])->check('AAA'), "Not OK, since AAA is not an Int";
+ok UniqueInt([$set_obj])->check(100), "OK, since 100 isn't in the set";
+
+ok( (my $unique = UniqueInt[$set_obj]), 'Created Anonymous typeconstraint');
+ok $unique->check(10), "OK, 10 is unique";
+ok !$unique->check(2), "Not OK, '2' is already in the set";
+
+ok( subtype(UniqueInSet, as UniqueInt[$set_obj]), 'Created Subtype');
+ok UniqueInSet->check(99), '99 is unique';
+ok !UniqueInSet->check(3), 'Not OK, 3 is already in the set';
+
+CHECKHARDEXCEPTION: {
+ eval { UniqueInt->check(1000) };
+ like $@,
+ qr/Validation failed for 'main::Set' with value undef/,
+ 'Got Expected Error';
+
+ eval { UniqueInt->validate(1000) };
+ like $@,
+ qr/Validation failed for 'main::Set' with value undef/,
+ 'Got Expected Error';
+}
+
+subtype Range,
+ as Dict[max=>Int, min=>Int],
+ where {
+ my ($range) = @_;
+ return $range->{max} > $range->{min};
+ };
+
+subtype RangedInt,
+ as Parameterizable[Int, Range],
+ where {
+ my ($value, $range) = @_;
+ return ($value >= $range->{min} &&
+ $value <= $range->{max});
+ };
- ok( (my $unique = UniqueInt[$set_obj]), 'Created Anonymous typeconstraint');
- ok $unique->check(10), "OK, 10 is unique";
- ok !$unique->check(2), "Not OK, '2' is already in the set";
+ok RangedInt([{min=>10,max=>100}])->check(50), '50 in the range';
+ok !RangedInt([{min=>50, max=>75}])->check(99),'99 exceeds max';
+ok !RangedInt([{min=>50, max=>75}])->check('aa'), '"aa" not even an Int';
+
+CHECKRANGEDINT: {
+ eval {
+ RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range!
+ };
- ok( subtype(UniqueInSet, as UniqueInt[$set_obj]), 'Created Subtype');
- ok UniqueInSet->check(99), '99 is unique';
- ok !UniqueInSet->check(3), 'Not OK, 3 is already in the set';
+ like $@,
+ qr/Validation failed for 'main::Range'/,
+ 'Got Expected Error';
+}
+
+ok RangedInt([min=>10,max=>100])->check(50), '50 in the range';
+ok !RangedInt([min=>50, max=>75])->check(99),'99 exceeds max';
+ok !RangedInt([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
+
+CHECKRANGEDINT2: {
+ eval {
+ RangedInt([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
+ };
- CHECKHARDEXCEPTION: {
- eval { UniqueInt->check(1000) };
- like $@,
- qr/Validation failed for 'main::Set' with value undef/,
- 'Got Expected Error';
-
- eval { UniqueInt->validate(1000) };
- like $@,
- qr/Validation failed for 'main::Set' with value undef/,
- 'Got Expected Error';
- }
+ like $@,
+ qr/Validation failed for 'main::Range'/,
+ 'Got Expected Error';
+}
+
+subtype PositiveRangedInt1,
+ as RangedInt,
+ where {
+ shift >= 0;
+ };
+
+ok PositiveRangedInt1([min=>10,max=>100])->check(50), '50 in the range';
+ok !PositiveRangedInt1([min=>50, max=>75])->check(99),'99 exceeds max';
+ok !PositiveRangedInt1([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
+
+CHECKRANGEDINT2: {
+ eval {
+ PositiveRangedInt1([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
+ };
- subtype Range,
- as Dict[max=>Int, min=>Int],
- where {
- my ($range) = @_;
- return $range->{max} > $range->{min};
- };
-
- subtype RangedInt,
- as Parameterizable[Int, Range],
- where {
- my ($value, $range) = @_;
- return ($value >= $range->{min} &&
- $value <= $range->{max});
- };
-
- ok RangedInt([{min=>10,max=>100}])->check(50), '50 in the range';
- ok !RangedInt([{min=>50, max=>75}])->check(99),'99 exceeds max';
- ok !RangedInt([{min=>50, max=>75}])->check('aa'), '"aa" not even an Int';
-
- CHECKRANGEDINT: {
- eval {
- RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::Range'/,
- 'Got Expected Error';
- }
+ like $@,
+ qr/Validation failed for 'main::Range'/,
+ 'Got Expected Error';
+}
- ok RangedInt([min=>10,max=>100])->check(50), '50 in the range';
- ok !RangedInt([min=>50, max=>75])->check(99),'99 exceeds max';
- ok !RangedInt([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
-
- CHECKRANGEDINT2: {
- eval {
- RangedInt([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::Range'/,
- 'Got Expected Error';
- }
+ok !PositiveRangedInt1([min=>-100,max=>100])->check(-10), '-10 is not positive';
- subtype PositiveRangedInt1,
- as RangedInt,
- where {
- shift >= 0;
- };
-
- ok PositiveRangedInt1([min=>10,max=>100])->check(50), '50 in the range';
- ok !PositiveRangedInt1([min=>50, max=>75])->check(99),'99 exceeds max';
- ok !PositiveRangedInt1([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
-
- CHECKRANGEDINT2: {
- eval {
- PositiveRangedInt1([min=>99, max=>10])->check(10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::Range'/,
- 'Got Expected Error';
- }
+subtype PositiveInt,
+ as Int,
+ where {
+ my ($value, $range) = @_;
+ return $value >= 0;
+ };
- ok !PositiveRangedInt1([min=>-100,max=>100])->check(-10), '-10 is not positive';
+## subtype Range to re-parameterize Range with subtypes
+subtype PositiveRange,
+ as Range[max=>PositiveInt, min=>PositiveInt];
- subtype PositiveInt,
- as Int,
- where {
- my ($value, $range) = @_;
- return $value >= 0;
- };
+## create subtype via reparameterizing
+subtype PositiveRangedInt2,
+ as RangedInt[PositiveRange];
- ## subtype Range to re-parameterize Range with subtypes
- subtype PositiveRange,
- as Range[max=>PositiveInt, min=>PositiveInt];
-
- ## create subtype via reparameterizing
- subtype PositiveRangedInt2,
- as RangedInt[PositiveRange];
-
- ok PositiveRangedInt2([min=>10,max=>100])->check(50), '50 in the range';
- ok !PositiveRangedInt2([min=>50, max=>75])->check(99),'99 exceeds max';
- ok !PositiveRangedInt2([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
-
- CHECKRANGEDINT2: {
- eval {
- PositiveRangedInt2([min=>-100,max=>100])->check(-10); ## Not OK, not a valid Range!
- };
-
- like $@,
- qr/Validation failed for 'main::PositiveRange'/,
- 'Got Expected Error';
- }
+ok PositiveRangedInt2([min=>10,max=>100])->check(50), '50 in the range';
+ok !PositiveRangedInt2([min=>50, max=>75])->check(99),'99 exceeds max';
+ok !PositiveRangedInt2([min=>50, max=>75])->check('aa'), '"aa" not even an Int';
- subtype NameAge,
- as Tuple[Str, Int];
-
- ok NameAge->check(['John',28]), 'Good NameAge';
- ok !NameAge->check(['John','Napiorkowski']), 'Bad NameAge';
+CHECKRANGEDINT2: {
+ eval {
+ PositiveRangedInt2([min=>-100,max=>100])->check(-10); ## Not OK, not a valid Range!
+ };
- subtype NameBetween18and35Age,
- as NameAge[
- Str,
- PositiveRangedInt2[min=>18,max=>35],
- ];
-
- ok NameBetween18and35Age->check(['John',28]), 'Good NameBetween18and35Age';
- ok !NameBetween18and35Age->check(['John','Napiorkowski']), 'Bad NameBetween18and35Age';
- ok !NameBetween18and35Age->check(['John',99]), 'Bad NameBetween18and35Age';
+ like $@,
+ qr/Validation failed for 'main::PositiveRange'/,
+ 'Got Expected Error';
}
+
+subtype NameAge,
+ as Tuple[Str, Int];
+
+ok NameAge->check(['John',28]), 'Good NameAge';
+ok !NameAge->check(['John','Napiorkowski']), 'Bad NameAge';
+
+subtype NameBetween18and35Age,
+ as NameAge[
+ Str,
+ PositiveRangedInt2[min=>18,max=>35],
+ ];
+
+ok NameBetween18and35Age->check(['John',28]), 'Good NameBetween18and35Age';
+ok !NameBetween18and35Age->check(['John','Napiorkowski']), 'Bad NameBetween18and35Age';
+ok !NameBetween18and35Age->check(['John',99]), 'Bad NameBetween18and35Age';
+
projects / gitmo/MooseX-Dependent.git / commitdiff