[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm

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 Optional)];

our $VERSION = '0.06';
our $AUTHORITY = 'cpan:JJNAPIORK';

=head1 NAME

MooseX::Types::Structured - Structured Type Constraints for Moose

=head1 SYNOPSIS

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],
        ],
    );

Then you can instantiate this class with something like:

    my $john = MyApp::MyClass->new(
        name => {
            first=>'John',
            middle=>'James'
            last=>'Napiorkowski',
        },
    );
    
    my $vanessa = MyApp::MyClass->new(
        name => {
            first=>'Vanessa',
            last=>'Li'
        },
    );

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</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

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;
			}
		}
	)
);
	
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;
			}
		},
	)
);

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.

L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>,
L<MooseX::Meta::TypeConstraint::Structured>

=head1 TODO

Need to clarify deep coercions, need to clarify subtypes of subtypes.

=head1 AUTHOR

John Napiorkowski, C<< <jjnapiork@cpan.org> >>

=head1 COPYRIGHT & LICENSE

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
	
1;
Commit	Line	Data
d24da8ec	1	package MooseX::Types::Structured;
d24da8ec	2
98336987	3	use 5.008;
6c2f284c	4	use Moose;
6c2f284c	5	use Moose::Util::TypeConstraints;
a30fa891	6	use MooseX::Meta::TypeConstraint::Structured;
e327145a	7	use MooseX::Types -declare => [qw(Dict Tuple Optional)];
011bacc6	8
190a34eb	9	our $VERSION = '0.06';
d24da8ec	10	our $AUTHORITY = 'cpan:JJNAPIORK';
	11
	12	=head1 NAME
	13
af1d00c9	14	MooseX::Types::Structured - Structured Type Constraints for Moose
d24da8ec	15
	16	=head1 SYNOPSIS
	17
af1d00c9	18	The following is example usage for this module.
6c2f284c	19
af1d00c9	20	package MyApp::MyClass;
6c2f284c	21
af1d00c9	22	use Moose;
af1d00c9	23	use MooseX::Types::Moose qw(Str Int);
190a34eb	24	use MooseX::Types::Structured qw(Dict Optional);
	25
	26	## A name has a first and last part, but middle names are not required
	27	has name => (
	28	isa=>Dict[
	29	first=>Str,
	30	last=>Str,
	31	middle=>Optional[Str],
	32	],
	33	);
af1d00c9	34
6c2f284c	35	Then you can instantiate this class with something like:
6c2f284c	36
190a34eb	37	my $john = MyApp::MyClass->new(
	38	name => {
	39	first=>'John',
	40	middle=>'James'
	41	last=>'Napiorkowski',
	42	},
	43	);
	44
	45	my $vanessa = MyApp::MyClass->new(
d87e8b74	46	name => {
190a34eb	47	first=>'Vanessa',
190a34eb	48	last=>'Li'
d87e8b74	49	},
d87e8b74	50	);
d24da8ec	51
d87e8b74	52	But all of these would cause a constraint error for the 'name' attribute:
6c2f284c	53
d87e8b74	54	MyApp::MyClass->new( name=>'John' );
	55	MyApp::MyClass->new( name=>{first_name=>'John'} );
	56	MyApp::MyClass->new( name=>{first_name=>'John', age=>39} );
190a34eb	57	MyApp::MyClass->new( name=>{first=>'Vanessa', middle=>[1,2], last=>'Li'} );
190a34eb	58
6c2f284c	59	Please see the test cases for more examples.
d24da8ec	60
	61	=head1 DESCRIPTION
	62
af1d00c9	63	A structured type constraint is a standard container L</Moose> type constraint,
af1d00c9	64	such as an arrayref or hashref, which has been enhanced to allow you to
59deb858	65	explicitly name all the allow type constraints inside the structure. The
af1d00c9	66	generalized form is:
	67
	68	TypeConstraint[TypeParameters]
	69
d87e8b74	70	Where 'TypeParameters' is an array or hash of L</Moose::Meta::TypeConstraint>
d87e8b74	71	type constraints.
af1d00c9	72
59deb858	73	This type library enables structured type constraints. It is build on top of the
	74	L<MooseX::Types> library system, so you should review the documentation for that
	75	if you are not familiar with it.
	76
5632ada1	77	=head2 Comparing Parameterized types to Structured types
59deb858	78
	79	Parameterized constraints are built into the core Moose types 'HashRef' and
	80	'ArrayRef'. Structured types have similar functionality, so their syntax is
	81	likewise similar. For example, you could define a parameterized constraint like:
