[gitmo/MooseX-Types-Structured.git] / t / constraints.t

BEGIN {
	use strict;
	use warnings;
	use Test::More tests=>42;
	use Test::Exception;
}

{
    package Test::MooseX::Meta::TypeConstraint::Structured;

    use Moose;
    use Moose::Util::TypeConstraints;
    use MooseX::Meta::TypeConstraint::Structured::Named;
    use MooseX::Meta::TypeConstraint::Structured::Positional;

    subtype 'MyString',
     as 'Str',
     where { $_=~m/abc/};

    sub Tuple {
        my ($args, $optional) = @_;
        my @args = @$args;
        my @optional = ref $optional eq 'ARRAY' ? @$optional : ();

        return MooseX::Meta::TypeConstraint::Structured::Positional->new(
            name => 'Tuple',
            parent => find_type_constraint('ArrayRef'),
            package_defined_in => __PACKAGE__,
            signature => [map {
				_normalize_type_constraint($_);
			} @args],
            optional_signature => [map {
				_normalize_type_constraint($_);
			} @optional],
        );
    }

    sub Dict {
        my ($args, $optional) = @_;
        my %args = @$args;
        my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
        
        return MooseX::Meta::TypeConstraint::Structured::Named->new(
            name => 'Dict',
            parent => find_type_constraint('HashRef'),
            package_defined_in => __PACKAGE__,
            signature => {map {
				$_ => _normalize_type_constraint($args{$_});
			} keys %args},
            optional_signature => {map {
				$_ => _normalize_type_constraint($optional{$_});
			} keys %optional},
        );
    }

	sub _normalize_type_constraint {
		my $tc = shift @_;
		if(defined $tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) {
			return $tc;
		} elsif($tc) {
			return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc);
		}
	}

    has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
    has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
    has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);	
	has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
	has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
	has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
    has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
    has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );
    
    has 'crazy' => (
        is=>'rw',
        isa=>Tuple(
            ## First ArrayRef Arg is the required type constraints for the top
            ## level Tuple.
            [
                'Int',
                'MyString',
                ## The third required element is a Dict type constraint, which
                ## itself has two required keys and a third optional key.
                Dict([name=>'Str',age=>'Int'],[visits=>'Int'])
            ],
            ## Second ArrayRef Arg defines the optional constraints for the top
            ## level Tuple.
            [
                'Int',
                ## This Tuple has one required type constraint and two optional.
                Tuple(
                      ['Int'],
                      ['Int','HashRef'],
                ),
            ],        
        )
    );
    
    ##has 'sugered' => ();
}

## Instantiate a new test object

ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
 => 'Instantiated new Record test class.';
 
isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
 => 'Created correct object type.';
 
## Test crazy

lives_ok sub {
    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39}]);
} => 'Set crazy attribute with no optionals used';

is_deeply $record->crazy, [1, 'hello.abc.world', {name=>'John', age=>39}]
 => 'correct values for crazy attributes no optionals';
 
lives_ok sub {
    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]);
} => 'Set crazy attribute with all optionals used';

is_deeply $record->crazy, [1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]
 => 'correct values for crazy attributes all optionals';

lives_ok sub {
    $record->crazy([1,'hello.abc.world', {name=>'John', age=>39},10, [1,2]]);
} => 'Set crazy attribute with some optionals used';

throws_ok sub {
    $record->crazy([1,'hello', 'test.xxx.test']);    
}, qr/Validation failed for 'MyString'/
 => 'Properly failed for bad value in crazy attribute 01';

throws_ok sub {
    $record->crazy([1,'hello.abc.world', {notname=>'John', notage=>39}]);    
}, qr/Validation failed for 'Str'/
 => 'Properly failed for bad value in crazy attribute 02';
 
## Test Tuple type constraint

lives_ok sub {
    $record->tuple([1,'hello', 'test.abc.test']);
} => 'Set tuple attribute without error';

is $record->tuple->[0], 1
 => 'correct set the tuple attribute index 0';

is $record->tuple->[1], 'hello'
 => 'correct set the tuple attribute index 1';

is $record->tuple->[2], 'test.abc.test'
 => 'correct set the tuple attribute index 2';

