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

package MooseX::Types::Structured;

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.

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