6c2f284c	82
d87e8b74	83	subtype ArrayOfInts,
d87e8b74	84	as Arrayref[Int];
6c2f284c	85
af1d00c9	86	which would constraint a value to something like [1,2,3,...] and so on. On the
59deb858	87	other hand, a structured type constraint explicitly names all it's allowed type
af1d00c9	88	parameter constraints. For the example:
6c2f284c	89
af1d00c9	90	subtype StringFollowedByInt,
af1d00c9	91	as Tuple[Str,Int];
6c2f284c	92
59deb858	93	would constrain it's value to something like ['hello', 111] but ['hello', 'world']
d87e8b74	94	would fail, as well as ['hello', 111, 'world'] and so on.
	95
	96	Structured Constraints are not limited to arrays. You can define a structure
	97	against a hashref with 'Dict' as in this example:
	98
	99	subtype FirstNameLastName,
	100	as Dict[firste=>Str, lastname=>Str];
	101
	102	This would constrain a hashref to something like:
	103
	104	{firstname=>'Vanessa', lastname=>'Li'};
	105
	106	but all the following would fail validation:
	107
	108	{first=>'Vanessa', last=>'Li'};
	109	{firstname=>'Vanessa', lastname=>'Li', middlename=>'NA'};
	110	['Vanessa', 'Li'];
6c2f284c	111
	112	These structures can be as simple or elaborate as you wish. You can even
	113	combine various structured, parameterized and simple constraints all together:
	114
af1d00c9	115	subtype crazy,
	116	as Tuple[
	117	Int,
	118	Dict[name=>Str, age=>Int],
	119	ArrayRef[Int]
	120	];
6c2f284c	121
af1d00c9	122	Which would match "[1, {name=>'John', age=>25},[10,11,12]]". Please notice how
59deb858	123	the type parameters can be visually arranged to your liking and to improve the
	124	clarity of your meaning. You don't need to run then altogether onto a single
	125	line.
	126
	127	=head2 Alternatives
6c2f284c	128
	129	You should exercise some care as to whether or not your complex structured
	130	constraints would be better off contained by a real object as in the following
	131	example:
	132
af1d00c9	133	package MyApp::MyStruct;
	134	use Moose;
	135
	136	has $_ for qw(name age);
	137
	138	package MyApp::MyClass;
	139	use Moose;
	140
	141	has person => (isa=>'MyApp::MyStruct');
	142
	143	my $instance = MyApp::MyClass->new(
	144	person=>MyApp::MyStruct->new(name=>'John', age=>39),
	145	);
6c2f284c	146
	147	This method may take some additional time to setup but will give you more
	148	flexibility. However, structured constraints are highly compatible with this
	149	method, granting some interesting possibilities for coercion. Try:
	150
af1d00c9	151	subtype 'MyStruct',
	152	as 'MyApp::MyStruct';
	153
	154	coerce 'MyStruct',
	155	from (Dict[name=>Str, age=>Int]),
59deb858	156	via { MyApp::MyStruct->new(%$_) },
af1d00c9	157	from (Dict[last_name=>Str, first_name=>Str, dob=>DateTime]),
	158	via {
	159	my $name = $_->{first_name} .' '. $_->{last_name};
	160	my $age = DateTime->now - $_->{dob};
59deb858	161	MyApp::MyStruct->new( name=>$name, age=>$age->years );
af1d00c9	162	};
a4a88fef	163
16aea7bf	164	=head2 Subtyping a structured subtype
	165
	166	You need to exercise some care when you try to subtype a structured type
a4a88fef	167	as in this example:
d24da8ec	168
af1d00c9	169	subtype Person,
d87e8b74	170	as Dict[name=>Str, age=>Int];
a4a88fef	171
af1d00c9	172	subtype FriendlyPerson,
af1d00c9	173	as Person[name=>Str, age=>Int, totalFriends=>Int];
a4a88fef	174
16aea7bf	175	This will actually work BUT you have to take care that the subtype has a
a4a88fef	176	structure that does not contradict the structure of it's parent. For now the
59deb858	177	above works, but I will clarify the syntax for this at a future point, so
a4a88fef	178	it's recommended to avoid (should not realy be needed so much anyway). For
59deb858	179	now this is supported in an EXPERIMENTAL way. Your thoughts, test cases and
59deb858	180	patches are welcomed for discussion.
16aea7bf	181
	182	=head2 Coercions
	183
	184	Coercions currently work for 'one level' deep. That is you can do:
	185