throws_ok sub {
    $record->tuple([1,'hello', 'test.xxx.test']);    
}, qr/Validation failed for 'MyString'/
 => 'Properly failed for bad value in custom type constraint';
 
throws_ok sub {
    $record->tuple(['asdasd',2, 'test.abc.test']);      
}, qr/Validation failed for 'Int'/
 => 'Got Expected Error for violating constraints';

## Test the Dictionary type constraint
 
lives_ok sub {
    $record->dict({name=>'frith', age=>23});
} => 'Set dict attribute without error';

is $record->dict->{name}, 'frith'
 => 'correct set the dict attribute name';

is $record->dict->{age}, 23
 => 'correct set the dict attribute age';
 
throws_ok sub {
    $record->dict({name=>[1,2,3], age=>'sdfsdfsd'});      
}, qr/Validation failed for 'Str'/
 => 'Got Expected Error for bad value in dict';

## Test tuple_with_maybe

lives_ok sub {
    $record->tuple_with_maybe([1,'hello', 1]);
} => 'Set tuple attribute without error';

throws_ok sub {
    $record->tuple_with_maybe([1,'hello', 'a']);
}, qr/Validation failed for 'Maybe\[Int\]'/
 => 'Properly failed for bad value parameterized constraint';

lives_ok sub {
    $record->tuple_with_maybe([1,'hello']);
} => 'Set tuple attribute without error skipping optional parameter';

## Test Tuple with parameterized type

lives_ok sub {
    $record->tuple_with_param([1,'hello', [1,2,3]]);
} => 'Set tuple attribute without error';

throws_ok sub {
    $record->tuple_with_param([1,'hello', [qw/a b c/]]);
}, qr/Validation failed for 'ArrayRef\[Int\]'/
 => 'Properly failed for bad value parameterized constraint';

## Test dict_with_maybe

lives_ok sub {
    $record->dict_with_maybe({name=>'frith', age=>23});
} => 'Set dict attribute without error';

is $record->dict_with_maybe->{name}, 'frith'
 => 'correct set the dict attribute name';

is $record->dict_with_maybe->{age}, 23
 => 'correct set the dict attribute age';
 
throws_ok sub {
    $record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});      
}, qr/Validation failed for 'Str'/
 => 'Got Expected Error for bad value in dict';

throws_ok sub {
    $record->dict_with_maybe({age=>30});      
}, qr/Validation failed for 'Str'/
 => 'Got Expected Error for missing named parameter';

lives_ok sub {
    $record->dict_with_maybe({name=>'usal'});
} => 'Set dict attribute without error, skipping optional';

## Test dict_with_tuple

lives_ok sub {
    $record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
} => 'Set tuple attribute without error';

throws_ok sub {
    $record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
}, qr/Validation failed for 'Int'/
 => 'Threw error on bad constraint';

## Test optional_tuple

lives_ok sub {
    $record->optional_tuple([1,2,3]);
} => 'Set tuple attribute with optional bits';

is_deeply $record->optional_tuple, [1,2,3]
 => 'correct values set';
 
lives_ok sub {
    $record->optional_tuple([4,5]);
} => 'Set tuple attribute withOUT optional bits';

is_deeply $record->optional_tuple, [4,5]
 => 'correct values set again';
 
throws_ok sub {
    $record->optional_tuple([1,2,'bad']);   
}, qr/Validation failed for 'Int'/
 => 'Properly failed for bad value in optional bit';

# Test optional_dict

lives_ok sub {
    $record->optional_dict({key1=>1,key2=>2});
} => 'Set tuple attribute with optional bits';

is_deeply $record->optional_dict, {key1=>1,key2=>2}
 => 'correct values set';
 
lives_ok sub {
    $record->optional_dict({key1=>3});
} => 'Set tuple attribute withOUT optional bits';

is_deeply $record->optional_dict, {key1=>3}
 => 'correct values set again';
 
throws_ok sub {
    $record->optional_dict({key1=>1,key2=>'bad'});   
}, qr/Validation failed for 'Int'/
 => 'Properly failed for bad value in optional bit';
