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

package MooseX::Types::Structured;

use 5.008008;
use Moose;
use Moose::Util::TypeConstraints;
use MooseX::Meta::TypeConstraint::Structured;
use MooseX::Types -declare => [qw(Dict Tuple)];

our $VERSION = '0.03';
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 Tuple);

    has name => (isa=>Dict[first_name=>Str, last_name=>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 $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});

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 a list of 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 HashOfInts,
     as Hashref[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']

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=>iIt];
	 
    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,
     from BlessedPersonObject,
     via { +{name=>$_->name, age=>$_->age} },
     from ArrayRef,
     via { +{name=>$_->[0], age=>$_->[1] },
     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}

=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 = @{shift @_};            
			my @values = @{shift @_};
			## 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 {
					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 = @{shift @_};            
			my %values = %{shift @_};
			## 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 {
					return;
				}
			}
			## Make sure there are no leftovers.
			if(%values) {
				return;
			} elsif(%type_constraints) {
				return;
			}else {
				return 1;
			}
		},
	)
);

=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
26cf05a9	3	use 5.008008;
6c2f284c	4	use Moose;
6c2f284c	5	use Moose::Util::TypeConstraints;
a30fa891	6	use MooseX::Meta::TypeConstraint::Structured;
a30fa891	7	use MooseX::Types -declare => [qw(Dict Tuple)];
011bacc6	8
59deb858	9	our $VERSION = '0.03';
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;
	23	use MooseX::Types::Moose qw(Str Int);
	24	use MooseX::Types::Structured qw(Dict Tuple);
	25
	26	has name => (isa=>Dict[first_name=>Str, last_name=>Str]);
	27
6c2f284c	28	Then you can instantiate this class with something like:
6c2f284c	29
af1d00c9	30	my $instance = MyApp::MyClass->new(
6c2f284c	31	name=>{first_name=>'John', last_name=>'Napiorkowski'},
6c2f284c	32	);
d24da8ec	33
6c2f284c	34	But all of these would cause an error:
6c2f284c	35
af1d00c9	36	my $instance = MyApp::MyClass->new(name=>'John');
	37	my $instance = MyApp::MyClass->new(name=>{first_name=>'John'});
	38	my $instance = MyApp::MyClass->new(name=>{first_name=>'John', age=>39});
6c2f284c	39
6c2f284c	40	Please see the test cases for more examples.
d24da8ec	41
	42	=head1 DESCRIPTION
	43
af1d00c9	44	A structured type constraint is a standard container L</Moose> type constraint,
af1d00c9	45	such as an arrayref or hashref, which has been enhanced to allow you to
59deb858	46	explicitly name all the allow type constraints inside the structure. The
af1d00c9	47	generalized form is:
	48
	49	TypeConstraint[TypeParameters]
	50
	51	Where TypeParameters is a list of type constraints.
	52
59deb858	53	This type library enables structured type constraints. It is build on top of the
	54	L<MooseX::Types> library system, so you should review the documentation for that
	55	if you are not familiar with it.
	56
5632ada1	57	=head2 Comparing Parameterized types to Structured types
59deb858	58
	59	Parameterized constraints are built into the core Moose types 'HashRef' and
	60	'ArrayRef'. Structured types have similar functionality, so their syntax is
	61	likewise similar. For example, you could define a parameterized constraint like:
6c2f284c	62
af1d00c9	63	subtype HashOfInts,
af1d00c9	64	as Hashref[Int];
6c2f284c	65
af1d00c9	66	which would constraint a value to something like [1,2,3,...] and so on. On the
59deb858	67	other hand, a structured type constraint explicitly names all it's allowed type
af1d00c9	68	parameter constraints. For the example:
6c2f284c	69
af1d00c9	70	subtype StringFollowedByInt,
af1d00c9	71	as Tuple[Str,Int];
6c2f284c	72
59deb858	73	would constrain it's value to something like ['hello', 111] but ['hello', 'world']
59deb858	74	would fail, as well as ['hello', 111, 'world']
6c2f284c	75
	76	These structures can be as simple or elaborate as you wish. You can even
	77	combine various structured, parameterized and simple constraints all together:
	78
af1d00c9	79	subtype crazy,
	80	as Tuple[
	81	Int,
	82	Dict[name=>Str, age=>Int],
	83	ArrayRef[Int]
	84	];