af1d00c9	186	subtype Person,
16aea7bf	187	as Dict[name=>Str, age=>Int];
af1d00c9	188
16aea7bf	189	subtype Fullname,
16aea7bf	190	as Dict[first=>Str, last=>Str];
af1d00c9	191
af1d00c9	192	coerce Person,
d87e8b74	193	## Coerce an object of a particular class
af1d00c9	194	from BlessedPersonObject,
af1d00c9	195	via { +{name=>$_->name, age=>$_->age} },
d87e8b74	196	## Coerce from [$name, $age]
af1d00c9	197	from ArrayRef,
af1d00c9	198	via { +{name=>$_->[0], age=>$_->[1] },
d87e8b74	199	## Coerce from {fullname=>{first=>...,last=>...}, dob=>$DateTimeObject}
16aea7bf	200	from Dict[fullname=>Fullname, dob=>DateTime],
16aea7bf	201	via {
af1d00c9	202	my $age = $_->dob - DateTime->now;
	203	+{
	204	name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last},
	205	age=>$age->years
	206	}
16aea7bf	207	};
	208
	209	And that should just work as expected. However, if there are any 'inner'
	210	coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
	211	won't currently get activated.
	212
	213	Please see the test '07-coerce.t' for a more detailed example.
	214
	215	=head1 TYPE CONSTRAINTS
	216
	217	This type library defines the following constraints.
	218
	219	=head2 Tuple[@constraints]
	220
	221	This defines an arrayref based constraint which allows you to validate a specific
	222	list of constraints. For example:
	223
af1d00c9	224	Tuple[Int,Str]; ## Validates [1,'hello']
af1d00c9	225	Tuple[Str\|Object, Int]; ##Validates ['hello', 1] or [$object, 2]
16aea7bf	226
	227	=head2 Dict [%constraints]
	228
	229	This defines a hashref based constraint which allowed you to validate a specific
	230	hashref. For example:
	231
af1d00c9	232	Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
d24da8ec	233
190a34eb	234	=head2 Optional [$constraint]
	235
	236	This is primarily a helper constraint for Dict and Tuple type constraints. What
	237	this allows if for you to assert that a given type constraint is allowed to be
	238	null (but NOT undefined). If the value is null, then the type constraint passes
	239	but if the value is defined it must validate against the type constraint. This
	240	makes it easy to make a Dict where one or more of the keys doesn't have to exist
	241	or a tuple where some of the values are not required. For example:
	242
	243	subtype Name() => as Dict[
	244	first=>Str,
	245	last=>Str,
	246	middle=>Optional[Str],
	247	];
	248
	249	Creates a constraint that validates against a hashref with the keys 'first' and
	250	'last' being strings and required while an optional key 'middle' is must be a
	251	string if it appears but doesn't have to appear. So in this case both the
	252	following are valid:
	253
	254	{first=>'John', middle=>'James', last=>'Napiorkowski'}
	255	{first=>'Vanessa', last=>'Li'}
	256
59deb858	257	=head1 EXAMPLES
	258
	259	Here are some additional example usage for structured types. All examples can
	260	be found also in the 't/examples.t' test. Your contributions are also welcomed.
	261
	262	=head2 Normalize a HashRef
	263
	264	You need a hashref to conform to a canonical structure but are required accept a
	265	bunch of different incoming structures. You can normalize using the Dict type
	266	constraint and coercions. This example also shows structured types mixed which
	267	other MooseX::Types libraries.
	268
	269	package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
	270
	271	use Moose;
	272	use DateTime;
	273
	274	use MooseX::Types::Structured qw(Dict Tuple);
	275	use MooseX::Types::DateTime qw(DateTime);
	276	use MooseX::Types::Moose qw(Int Str Object);
	277	use MooseX::Types -declare => [qw(Name Age Person)];
	278
	279	subtype Person,
	280	as Dict[name=>Str, age=>Int];
	281
	282	coerce Person,
	283	from Dict[first=>Str, last=>Str, years=>Int],
	284	via { +{
	285	name => "$_->{first} $_->{last}",
	286	age=>$_->{years},
	287	}},
	288	from Dict[fullname=>Dict[last=>Str, first=>Str], dob=>DateTime],
	289	via { +{
	290	name => "$_->{fullname}{first} $_->{fullname}{last}",
	291	age => ($_->{dob} - 'DateTime'->now)->years,
	292	}};
	293
	294	has person => (is=>'rw', isa=>Person, coerce=>1);
	295
