package MooseX::Types::Structured;
-use MooseX::Types::Moose qw();
-use MooseX::Types -declare => [qw( Dict Tuple Optional )];
+use 5.008;
+use Moose;
+use Moose::Util::TypeConstraints;
+use MooseX::Meta::TypeConstraint::Structured;
+use MooseX::Types -declare => [qw(Dict Tuple Optional)];
-our $VERSION = '0.01';
+our $VERSION = '0.06';
our $AUTHORITY = 'cpan:JJNAPIORK';
=head1 NAME
-MooseX::Types::Structured; Structured Type Constraints for Moose
+MooseX::Types::Structured - Structured Type Constraints for Moose
=head1 SYNOPSIS
-The following is example usage for this module
-
- package MyApp::Types
- TBD
-
-=head1 DESCRIPTION
-
-What this application does, why I made it etc.
-
-=head1 TYPES
-
-This class defines the following types and subtypes.
-
-=cut
-
-
-=head1 SEE ALSO
-
-The following modules or resources may be of interest.
+The following is example usage for this module.
+
+ package MyApp::MyClass;
+
+ use Moose;
+ use MooseX::Types::Moose qw(Str Int);
+ 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],
+ ],
+ );
-L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>
+Then you can instantiate this class with something like:
-=head1 BUGS
+ my $john = MyApp::MyClass->new(
+ name => {
+ first=>'John',
+ middle=>'James'
+ last=>'Napiorkowski',
+ },
+ );
+
+ my $vanessa = MyApp::MyClass->new(
+ name => {
+ first=>'Vanessa',
+ last=>'Li'
+ },
+ );
-No known or reported bugs.
+But all of these would cause a constraint error for the 'name' attribute:
-=head1 AUTHOR
+ 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.
-John Napiorkowski, C<< <jjnapiork@cpan.org> >>
-
-=head1 COPYRIGHT & LICENSE
+=head1 DESCRIPTION
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+A structured type constraint is a standard container L</Moose> type constraint,
+such as an arrayref or hashref, which has been enhanced to allow you to
+explicitly name all the allow type constraints inside the structure. The
+generalized form is:
+
+ TypeConstraint[TypeParameters]
+
+Where 'TypeParameters' is an array or hash of L</Moose::Meta::TypeConstraint>
+type constraints.
+
+This type library enables structured type constraints. It is build on top of the
+L<MooseX::Types> library system, so you should review the documentation for that
+if you are not familiar with it.
+
+=head2 Comparing Parameterized types to Structured types
+
+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 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 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] 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:
+
+ subtype crazy,
+ as Tuple[
+ Int,
+ Dict[name=>Str, age=>Int],
+ ArrayRef[Int]
+ ];
+
+Which would match "[1, {name=>'John', age=>25},[10,11,12]]". Please notice how
+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
+example:
+
+ package MyApp::MyStruct;
+ use Moose;
+
+ has $_ for qw(name age);
+
+ package MyApp::MyClass;
+ use Moose;
+
+ has person => (isa=>'MyApp::MyStruct');
+
+ my $instance = MyApp::MyClass->new(
+ person=>MyApp::MyStruct->new(name=>'John', age=>39),
+ );
+
+This method may take some additional time to setup but will give you more
+flexibility. However, structured constraints are highly compatible with this
+method, granting some interesting possibilities for coercion. Try:
+
+ subtype 'MyStruct',
+ as 'MyApp::MyStruct';
+
+ coerce 'MyStruct',
+ from (Dict[name=>Str, age=>Int]),
+ 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 );
+ };
+
+=head2 Subtyping a structured subtype
+
+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=>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 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. Your thoughts, test cases and
+patches are welcomed for discussion.
+
+=head2 Coercions
+
+Coercions currently work for 'one level' deep. That is you can do:
+
+ subtype Person,
+ as Dict[name=>Str, age=>Int];
+
+ subtype Fullname,
+ 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;
+ +{
+ name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last},
+ age=>$age->years
+ }
+ };
+
+And that should just work as expected. However, if there are any 'inner'
+coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
+won't currently get activated.
+
+Please see the test '07-coerce.t' for a more detailed example.
+
+=head1 TYPE CONSTRAINTS
+
+This type library defines the following constraints.
+
+=head2 Tuple[@constraints]
+
+This defines an arrayref based constraint which allows you to validate a specific
+list of constraints. For example:
+
+ Tuple[Int,Str]; ## Validates [1,'hello']
+ Tuple[Str|Object, Int]; ##Validates ['hello', 1] or [$object, 2]
+
+=head2 Dict [%constraints]
+
+This defines a hashref based constraint which allowed you to validate a specific
+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
-1;
-
-
-
-
-
-
-
-
-class_type "DateTime";
-class_type "DateTime::Duration";
-class_type "DateTime::TimeZone";
-class_type "DateTime::Locale::root" => { name => "DateTime::Locale" };
-
-subtype DateTime, as 'DateTime';
-subtype Duration, as 'DateTime::Duration';
-subtype TimeZone, as 'DateTime::TimeZone';
-subtype Locale, as 'DateTime::Locale';
-
-subtype( Now,
- as Str,
- where { $_ eq 'now' },
- Moose::Util::TypeConstraints::optimize_as {
- no warnings 'uninitialized';
- !ref($_[0]) and $_[0] eq 'now';
- },
+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 {
+ ## Get the constraints and values to check
+ 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;
+ if(@values) {
+ my $value = shift @values;
+ unless($type_constraint->check($value)) {
+ return;
+ }
+ } else {
+ unless($type_constraint->check()) {
+ return;
+ }
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(@values) {
+ return;
+ } elsif(@type_constraints) {
+ return;
+ }else {
+ return 1;
+ }
+ }
+ )
);
-
-our %coercions = (
- DateTime => [
- from Num, via { 'DateTime'->from_epoch( epoch => $_ ) },
- from HashRef, via { 'DateTime'->new( %$_ ) },
- from Now, via { 'DateTime'->now },
- ],
- "DateTime::Duration" => [
- from Num, via { DateTime::Duration->new( seconds => $_ ) },
- from HashRef, via { DateTime::Duration->new( %$_ ) },
- ],
- "DateTime::TimeZone" => [
- from Str, via { DateTime::TimeZone->new( name => $_ ) },
- ],
- "DateTime::Locale" => [
- from Moose::Util::TypeConstraints::find_or_create_isa_type_constraint("Locale::Maketext"),
- via { DateTime::Locale->load($_->language_tag) },
- from Str, via { DateTime::Locale->load($_) },
- ],
+
+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 {
+ ## Get the constraints and values to check
+ 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;
+ delete $type_constraints{$key};
+ if(exists $values{$key}) {
+ my $value = $values{$key};
+ delete $values{$key};
+ unless($type_constraint->check($value)) {
+ return;
+ }
+ } else {
+ unless($type_constraint->check()) {
+ return;
+ }
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(%values) {
+ return;
+ } elsif(%type_constraints) {
+ return;
+ }else {
+ return 1;
+ }
+ },
+ )
);
-for my $type ( "DateTime", DateTime ) {
- coerce $type => @{ $coercions{DateTime} };
-}
-
-for my $type ( "DateTime::Duration", Duration ) {
- coerce $type => @{ $coercions{"DateTime::Duration"} };
-}
-
-for my $type ( "DateTime::TimeZone", TimeZone ) {
- coerce $type => @{ $coercions{"DateTime::TimeZone"} };
-}
-
-for my $type ( "DateTime::Locale", Locale ) {
- coerce $type => @{ $coercions{"DateTime::Locale"} };
-}
-
-__PACKAGE__
-
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::Types::DateTime - L<DateTime> related constraints and coercions for
-Moose
-
-=head1 SYNOPSIS
-
-Export Example:
-
- use MooseX::Types::DateTime qw(TimeZone);
-
- has time_zone => (
- isa => TimeZone,
- is => "rw",
- coerce => 1,
+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;
+ }
+ }
+ }
);
- Class->new( time_zone => "Africa/Timbuktu" );
-
-Namespaced Example:
-
- use MooseX::Types::DateTime;
-
- has time_zone => (
- isa => 'DateTime::TimeZone',
- is => "rw",
- coerce => 1,
- );
-
- Class->new( time_zone => "Africa/Timbuktu" );
-
-=head1 DESCRIPTION
-
-This module packages several L<Moose::Util::TypeConstraints> with coercions,
-designed to work with the L<DateTime> suite of objects.
-
-=head1 CONSTRAINTS
-
-=over 4
-
-=item L<DateTime>
-
-A class type for L<DateTime>.
-
-=over 4
-
-=item from C<Num>
-
-Uses L<DateTime/from_epoch>. Floating values will be used for subsecond
-percision, see L<DateTime> for details.
-
-=item from C<HashRef>
-
-Calls L<DateTime/new> with the hash entries as arguments.
-
-=back
-
-=item L<Duration>
-
-A class type for L<DateTime::Duration>
-
-=over 4
-
-=item from C<Num>
-
-Uses L<DateTime::Duration/new> and passes the number as the C<seconds> argument.
-
-Note that due to leap seconds, DST changes etc this may not do what you expect.
-For instance passing in C<86400> is not always equivalent to one day, although
-there are that many seconds in a day. See L<DateTime/"How Date Math is Done">
-for more details.
-
-=item from C<HashRef>
-
-Calls L<DateTime::Duration/new> with the hash entries as arguments.
-
-=back
-
-=item L<DateTime::Locale>
-
-A class type for L<DateTime::Locale::root> with the name L<DateTime::Locale>.
-
-=over 4
-
-=item from C<Str>
-
-The string is treated as a language tag (e.g. C<en> or C<he_IL>) and given to
-L<DateTime::Locale/load>.
-
-=item from L<Locale::Maktext>
-
-The C<Locale::Maketext/language_tag> attribute will be used with L<DateTime::Locale/load>.
-
-=item L<DateTime::TimeZone>
-
-A class type for L<DateTime::TimeZone>.
-
-=over 4
-
-=item from C<Str>
-
-Treated as a time zone name or offset. See L<DateTime::TimeZone/USAGE> for more
-details on the allowed values.
-
-Delegates to L<DateTime::TimeZone/new> with the string as the C<name> argument.
+ Moose::Util::TypeConstraints::register_type_constraint($Optional);
+ Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
+}
-=back
=head1 SEE ALSO
-L<MooseX::Types::DateTimeX>
+The following modules or resources may be of interest.
-L<DateTime>, L<DateTimeX::Easy>
+L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>,
+L<MooseX::Meta::TypeConstraint::Structured>
-=head1 VERSION CONTROL
+=head1 TODO
-L<http://code2.0beta.co.uk/moose/svn/MooseX-Types-DateTime/trunk>. Ask on
-#moose for commit bits.
+Need to clarify deep coercions, need to clarify subtypes of subtypes.
=head1 AUTHOR
-Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
-
-John Napiorkowski E<lt>jjn1056 at yahoo.comE<gt>
+John Napiorkowski, C<< <jjnapiork@cpan.org> >>
-=head1 COPYRIGHT
+=head1 COPYRIGHT & LICENSE
- Copyright (c) 2008 Yuval Kogman. All rights reserved
- This program is free software; you can redistribute
- it and/or modify it under the same terms as Perl itself.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
=cut
+
+1;
projects / gitmo/MooseX-Types-Structured.git / blobdiff