6c2f284c	85
af1d00c9	86	Which would match "[1, {name=>'John', age=>25},[10,11,12]]". Please notice how
59deb858	87	the type parameters can be visually arranged to your liking and to improve the
	88	clarity of your meaning. You don't need to run then altogether onto a single
	89	line.
	90
	91	=head2 Alternatives
6c2f284c	92
	93	You should exercise some care as to whether or not your complex structured
	94	constraints would be better off contained by a real object as in the following
	95	example:
	96
af1d00c9	97	package MyApp::MyStruct;
	98	use Moose;
	99
	100	has $_ for qw(name age);
	101
	102	package MyApp::MyClass;
	103	use Moose;
	104
	105	has person => (isa=>'MyApp::MyStruct');
	106
	107	my $instance = MyApp::MyClass->new(
	108	person=>MyApp::MyStruct->new(name=>'John', age=>39),
	109	);
6c2f284c	110
	111	This method may take some additional time to setup but will give you more
	112	flexibility. However, structured constraints are highly compatible with this
	113	method, granting some interesting possibilities for coercion. Try:
	114
af1d00c9	115	subtype 'MyStruct',
	116	as 'MyApp::MyStruct';
	117
	118	coerce 'MyStruct',
	119	from (Dict[name=>Str, age=>Int]),
59deb858	120	via { MyApp::MyStruct->new(%$_) },
af1d00c9	121	from (Dict[last_name=>Str, first_name=>Str, dob=>DateTime]),
	122	via {
	123	my $name = $_->{first_name} .' '. $_->{last_name};
	124	my $age = DateTime->now - $_->{dob};
59deb858	125	MyApp::MyStruct->new( name=>$name, age=>$age->years );
af1d00c9	126	};
a4a88fef	127
16aea7bf	128	=head2 Subtyping a structured subtype
	129
	130	You need to exercise some care when you try to subtype a structured type
a4a88fef	131	as in this example:
d24da8ec	132
af1d00c9	133	subtype Person,
af1d00c9	134	as Dict[name=>Str, age=>iIt];
a4a88fef	135
af1d00c9	136	subtype FriendlyPerson,
af1d00c9	137	as Person[name=>Str, age=>Int, totalFriends=>Int];
a4a88fef	138
16aea7bf	139	This will actually work BUT you have to take care that the subtype has a
a4a88fef	140	structure that does not contradict the structure of it's parent. For now the
59deb858	141	above works, but I will clarify the syntax for this at a future point, so
a4a88fef	142	it's recommended to avoid (should not realy be needed so much anyway). For
59deb858	143	now this is supported in an EXPERIMENTAL way. Your thoughts, test cases and
59deb858	144	patches are welcomed for discussion.
16aea7bf	145
	146	=head2 Coercions
	147
	148	Coercions currently work for 'one level' deep. That is you can do:
	149
af1d00c9	150	subtype Person,
16aea7bf	151	as Dict[name=>Str, age=>Int];
af1d00c9	152
16aea7bf	153	subtype Fullname,
16aea7bf	154	as Dict[first=>Str, last=>Str];
af1d00c9	155
	156	coerce Person,
	157	from BlessedPersonObject,
	158	via { +{name=>$_->name, age=>$_->age} },
	159	from ArrayRef,
	160	via { +{name=>$_->[0], age=>$_->[1] },
16aea7bf	161	from Dict[fullname=>Fullname, dob=>DateTime],
16aea7bf	162	via {
af1d00c9	163	my $age = $_->dob - DateTime->now;
	164	+{
	165	name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last},
	166	age=>$age->years
	167	}
16aea7bf	168	};
	169
	170	And that should just work as expected. However, if there are any 'inner'
	171	coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
	172	won't currently get activated.
	173
	174	Please see the test '07-coerce.t' for a more detailed example.
	175
	176	=head1 TYPE CONSTRAINTS
	177
	178	This type library defines the following constraints.
	179
	180	=head2 Tuple[@constraints]
	181
	182	This defines an arrayref based constraint which allows you to validate a specific
	183	list of constraints. For example:
	184
af1d00c9	185	Tuple[Int,Str]; ## Validates [1,'hello']
af1d00c9	186	Tuple[Str\|Object, Int]; ##Validates ['hello', 1] or [$object, 2]
16aea7bf	187
	188	=head2 Dict [%constraints]
	189
	190	This defines a hashref based constraint which allowed you to validate a specific
	191	hashref. For example:
	192