a30fa891	296	=cut
a30fa891	297
67a8bc04	298	Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
	299	MooseX::Meta::TypeConstraint::Structured->new(
	300	name => "MooseX::Types::Structured::Tuple" ,
	301	parent => find_type_constraint('ArrayRef'),
e327145a	302	constraint_generator=> sub {
67a8bc04	303	## Get the constraints and values to check
e327145a	304	my ($type_constraints, $values) = @_;
	305	my @type_constraints = defined $type_constraints ? @$type_constraints: ();
	306	my @values = defined $values ? @$values: ();
67a8bc04	307	## Perform the checking
	308	while(@type_constraints) {
	309	my $type_constraint = shift @type_constraints;
a30fa891	310	if(@values) {
67a8bc04	311	my $value = shift @values;
	312	unless($type_constraint->check($value)) {
	313	return;
	314	}
	315	} else {
190a34eb	316	unless($type_constraint->check()) {
	317	return;
	318	}
a30fa891	319	}
a30fa891	320	}
67a8bc04	321	## Make sure there are no leftovers.
	322	if(@values) {
	323	return;
	324	} elsif(@type_constraints) {
	325	return;
	326	}else {
	327	return 1;
	328	}
	329	}
	330	)
	331	);
	332
	333	Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
	334	MooseX::Meta::TypeConstraint::Structured->new(
	335	name => "MooseX::Types::Structured::Dict",
	336	parent => find_type_constraint('HashRef'),
e327145a	337	constraint_generator=> sub {
67a8bc04	338	## Get the constraints and values to check
e327145a	339	my ($type_constraints, $values) = @_;
	340	my %type_constraints = defined $type_constraints ? @$type_constraints: ();
	341	my %values = defined $values ? %$values: ();
67a8bc04	342	## Perform the checking
	343	while(%type_constraints) {
	344	my($key, $type_constraint) = each %type_constraints;
	345	delete $type_constraints{$key};
	346	if(exists $values{$key}) {
	347	my $value = $values{$key};
	348	delete $values{$key};
	349	unless($type_constraint->check($value)) {
a30fa891	350	return;
a30fa891	351	}
e327145a	352	} else {
190a34eb	353	unless($type_constraint->check()) {
	354	return;
	355	}
a30fa891	356	}
67a8bc04	357	}
67a8bc04	358	## Make sure there are no leftovers.
e327145a	359	if(%values) {
67a8bc04	360	return;
	361	} elsif(%type_constraints) {
	362	return;
	363	}else {
	364	return 1;
	365	}
	366	},
	367	)
	368	);
d24da8ec	369
e327145a	370	OPTIONAL: {
	371	my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
	372	name => 'MooseX::Types::Structured::Optional',
	373	package_defined_in => __PACKAGE__,
	374	parent => find_type_constraint('Item'),
	375	constraint => sub { 1 },
	376	constraint_generator => sub {
	377	my ($type_parameter, @args) = @_;
	378	my $check = $type_parameter->_compiled_type_constraint();
	379	return sub {
	380	my (@args) = @_;
	381	if(exists($args[0])) {
	382	## If it exists, we need to validate it
	383	$check->($args[0]);
	384	} else {
	385	## But it's is okay if the value doesn't exists
	386	return 1;
	387	}
	388	}
	389	}
	390	);
	391
	392	Moose::Util::TypeConstraints::register_type_constraint($Optional);
	393	Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
	394	}
	395
	396
d24da8ec	397	=head1 SEE ALSO
	398
	399	The following modules or resources may be of interest.
	400
a30fa891	401	L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>,
a30fa891	402	L<MooseX::Meta::TypeConstraint::Structured>
d24da8ec	403
16aea7bf	404	=head1 TODO
	405
	406	Need to clarify deep coercions, need to clarify subtypes of subtypes.
	407
d24da8ec	408	=head1 AUTHOR
	409
	410	John Napiorkowski, C<< <jjnapiork@cpan.org> >>
	411
	412	=head1 COPYRIGHT & LICENSE
	413
	414	This program is free software; you can redistribute it and/or modify
	415	it under the same terms as Perl itself.
	416
	417	=cut
67a8bc04	418
67a8bc04	419	1;