Commit	Line	Data
65748864	1	BEGIN {
	2	use strict;
	3	use warnings;
0f766471	4	use Test::More tests=>42;
65748864	5	use Test::Exception;
	6	}
	7
	8	{
bc64165b	9	package Test::MooseX::Meta::TypeConstraint::Structured;
65748864	10
	11	use Moose;
	12	use Moose::Util::TypeConstraints;
9a491c80	13	use MooseX::Meta::TypeConstraint::Structured::Named;
9a491c80	14	use MooseX::Meta::TypeConstraint::Structured::Positional;
9a920d27	15
c3abf064	16	subtype 'MyString',
	17	as 'Str',
	18	where { $_=~m/abc/};
9a920d27	19
65748864	20	sub Tuple {
9a491c80	21	my ($args, $optional) = @_;
	22	my @args = @$args;
	23	my @optional = ref $optional eq 'ARRAY' ? @$optional : ();
	24
	25	return MooseX::Meta::TypeConstraint::Structured::Positional->new(
65748864	26	name => 'Tuple',
	27	parent => find_type_constraint('ArrayRef'),
	28	package_defined_in => __PACKAGE__,
8b276dd4	29	signature => [map {
9a920d27	30	_normalize_type_constraint($_);
8b276dd4	31	} @args],
b5f77bd3	32	optional_signature => [map {
	33	_normalize_type_constraint($_);
	34	} @optional],
bc64165b	35	);
bc64165b	36	}
9a920d27	37
bc64165b	38	sub Dict {
9a491c80	39	my ($args, $optional) = @_;
9a491c80	40	my %args = @$args;
6479ca33	41	my %optional = ref $optional eq 'ARRAY' ? @$optional : ();
9a491c80	42
9a491c80	43	return MooseX::Meta::TypeConstraint::Structured::Named->new(
8b276dd4	44	name => 'Dict',
bc64165b	45	parent => find_type_constraint('HashRef'),
bc64165b	46	package_defined_in => __PACKAGE__,
8b276dd4	47	signature => {map {
9a920d27	48	$_ => _normalize_type_constraint($args{$_});
8b276dd4	49	} keys %args},
b5f77bd3	50	optional_signature => {map {
	51	$_ => _normalize_type_constraint($optional{$_});
	52	} keys %optional},
65748864	53	);
65748864	54	}
c3abf064	55
9a920d27	56	sub _normalize_type_constraint {
9a920d27	57	my $tc = shift @_;
0f766471	58	if(defined $tc && blessed $tc && $tc->isa('Moose::Meta::TypeConstraint')) {
9a920d27	59	return $tc;
	60	} elsif($tc) {
	61	return Moose::Util::TypeConstraints::find_or_parse_type_constraint($tc);
	62	}
	63	}
	64
c3abf064	65	has 'tuple' => (is=>'rw', isa=>Tuple['Int', 'Str', 'MyString']);
bc64165b	66	has 'dict' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Int']);
8b276dd4	67	has 'dict_with_maybe' => (is=>'rw', isa=>Dict[name=>'Str', age=>'Maybe[Int]']);
	68	has 'tuple_with_param' => (is=>'rw', isa=>Tuple['Int', 'Str', 'ArrayRef[Int]']);
	69	has 'tuple_with_maybe' => (is=>'rw', isa=>Tuple['Int', 'Str', 'Maybe[Int]']);
9a920d27	70	has 'dict_with_tuple' => (is=>'rw', isa=>Dict[key1=>'Str', key2=>Tuple['Int','Str']]);
b5f77bd3	71	has 'optional_tuple' => (is=>'rw', isa=>Tuple(['Int', 'Int'],['Int']) );
0f766471	72	has 'optional_dict' => (is=>'rw', isa=>Dict([key1=>'Int'],[key2=>'Int']) );
	73
	74	has 'crazy' => (
	75	is=>'rw',
	76	isa=>Tuple(
	77	## First ArrayRef Arg is the required type constraints for the top
	78	## level Tuple.
	79	[
	80	'Int',
	81	'MyString',
	82	## The third required element is a Dict type constraint, which
	83	## itself has two required keys and a third optional key.
	84	Dict([name=>'Str',age=>'Int'],[visits=>'Int'])
	85	],
	86	## Second ArrayRef Arg defines the optional constraints for the top
	87	## level Tuple.
	88	[
	89	'Int',
	90	## This Tuple has one required type constraint and two optional.
	91	Tuple(
	92	['Int'],
	93	['Int','HashRef'],
	94	),
	95	],
	96	)
	97	);
	98
	99	##has 'sugered' => ();
65748864	100	}
	101
	102	## Instantiate a new test object
	103
