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

package MooseX::Types::Structured;

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