From: John Napiorkowski Date: Mon, 15 Sep 2008 03:22:17 +0000 (+0000) Subject: more work toward true structured types, away from the method based hack, some refacto... X-Git-Tag: 0.01~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=7e2f0558073a1a9544274a76ad7530340b2c18e8 more work toward true structured types, away from the method based hack, some refactoring of a base class and a first go at Optional, or at least decent documenation for it. --- diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Optional.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Optional.pm new file mode 100755 index 0000000..ba1ad53 --- /dev/null +++ b/lib/MooseX/Meta/TypeConstraint/Structured/Optional.pm @@ -0,0 +1,145 @@ +package MooseX::Meta::TypeConstraint::Structured::Optional; + +use Moose; +use Moose::Meta::TypeConstraint (); + +extends 'Moose::Meta::TypeConstraint'; +with 'MooseX::Meta::TypeConstraint::Role::Structured'; + +=head1 NAME + +MooseX::Meta::TypeConstraint::Structured::Optional - Structured Type Constraints + +=head1 SYNOPSIS + +The follow is example usage: + + use Moose::Util::TypeConstraints; + use MooseX::Meta::TypeConstraint::Structured::Optional; + + my @options = ('Str', 'Int'); + + my $tc = MooseX::Meta::TypeConstraint::Structured::Optional->new( + name => 'Dict', + parent => find_type_constraint('ArrayRef'), + signature => [map { + find_type_constraint($_); + } @options], + ); + +=head1 DESCRIPTION + +Optional Type Constraints are additional constraints on a 'base' structured +type constraint which extends those constraints with additional optional +fields. Basically this constraint get's it's constraint logic and args +from a a Structured Type Constraint that contains it. So basically: + + MyType[Int,Str,Optional[Int, Int]] + +In this example, the structured Type constraint 'MyType' is the container for +this Optional type called 'Optional'. What will happen here is that the +MyType will get the first elements for validation and a third one will go +to optional. Optional will 'inline' itself so that you can validate with: + + ->validate(1,'hello',2,3); + ->validate(1,'hello',2); + ->validate(1,'hello'); + +and not: + + ->validate(1,'hello',[2,3]]); + ->validate(1,'hello',[2]]); + +as you might expect. Basically it sucks up args to the length of it's declared +type constraints. + +Please keep in mind the type constraint names given in this example are for +example use only and any similarity between them, actual Type Constraints and +package names are coincidental. + +=head1 ATTRIBUTES + +This class defines the following attributes. + +=head2 containing_type_constraint ($structured_type_constraint) + +This is the type constraint that contains the Optional parameters. + +=cut + +has 'containing_type_constraint' => ( + is=>'ro', + does=>'MooseX::Meta::TypeConstraint::Role::Structured', + required=>1, +); + +=head2 signature + +This is a signature of internal contraints for the contents of the outer +contraint container. + +=cut + +has '+signature' => (isa=>'ArrayRef[Moose::Meta::TypeConstraint]'); + +=head1 METHODS + +This class defines the following methods. + +=head2 _normalize_args + +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 HashRef. This gets +delegated to the containing class (L). + +=cut + +sub _normalize_args { + return shift->containing_type_constraint->_normalize_args(@_); +} + +=head2 constraint + +The constraint is basically validating the L against the incoming + +=cut + +sub constraint { + return shift->containing_type_constraint->constraint(@_); +} + +=head2 parse_parameter_str ($str) + +Given a $string that is the parameter information part of a parameterized +constraint, parses it for internal constraint information. This is delegated +to the containing class. + +=cut + +sub parse_parameter_str { + return shift->containing_type_constraint->parse_parameter_str(@_); +} + + +=head2 signature_equals + +Check that the signature equals another signature. Delegated to the containing +class. + +=cut + +sub signature_equals { + return shift->containing_type_constraint->signature_equals(@_); +} + +=head1 AUTHOR + +John James Napiorkowski + +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut + +no Moose; 1; diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm index f51a9d6..115e25a 100644 --- a/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm +++ b/lib/MooseX/Meta/TypeConstraint/Structured/Positional.pm @@ -117,6 +117,33 @@ sub constraint { }; } +=head2 parse_parameter_str ($str) + +Given a $string that is the parameter information part of a parameterized +constraint, parses it for internal constraint information. For example: + + MyType[Int,Int,Str] + +has a parameter string of "Int,Int,Str" (whitespace will automatically be +removed during normalization that happens in L) +and we need to convert that to ['Int','Int','Str'] which then has any type +constraints converted to true objects. + +=cut + +{ + my $comma = qr{,}; + my $indirection = qr{=>}; + my $divider_ops = qr{ $comma | $indirection }x; + my $structure_divider = qr{\s* $divider_ops \s*}x; + + sub parse_parameter_str { + my ($class, $type_str) = @_; + my @type_strs = split($structure_divider, $type_str); + return map { Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_) } @type_strs; + } +} + =head2 signature_equals Check that the signature equals another signature. diff --git a/lib/MooseX/Meta/TypeConstraint/Structured/Structurable.pm b/lib/MooseX/Meta/TypeConstraint/Structured/Structurable.pm index 325d37e..8115c61 100755 --- a/lib/MooseX/Meta/TypeConstraint/Structured/Structurable.pm +++ b/lib/MooseX/Meta/TypeConstraint/Structured/Structurable.pm @@ -1,4 +1,4 @@ -package MooseX::Meta::TypeConstraint::Structured::Positionable; +package MooseX::Meta::TypeConstraint::Structured::Structurable; use strict; use warnings; @@ -7,35 +7,27 @@ use metaclass; use base 'Moose::Meta::TypeConstraint'; use Moose::Util::TypeConstraints (); -use MooseX::Meta::TypeConstraint::Structured::Positional; __PACKAGE__->meta->add_attribute('structured_type' => ( accessor => 'structured_type', predicate => 'has_structured_type', )); - my $comma = qr{,}; - my $indirection = qr{=>}; - my $divider_ops = qr{ $comma | $indirection }x; - my $structure_divider = qr{\s* $divider_ops \s*}x; - sub parse_parameter_str { - my ($self, $type_str) = @_; - my @type_strs = split($structure_divider, $type_str); - return map {Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_)} @type_strs; + my ($self, $type_str) = @_; + return $self->structured_type->parse_parameter_str($type_str); } sub parameterize { my ($self, @contained_tcs) = @_; my $tc_name = $self->name .'['. join(',', map {$_->name} @contained_tcs) .']'; - return MooseX::Meta::TypeConstraint::Structured::Positional->new( + return $self->structured_type->new( name => $tc_name, - parent => Moose::Util::TypeConstraints::find_type_constraint('ArrayRef'), + parent => $self->parent, package_defined_in => __PACKAGE__, signature => \@contained_tcs, ); } - 1; diff --git a/t/01-basic.t b/t/01-basic.t index f6cfbcc..45e7351 100755 --- a/t/01-basic.t +++ b/t/01-basic.t @@ -1,18 +1,20 @@ BEGIN { use strict; use warnings; - use Test::More tests=>8; + use Test::More tests=>10; use Test::Exception; use_ok 'Moose::Util::TypeConstraints'; - use_ok 'MooseX::Meta::TypeConstraint::Structured::Positionable'; + use_ok 'MooseX::Meta::TypeConstraint::Structured::Structurable'; + use_ok 'MooseX::Meta::TypeConstraint::Structured::Positional'; + use_ok 'MooseX::Meta::TypeConstraint::Structured::Named'; } - -my $tuple = MooseX::Meta::TypeConstraint::Structured::Positionable->new( +my $tuple = MooseX::Meta::TypeConstraint::Structured::Structurable->new( name => 'Tuple', + structured_type => 'MooseX::Meta::TypeConstraint::Structured::Positional', package_defined_in => __PACKAGE__, - parent => find_type_constraint('Ref'), + parent => find_type_constraint('ArrayRef'), ); Moose::Util::TypeConstraints::register_type_constraint($tuple); @@ -22,7 +24,6 @@ Moose::Util::TypeConstraints::register_type_constraint($tuple); ok Moose::Util::TypeConstraints::find_type_constraint('Tuple') => 'Found the Tuple Type'; - { package Test::MooseX::Types::Structured::Positionable;