From: John Napiorkowski Date: Sun, 29 Mar 2009 23:13:13 +0000 (+0000) Subject: create a basic type, clarified and regularized some of the naming conventions for... X-Git-Tag: 0.01~46 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b6d2e22998448b8c5a0817fb0d6a945ca0a9ea4;p=gitmo%2FMooseX-Dependent.git create a basic type, clarified and regularized some of the naming conventions for vars. --- diff --git a/Makefile.PL b/Makefile.PL index c891688..adcf2ae 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -9,6 +9,7 @@ license 'perl'; ## Module dependencies requires 'Moose' => '0.73'; +requires 'MooseX::Types' => '.10'; requires 'Scalar::Util' => '1.19'; ## Testing dependencies diff --git a/lib/MooseX/Meta/TypeConstraint/Dependent.pm b/lib/MooseX/Meta/TypeConstraint/Dependent.pm index 9e02be5..4080494 100644 --- a/lib/MooseX/Meta/TypeConstraint/Dependent.pm +++ b/lib/MooseX/Meta/TypeConstraint/Dependent.pm @@ -31,7 +31,6 @@ has 'dependent_type_constraint' => ( is=>'ro', isa=>'Object', predicate=>'has_dependent_type_constraint', - required=>1, handles=>{ check_dependent=>'check', }, @@ -48,7 +47,6 @@ has 'constraining_type_constraint' => ( is=>'ro', isa=>'Object', predicate=>'has_constraining_type_constraint', - required=>1, handles=>{ check_constraining=>'check', }, @@ -71,7 +69,6 @@ has 'comparison_callback' => ( is=>'ro', isa=>'CodeRef', predicate=>'has_comparison_callback', - required=>1, ); =head2 constraint_generator @@ -107,17 +104,6 @@ around 'new' => sub { 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 @@ of values (to be passed at check time) =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 @@ Given a ref of type constraints, create a structured type. =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 @@ Returns a name for the dependent type that should be unique =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 @@ sub __infer_constraint_generator { 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 @@ around 'compile_type_constraint' => sub { $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 @@ around 'compile_type_constraint' => sub { 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( diff --git a/lib/MooseX/Types/Dependent.pm b/lib/MooseX/Types/Dependent.pm index 3f45cf1..5b3f273 100644 --- a/lib/MooseX/Types/Dependent.pm +++ b/lib/MooseX/Types/Dependent.pm @@ -15,37 +15,19 @@ MooseX::Types::Dependent - L constraints that depend on values. =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. @@ -72,12 +54,12 @@ comparision operator between the check value and the constraining value =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 @@ you can include a type constraint as a contained type constraint of itself. 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 @@ This type library defines the following constraints. =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 @@ valid $constraining_tc using $coderef. For example; 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 @@ This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut - + 1; diff --git a/t/00-load.t b/t/00-load.t index d685168..062b92b 100644 --- a/t/00-load.t +++ b/t/00-load.t @@ -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'; } diff --git a/t/01-basic.t b/t/01-basic.t index 97dfdd9..86b12e0 100644 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -18,14 +18,13 @@ use Test::More tests=>9; { 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); }, ); diff --git a/t/02-depending.t b/t/02-depending.t new file mode 100644 index 0000000..1b31366 --- /dev/null +++ b/t/02-depending.t @@ -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."; +}