X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FStructured.pm;h=6063e4c21a8928e8f6332eb12814a2e6b379792d;hb=190a34ebaf957618baf301ad0574bfc21b2f76b1;hp=37b2efc33acc768be3c19636079039da684f73fc;hpb=af1d00c99a2cc3bf2e9aa7f41a5dab3d705b950e;p=gitmo%2FMooseX-Types-Structured.git diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm index 37b2efc..6063e4c 100644 --- a/lib/MooseX/Types/Structured.pm +++ b/lib/MooseX/Types/Structured.pm @@ -1,12 +1,12 @@ package MooseX::Types::Structured; +use 5.008; use Moose; use Moose::Util::TypeConstraints; use MooseX::Meta::TypeConstraint::Structured; -use MooseX::Types -declare => [qw(Dict Tuple)]; +use MooseX::Types -declare => [qw(Dict Tuple Optional)]; - -our $VERSION = '0.02'; +our $VERSION = '0.06'; our $AUTHORITY = 'cpan:JJNAPIORK'; =head1 NAME @@ -21,51 +21,93 @@ The following is example usage for this module. use Moose; use MooseX::Types::Moose qw(Str Int); - use MooseX::Types::Structured qw(Dict Tuple); - - has name => (isa=>Dict[first_name=>Str, last_name=>Str]); + use MooseX::Types::Structured qw(Dict Optional); + + ## A name has a first and last part, but middle names are not required + has name => ( + isa=>Dict[ + first=>Str, + last=>Str, + middle=>Optional[Str], + ], + ); Then you can instantiate this class with something like: - my $instance = MyApp::MyClass->new( - name=>{first_name=>'John', last_name=>'Napiorkowski'}, - ); - -But all of these would cause an error: + my $john = MyApp::MyClass->new( + name => { + first=>'John', + middle=>'James' + last=>'Napiorkowski', + }, + ); + + my $vanessa = MyApp::MyClass->new( + name => { + first=>'Vanessa', + last=>'Li' + }, + ); - my $instance = MyApp::MyClass->new(name=>'John'); - my $instance = MyApp::MyClass->new(name=>{first_name=>'John'}); - my $instance = MyApp::MyClass->new(name=>{first_name=>'John', age=>39}); +But all of these would cause a constraint error for the 'name' attribute: + MyApp::MyClass->new( name=>'John' ); + MyApp::MyClass->new( name=>{first_name=>'John'} ); + MyApp::MyClass->new( name=>{first_name=>'John', age=>39} ); + MyApp::MyClass->new( name=>{first=>'Vanessa', middle=>[1,2], last=>'Li'} ); + Please see the test cases for more examples. =head1 DESCRIPTION A structured type constraint is a standard container L type constraint, such as an arrayref or hashref, which has been enhanced to allow you to -explicitely name all the allow type constraints inside the structure. The +explicitly name all the allow type constraints inside the structure. The generalized form is: TypeConstraint[TypeParameters] -Where TypeParameters is a list of type constraints. +Where 'TypeParameters' is an array or hash of L +type constraints. + +This type library enables structured type constraints. It is build on top of the +L library system, so you should review the documentation for that +if you are not familiar with it. + +=head2 Comparing Parameterized types to Structured types -This type library enables structured type constraints. These work in a similar -way to parameterized constraints that are built into the core Moose types, -except that you are allowed to define the container's entire structure. For -example, you could define a parameterized constraint like so: +Parameterized constraints are built into the core Moose types 'HashRef' and +'ArrayRef'. Structured types have similar functionality, so their syntax is +likewise similar. For example, you could define a parameterized constraint like: - subtype HashOfInts, - as Hashref[Int]; + subtype ArrayOfInts, + as Arrayref[Int]; which would constraint a value to something like [1,2,3,...] and so on. On the -other hand, a structured type constrain explicitly names all it's allowed type +other hand, a structured type constraint explicitly names all it's allowed type parameter constraints. For the example: subtype StringFollowedByInt, as Tuple[Str,Int]; -would constrain it's value to something like ['hello', 111]; +would constrain it's value to something like ['hello', 111] but ['hello', 'world'] +would fail, as well as ['hello', 111, 'world'] and so on. + +Structured Constraints are not limited to arrays. You can define a structure +against a hashref with 'Dict' as in this example: + + subtype FirstNameLastName, + as Dict[firste=>Str, lastname=>Str]; + +This would constrain a hashref to something like: + + {firstname=>'Vanessa', lastname=>'Li'}; + +but all the following would fail validation: + + {first=>'Vanessa', last=>'Li'}; + {firstname=>'Vanessa', lastname=>'Li', middlename=>'NA'}; + ['Vanessa', 'Li']; These structures can be as simple or elaborate as you wish. You can even combine various structured, parameterized and simple constraints all together: @@ -78,7 +120,11 @@ combine various structured, parameterized and simple constraints all together: ]; Which would match "[1, {name=>'John', age=>25},[10,11,12]]". Please notice how -the type parameters +the type parameters can be visually arranged to your liking and to improve the +clarity of your meaning. You don't need to run then altogether onto a single +line. + +=head2 Alternatives You should exercise some care as to whether or not your complex structured constraints would be better off contained by a real object as in the following @@ -107,16 +153,12 @@ method, granting some interesting possibilities for coercion. Try: coerce 'MyStruct', from (Dict[name=>Str, age=>Int]), - via { - MyApp::MyStruct->new(%$_); - }, + via { MyApp::MyStruct->new(%$_) }, from (Dict[last_name=>Str, first_name=>Str, dob=>DateTime]), via { my $name = $_->{first_name} .' '. $_->{last_name}; my $age = DateTime->now - $_->{dob}; - MyApp::MyStruct->new( - name=>$name, - age=>$age->years ); + MyApp::MyStruct->new( name=>$name, age=>$age->years ); }; =head2 Subtyping a structured subtype @@ -125,17 +167,17 @@ You need to exercise some care when you try to subtype a structured type as in this example: subtype Person, - as Dict[name=>Str, age=>iIt]; + as Dict[name=>Str, age=>Int]; subtype FriendlyPerson, as Person[name=>Str, age=>Int, totalFriends=>Int]; This will actually work BUT you have to take care that the subtype has a structure that does not contradict the structure of it's parent. For now the -above works, but I will probably clarify how this works at a future point, so +above works, but I will clarify the syntax for this at a future point, so it's recommended to avoid (should not realy be needed so much anyway). For -now this is supported in an EXPERIMENTAL way. In the future we will probably -clarify how to augment existing structured types. +now this is supported in an EXPERIMENTAL way. Your thoughts, test cases and +patches are welcomed for discussion. =head2 Coercions @@ -148,10 +190,13 @@ Coercions currently work for 'one level' deep. That is you can do: as Dict[first=>Str, last=>Str]; coerce Person, + ## Coerce an object of a particular class from BlessedPersonObject, via { +{name=>$_->name, age=>$_->age} }, + ## Coerce from [$name, $age] from ArrayRef, via { +{name=>$_->[0], age=>$_->[1] }, + ## Coerce from {fullname=>{first=>...,last=>...}, dob=>$DateTimeObject} from Dict[fullname=>Fullname, dob=>DateTime], via { my $age = $_->dob - DateTime->now; @@ -186,16 +231,79 @@ hashref. For example: Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39} +=head2 Optional [$constraint] + +This is primarily a helper constraint for Dict and Tuple type constraints. What +this allows if for you to assert that a given type constraint is allowed to be +null (but NOT undefined). If the value is null, then the type constraint passes +but if the value is defined it must validate against the type constraint. This +makes it easy to make a Dict where one or more of the keys doesn't have to exist +or a tuple where some of the values are not required. For example: + + subtype Name() => as Dict[ + first=>Str, + last=>Str, + middle=>Optional[Str], + ]; + +Creates a constraint that validates against a hashref with the keys 'first' and +'last' being strings and required while an optional key 'middle' is must be a +string if it appears but doesn't have to appear. So in this case both the +following are valid: + + {first=>'John', middle=>'James', last=>'Napiorkowski'} + {first=>'Vanessa', last=>'Li'} + +=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. + +=head2 Normalize a HashRef + +You need a hashref to conform to a canonical structure but are required accept a +bunch of different incoming structures. You can normalize using the Dict type +constraint and coercions. This example also shows structured types mixed which +other MooseX::Types libraries. + + package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize; + + use Moose; + use DateTime; + + use MooseX::Types::Structured qw(Dict Tuple); + use MooseX::Types::DateTime qw(DateTime); + use MooseX::Types::Moose qw(Int Str Object); + use MooseX::Types -declare => [qw(Name Age Person)]; + + subtype Person, + as Dict[name=>Str, age=>Int]; + + coerce Person, + from Dict[first=>Str, last=>Str, years=>Int], + via { +{ + name => "$_->{first} $_->{last}", + age=>$_->{years}, + }}, + from Dict[fullname=>Dict[last=>Str, first=>Str], dob=>DateTime], + via { +{ + name => "$_->{fullname}{first} $_->{fullname}{last}", + age => ($_->{dob} - 'DateTime'->now)->years, + }}; + + has person => (is=>'rw', isa=>Person, coerce=>1); + =cut Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( MooseX::Meta::TypeConstraint::Structured->new( name => "MooseX::Types::Structured::Tuple" , parent => find_type_constraint('ArrayRef'), - constraint_generator=> sub { + constraint_generator=> sub { ## Get the constraints and values to check - my @type_constraints = @{shift @_}; - my @values = @{shift @_}; + my ($type_constraints, $values) = @_; + my @type_constraints = defined $type_constraints ? @$type_constraints: (); + my @values = defined $values ? @$values: (); ## Perform the checking while(@type_constraints) { my $type_constraint = shift @type_constraints; @@ -205,7 +313,9 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( return; } } else { - return; + unless($type_constraint->check()) { + return; + } } } ## Make sure there are no leftovers. @@ -224,10 +334,11 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( MooseX::Meta::TypeConstraint::Structured->new( name => "MooseX::Types::Structured::Dict", parent => find_type_constraint('HashRef'), - constraint_generator=> sub { + constraint_generator=> sub { ## Get the constraints and values to check - my %type_constraints = @{shift @_}; - my %values = %{shift @_}; + my ($type_constraints, $values) = @_; + my %type_constraints = defined $type_constraints ? @$type_constraints: (); + my %values = defined $values ? %$values: (); ## Perform the checking while(%type_constraints) { my($key, $type_constraint) = each %type_constraints; @@ -237,22 +348,15 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( delete $values{$key}; unless($type_constraint->check($value)) { return; - #if ($type_constraint->has_coercion) { - # my $temp = $type_constraint->coerce($value); - # use Data::Dump qw/dump/; warn dump $value, $temp; - # unless($type_constraint->check($temp)) { - # return; - # } - #} else { - # return; - #} } - } else { - return; + } else { + unless($type_constraint->check()) { + return; + } } } ## Make sure there are no leftovers. - if(%values) { + if(%values) { return; } elsif(%type_constraints) { return; @@ -263,6 +367,33 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( ) ); +OPTIONAL: { + my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new( + name => 'MooseX::Types::Structured::Optional', + package_defined_in => __PACKAGE__, + parent => find_type_constraint('Item'), + constraint => sub { 1 }, + constraint_generator => sub { + my ($type_parameter, @args) = @_; + my $check = $type_parameter->_compiled_type_constraint(); + return sub { + my (@args) = @_; + if(exists($args[0])) { + ## If it exists, we need to validate it + $check->($args[0]); + } else { + ## But it's is okay if the value doesn't exists + return 1; + } + } + } + ); + + Moose::Util::TypeConstraints::register_type_constraint($Optional); + Moose::Util::TypeConstraints::add_parameterizable_type($Optional); +} + + =head1 SEE ALSO The following modules or resources may be of interest.