af1d00c9	193	Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
d24da8ec	194
59deb858	195	=head1 EXAMPLES
	196
	197	Here are some additional example usage for structured types. All examples can
	198	be found also in the 't/examples.t' test. Your contributions are also welcomed.
	199
	200	=head2 Normalize a HashRef
	201
	202	You need a hashref to conform to a canonical structure but are required accept a
	203	bunch of different incoming structures. You can normalize using the Dict type
	204	constraint and coercions. This example also shows structured types mixed which
	205	other MooseX::Types libraries.
	206
	207	package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
	208
	209	use Moose;
	210	use DateTime;
	211
	212	use MooseX::Types::Structured qw(Dict Tuple);
	213	use MooseX::Types::DateTime qw(DateTime);
	214	use MooseX::Types::Moose qw(Int Str Object);
	215	use MooseX::Types -declare => [qw(Name Age Person)];
	216
	217	subtype Person,
	218	as Dict[name=>Str, age=>Int];
	219
	220	coerce Person,
	221	from Dict[first=>Str, last=>Str, years=>Int],
	222	via { +{
	223	name => "$_->{first} $_->{last}",
	224	age=>$_->{years},
	225	}},
	226	from Dict[fullname=>Dict[last=>Str, first=>Str], dob=>DateTime],
	227	via { +{
	228	name => "$_->{fullname}{first} $_->{fullname}{last}",
	229	age => ($_->{dob} - 'DateTime'->now)->years,
	230	}};
	231
	232	has person => (is=>'rw', isa=>Person, coerce=>1);
	233
a30fa891	234	=cut
a30fa891	235
67a8bc04	236	Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
	237	MooseX::Meta::TypeConstraint::Structured->new(
	238	name => "MooseX::Types::Structured::Tuple" ,
	239	parent => find_type_constraint('ArrayRef'),
	240	constraint_generator=> sub {
	241	## Get the constraints and values to check
	242	my @type_constraints = @{shift @_};
	243	my @values = @{shift @_};
	244	## Perform the checking
	245	while(@type_constraints) {
	246	my $type_constraint = shift @type_constraints;
a30fa891	247	if(@values) {
67a8bc04	248	my $value = shift @values;
	249	unless($type_constraint->check($value)) {
	250	return;
	251	}
	252	} else {
a30fa891	253	return;
a30fa891	254	}
a30fa891	255	}
67a8bc04	256	## Make sure there are no leftovers.
	257	if(@values) {
	258	return;
	259	} elsif(@type_constraints) {
	260	return;
	261	}else {
	262	return 1;
	263	}
	264	}
	265	)
	266	);
	267
	268	Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
	269	MooseX::Meta::TypeConstraint::Structured->new(
	270	name => "MooseX::Types::Structured::Dict",
	271	parent => find_type_constraint('HashRef'),
	272	constraint_generator=> sub {
	273	## Get the constraints and values to check
	274	my %type_constraints = @{shift @_};
	275	my %values = %{shift @_};
	276	## Perform the checking
	277	while(%type_constraints) {
	278	my($key, $type_constraint) = each %type_constraints;
	279	delete $type_constraints{$key};
	280	if(exists $values{$key}) {
	281	my $value = $values{$key};
	282	delete $values{$key};
	283	unless($type_constraint->check($value)) {
a30fa891	284	return;
a30fa891	285	}
67a8bc04	286	} else {
a30fa891	287	return;
a30fa891	288	}
67a8bc04	289	}
	290	## Make sure there are no leftovers.
	291	if(%values) {
	292	return;
	293	} elsif(%type_constraints) {
	294	return;
	295	}else {
	296	return 1;
	297	}
	298	},
	299	)
	300	);
d24da8ec	301
	302	=head1 SEE ALSO
	303
	304	The following modules or resources may be of interest.
	305
a30fa891	306	L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>,
a30fa891	307	L<MooseX::Meta::TypeConstraint::Structured>
d24da8ec	308
16aea7bf	309	=head1 TODO
	310
	311	Need to clarify deep coercions, need to clarify subtypes of subtypes.
	312
d24da8ec	313	=head1 AUTHOR
	314
	315	John Napiorkowski, C<< <jjnapiork@cpan.org> >>
	316
	317	=head1 COPYRIGHT & LICENSE
	318
	319	This program is free software; you can redistribute it and/or modify
	320	it under the same terms as Perl itself.
	321
	322	=cut
67a8bc04	323
67a8bc04	324	1;