bc64165b	104	ok my $record = Test::MooseX::Meta::TypeConstraint::Structured->new
65748864	105	=> 'Instantiated new Record test class.';
65748864	106
bc64165b	107	isa_ok $record => 'Test::MooseX::Meta::TypeConstraint::Structured'
65748864	108	=> 'Created correct object type.';
0f766471	109
	110	## Test crazy
	111
	112	lives_ok sub {
	113	$record->crazy([1,'hello.abc.world', {name=>'John', age=>39}]);
	114	} => 'Set crazy attribute with no optionals used';
	115
	116	is_deeply $record->crazy, [1, 'hello.abc.world', {name=>'John', age=>39}]
	117	=> 'correct values for crazy attributes no optionals';
	118
	119	lives_ok sub {
	120	$record->crazy([1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]);
	121	} => 'Set crazy attribute with all optionals used';
	122
	123	is_deeply $record->crazy, [1,'hello.abc.world', {name=>'John', age=>39, visits=>10},10, [1,2,{key=>'value'}]]
	124	=> 'correct values for crazy attributes all optionals';
b5f77bd3	125
0f766471	126	lives_ok sub {
	127	$record->crazy([1,'hello.abc.world', {name=>'John', age=>39},10, [1,2]]);
	128	} => 'Set crazy attribute with some optionals used';
	129
	130	throws_ok sub {
	131	$record->crazy([1,'hello', 'test.xxx.test']);
	132	}, qr/Validation failed for 'MyString'/
	133	=> 'Properly failed for bad value in crazy attribute 01';
	134
	135	throws_ok sub {
	136	$record->crazy([1,'hello.abc.world', {notname=>'John', notage=>39}]);
	137	}, qr/Validation failed for 'Str'/
	138	=> 'Properly failed for bad value in crazy attribute 02';
	139
bc64165b	140	## Test Tuple type constraint
bc64165b	141
65748864	142	lives_ok sub {
c3abf064	143	$record->tuple([1,'hello', 'test.abc.test']);
65748864	144	} => 'Set tuple attribute without error';
	145
	146	is $record->tuple->[0], 1
	147	=> 'correct set the tuple attribute index 0';
	148
	149	is $record->tuple->[1], 'hello'
	150	=> 'correct set the tuple attribute index 1';
	151
c3abf064	152	is $record->tuple->[2], 'test.abc.test'
	153	=> 'correct set the tuple attribute index 2';
	154
	155	throws_ok sub {
	156	$record->tuple([1,'hello', 'test.xxx.test']);
	157	}, qr/Validation failed for 'MyString'/
	158	=> 'Properly failed for bad value in custom type constraint';
	159
65748864	160	throws_ok sub {
c3abf064	161	$record->tuple(['asdasd',2, 'test.abc.test']);
65748864	162	}, qr/Validation failed for 'Int'/
	163	=> 'Got Expected Error for violating constraints';
	164
bc64165b	165	## Test the Dictionary type constraint
	166
	167	lives_ok sub {
	168	$record->dict({name=>'frith', age=>23});
	169	} => 'Set dict attribute without error';
	170
	171	is $record->dict->{name}, 'frith'
	172	=> 'correct set the dict attribute name';
	173
	174	is $record->dict->{age}, 23
	175	=> 'correct set the dict attribute age';
	176
	177	throws_ok sub {
	178	$record->dict({name=>[1,2,3], age=>'sdfsdfsd'});
	179	}, qr/Validation failed for 'Str'/
	180	=> 'Got Expected Error for bad value in dict';
