use Moose;
use Moose::Util::TypeConstraints;
-use MooseX::Meta::TypeConstraint::Structured::Positional;
-use MooseX::Meta::TypeConstraint::Structured::Named;
-#use MooseX::Types::Moose qw();
-#use MooseX::Types -declare => [qw( Dict Tuple Optional )];
- use Sub::Exporter
- -setup => { exports => [ qw(Dict Tuple) ] };
+use MooseX::Meta::TypeConstraint::Structured;
+use MooseX::Types -declare => [qw(Dict Tuple)];
+
our $VERSION = '0.01';
our $AUTHORITY = 'cpan:JJNAPIORK';
};
-=head1 TYPES
+=head1 METHODS
-This class defines the following types and subtypes.
+This class defines the following methods
-=cut
+=head2 type_storage
-sub Tuple {
- my ($args, $optional) = @_;
- my @args = @$args;
- my @optional = ref $optional eq 'ARRAY' ? @$optional : ();
-
- return MooseX::Meta::TypeConstraint::Structured::Positional->new(
- name => 'Tuple',
- parent => find_type_constraint('ArrayRef'),
- package_defined_in => __PACKAGE__,
- signature => [map {
- _normalize_type_constraint($_);
- } @args],
- optional_signature => [map {
- _normalize_type_constraint($_);
- } @optional],
- );
-}
+Override the type_storage method so that we can inline the types. We do this
+because if we try to say "type Dict, $dict" or similar, I found that
+L<Moose::Util::TypeConstraints> automatically wraps a L<Moose::Meta::TypeConstraint>
+object around my Structured type, which then throws an error since the base
+Type Constraint object doesn't have a parameterize method.
-sub Dict {
- my ($args, $optional) = @_;
- my %args = @$args;
- my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
-
- return MooseX::Meta::TypeConstraint::Structured::Named->new(
- name => 'Dict',
- parent => find_type_constraint('HashRef'),
- package_defined_in => __PACKAGE__,
- signature => {map {
- $_ => _normalize_type_constraint($args{$_});
- } keys %args},
- optional_signature => {map {
- $_ => _normalize_type_constraint($optional{$_});
- } keys %optional},
- );
-}
+In the future, might make all these play more nicely with Parameterized types,
+and then this nasty override can go away.
-sub _normalize_type_constraint {
- my $tc = shift @_;
- if(defined $tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) {
- return $tc;
- } elsif($tc) {
- return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc);
- }
+=cut
+
+sub type_storage {
+ return {
+ Tuple => MooseX::Meta::TypeConstraint::Structured->new(
+ name => 'Tuple',
+ parent => find_type_constraint('ArrayRef'),
+ constraint_generator=> sub {
+ ## Get the constraints and values to check
+ my @type_constraints = @{shift @_};
+ my @values = @{shift @_};
+ ## Perform the checking
+ while(@type_constraints) {
+ my $type_constraint = shift @type_constraints;
+ if(@values) {
+ my $value = shift @values;
+ unless($type_constraint->check($value)) {
+ return;
+ }
+ } else {
+ return;
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(@values) {
+ return;
+ } elsif(@type_constraints) {
+ return;
+ }else {
+ return 1;
+ }
+ }
+ ),
+ Dict => MooseX::Meta::TypeConstraint::Structured->new(
+ name => 'Dict',
+ parent => find_type_constraint('HashRef'),
+ constraint_generator=> sub {
+ ## Get the constraints and values to check
+ my %type_constraints = @{shift @_};
+ my %values = %{shift @_};
+ ## Perform the checking
+ while(%type_constraints) {
+ my($key, $type_constraint) = each %type_constraints;
+ delete $type_constraints{$key};
+ if(exists $values{$key}) {
+ my $value = $values{$key};
+ delete $values{$key};
+ unless($type_constraint->check($value)) {
+ return;
+ }
+ } else {
+ return;
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(%values) {
+ return;
+ } elsif(%type_constraints) {
+ return;
+ }else {
+ return 1;
+ }
+ },
+ ),
+ };
}
=head1 SEE ALSO
The following modules or resources may be of interest.
-L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>
-
-=head1 BUGS
-
-No known or reported bugs.
+L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>,
+L<MooseX::Meta::TypeConstraint::Structured>
=head1 AUTHOR