package MooseX::Meta::TypeConstraint::Role::Structured;
use Moose::Role;
+use Moose::Util::TypeConstraints;
+requires qw(_normalize_args signature_equals);
=head1 NAME
STUB - TBD
+=head1 TYPES
+
+The following types are defined in this class.
+
+=head2 Moose::Meta::TypeConstraint
+
+Used to make sure we can properly validate incoming signatures.
+
+=cut
+
+class_type 'Moose::Meta::TypeConstraint';
+
=head1 ATTRIBUTES
This class defines the following attributes.
Get arguments into a known state or die trying. Ideally we try to make this
into a HashRef so we can match it up with the L</signature> HashRef.
-
-=cut
-
=head2 constraint
The constraint is basically validating the L</signature> against the incoming
-=cut
-
=head2 equals
modifier to make sure equals descends into the L</signature>
=cut
+around 'equals' => sub {
+ my ($equals, $self, $compared_type_constraint) = @_;
+
+ ## Make sure we are comparing typeconstraints of the same base class
+ return unless $compared_type_constraint->isa(__PACKAGE__);
+
+ ## Make sure the base equals is also good
+ return unless $self->$equals($compared_type_constraint);
+
+ ## Make sure the signatures match
+ return unless $self->signature_equals($compared_type_constraint);
+
+ ## If we get this far, the two are equal
+ return 1;
+};
+
=head2 signature_equals
Check that the signature equals another signature.
-=cut
-
=head1 AUTHOR
John James Napiorkowski <jjnapiork@cpan.org>
use Moose;
use Moose::Meta::TypeConstraint ();
-use Moose::Util::TypeConstraints;
extends 'Moose::Meta::TypeConstraint';
with 'MooseX::Meta::TypeConstraint::Role::Structured';
MooseX::Meta::TypeConstraint::Structured::Named - Structured Type Constraints
-=head1 VERSION
-
-0.01
-
-=cut
-
-our $VERSION = '0.01';
-
=head1 DESCRIPTION
Structured type constraints let you assign an internal pattern of type
Named structured Constraints expect the internal constraints to be in keys or
fields similar to what we expect in a HashRef.
-=head1 TYPES
-
-The following types are defined in this class.
-
-=head2 Moose::Meta::TypeConstraint
-
-Used to make sure we can properly validate incoming signatures.
-
-=cut
-
-class_type 'Moose::Meta::TypeConstraint';
-
=head1 ATTRIBUTES
This class defines the following attributes.
return 1;
}
-=head2 equals
-
-modifier to make sure equals descends into the L</signature>
-
-=cut
-around 'equals' => sub {
- my ($equals, $self, $compared_type_constraint) = @_;
-
- ## Make sure we are comparing typeconstraints of the same base class
- return unless $compared_type_constraint->isa(__PACKAGE__);
-
- ## Make sure the base equals is also good
- return unless $self->$equals($compared_type_constraint);
-
- ## Make sure the signatures match
- return unless $self->signature_equals($compared_type_constraint);
-
- ## If we get this far, the two are equal
- return 1;
-};
=head1 AUTHOR
use Moose;
use Moose::Meta::TypeConstraint ();
-use Moose::Util::TypeConstraints;
extends 'Moose::Meta::TypeConstraint';
with 'MooseX::Meta::TypeConstraint::Role::Structured';
MooseX::Meta::TypeConstraint::Structured::Positional - Structured Type Constraints
-=head1 VERSION
-
-0.01
-
-=cut
-
-our $VERSION = '0.01';
-
=head1 DESCRIPTION
Structured type constraints let you assign an internal pattern of type
Positionally structured Constraints expect the internal constraints to be in
'positioned' or ArrayRef style order.
-=head1 TYPES
-
-The following types are defined in this class.
-
-=head2 Moose::Meta::TypeConstraint
-
-Used to make sure we can properly validate incoming signatures.
-
-=cut
-
-class_type 'Moose::Meta::TypeConstraint';
-
=head1 ATTRIBUTES
This class defines the following attributes.
return 1;
}
-=head2 equals
-
-modifier to make sure equals descends into the L</signature>
-
-=cut
-
-around 'equals' => sub {
- my ($equals, $self, $compared_type_constraint) = @_;
-
- ## Make sure we are comparing typeconstraints of the same base class
- return unless $compared_type_constraint->isa(__PACKAGE__);
-
- ## Make sure the base equals is also good
- return unless $self->$equals($compared_type_constraint);
-
- ## Make sure the signatures match
- return unless $self->signature_equals($compared_type_constraint);
-
- ## If we get this far, the two are equal
- return 1;
-};
-
=head1 AUTHOR
John James Napiorkowski <jjnapiork@cpan.org>
BEGIN {
use strict;
use warnings;
- use Test::More tests=>25;
+ use Test::More tests=>30;
use Test::Exception;
}
signature => [map {
_normalize_type_constraint($_);
} @args],
+ optional_signature => [map {
+ _normalize_type_constraint($_);
+ } @optional],
);
}
signature => {map {
$_ => _normalize_type_constraint($args{$_});
} keys %args},
+ optional_signature => {map {
+ $_ => _normalize_type_constraint($optional{$_});
+ } keys %optional},
);
}
has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
+ has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
}
## Instantiate a new test object
isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
=> 'Created correct object type.';
-
+
## Test Tuple type constraint
lives_ok sub {
}, qr/Validation failed for 'Int'/
=> 'Threw error on bad constraint';
+## Test optional_tuple
+lives_ok sub {
+ $record->optional_tuple([1,2,3]);
+} => 'Set tuple attribute with optional bits';
+
+is_deeply $record->optional_tuple, [1,2,3]
+ => 'correct values set';
+
+lives_ok sub {
+ $record->optional_tuple([4,5]);
+} => 'Set tuple attribute withOUT optional bits';
+
+is_deeply $record->optional_tuple, [4,5]
+ => 'correct values set again';
+
+throws_ok sub {
+ $record->optional_tuple([1,2,'bad']);
+}, qr/Validation failed for 'Int'/
+ => 'Properly failed for bad value in optional bit';
projects / gitmo/MooseX-Types-Structured.git / commitdiff