8b276dd4	181
	182	## Test tuple_with_maybe
	183
	184	lives_ok sub {
	185	$record->tuple_with_maybe([1,'hello', 1]);
	186	} => 'Set tuple attribute without error';
	187
	188	throws_ok sub {
	189	$record->tuple_with_maybe([1,'hello', 'a']);
	190	}, qr/Validation failed for 'Maybe\[Int\]'/
	191	=> 'Properly failed for bad value parameterized constraint';
	192
	193	lives_ok sub {
	194	$record->tuple_with_maybe([1,'hello']);
	195	} => 'Set tuple attribute without error skipping optional parameter';
	196
	197	## Test Tuple with parameterized type
	198
	199	lives_ok sub {
	200	$record->tuple_with_param([1,'hello', [1,2,3]]);
	201	} => 'Set tuple attribute without error';
	202
	203	throws_ok sub {
	204	$record->tuple_with_param([1,'hello', [qw/a b c/]]);
	205	}, qr/Validation failed for 'ArrayRef\[Int\]'/
	206	=> 'Properly failed for bad value parameterized constraint';
	207
	208	## Test dict_with_maybe
	209
	210	lives_ok sub {
	211	$record->dict_with_maybe({name=>'frith', age=>23});
	212	} => 'Set dict attribute without error';
	213
	214	is $record->dict_with_maybe->{name}, 'frith'
	215	=> 'correct set the dict attribute name';
	216
	217	is $record->dict_with_maybe->{age}, 23
	218	=> 'correct set the dict attribute age';
	219
	220	throws_ok sub {
	221	$record->dict_with_maybe({name=>[1,2,3], age=>'sdfsdfsd'});
	222	}, qr/Validation failed for 'Str'/
	223	=> 'Got Expected Error for bad value in dict';
	224
	225	throws_ok sub {
	226	$record->dict_with_maybe({age=>30});
	227	}, qr/Validation failed for 'Str'/
	228	=> 'Got Expected Error for missing named parameter';
	229
	230	lives_ok sub {
	231	$record->dict_with_maybe({name=>'usal'});
	232	} => 'Set dict attribute without error, skipping optional';
9a920d27	233
	234	## Test dict_with_tuple
	235
	236	lives_ok sub {
	237	$record->dict_with_tuple({key1=>'Hello', key2=>[1,'World']});
	238	} => 'Set tuple attribute without error';
	239
	240	throws_ok sub {
	241	$record->dict_with_tuple({key1=>'Hello', key2=>['World',2]});
	242	}, qr/Validation failed for 'Int'/
	243	=> 'Threw error on bad constraint';
	244
b5f77bd3	245	## Test optional_tuple
9a920d27	246
b5f77bd3	247	lives_ok sub {
	248	$record->optional_tuple([1,2,3]);
	249	} => 'Set tuple attribute with optional bits';
	250
	251	is_deeply $record->optional_tuple, [1,2,3]
	252	=> 'correct values set';
	253
	254	lives_ok sub {
	255	$record->optional_tuple([4,5]);
	256	} => 'Set tuple attribute withOUT optional bits';
	257
	258	is_deeply $record->optional_tuple, [4,5]
	259	=> 'correct values set again';
	260
	261	throws_ok sub {
	262	$record->optional_tuple([1,2,'bad']);
	263	}, qr/Validation failed for 'Int'/
	264	=> 'Properly failed for bad value in optional bit';
9a920d27	265
6479ca33	266	# Test optional_dict
	267
	268	lives_ok sub {
	269	$record->optional_dict({key1=>1,key2=>2});
	270	} => 'Set tuple attribute with optional bits';
	271
	272	is_deeply $record->optional_dict, {key1=>1,key2=>2}
	273	=> 'correct values set';
	274
	275	lives_ok sub {
	276	$record->optional_dict({key1=>3});
	277	} => 'Set tuple attribute withOUT optional bits';
	278
	279	is_deeply $record->optional_dict, {key1=>3}
	280	=> 'correct values set again';
	281
	282	throws_ok sub {
	283	$record->optional_dict({key1=>1,key2=>'bad'});
	284	}, qr/Validation failed for 'Int'/
	285	=> 'Properly failed for bad value in optional bit';
	286
	287
	288