1package Type::Tiny;
2
3use 5.006001;
4use strict;
5use warnings;
6
7BEGIN {
8	if ( $] < 5.008 ) { require Devel::TypeTiny::Perl56Compat }
9	if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat }
10}
11
12BEGIN {
13	$Type::Tiny::AUTHORITY  = 'cpan:TOBYINK';
14	$Type::Tiny::VERSION    = '1.012004';
15	$Type::Tiny::XS_VERSION = '0.016';
16}
17
18$Type::Tiny::VERSION    =~ tr/_//d;
19$Type::Tiny::XS_VERSION =~ tr/_//d;
20
21use Scalar::Util qw( blessed );
22use Types::TypeTiny ();
23
24sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }
25
26sub _swap { $_[2] ? @_[ 1, 0 ] : @_[ 0, 1 ] }
27
28BEGIN {
29	my $support_smartmatch = 0+ !!( $] >= 5.010001 );
30	eval qq{ sub SUPPORT_SMARTMATCH () { !! $support_smartmatch } };
31
32	my $fixed_precedence = 0+ !!( $] >= 5.014 );
33	eval qq{ sub _FIXED_PRECEDENCE () { !! $fixed_precedence } };
34
35	my $try_xs =
36		exists( $ENV{PERL_TYPE_TINY_XS} ) ? !!$ENV{PERL_TYPE_TINY_XS}
37		: exists( $ENV{PERL_ONLY} )       ? !$ENV{PERL_ONLY}
38		:                                   1;
39
40	my $use_xs = 0;
41	$try_xs and eval {
42		require Type::Tiny::XS;
43		'Type::Tiny::XS'->VERSION( $Type::Tiny::XS_VERSION );
44		$use_xs++;
45	};
46
47	*_USE_XS =
48		$use_xs
49		? sub () { !!1 }
50		: sub () { !!0 };
51
52	*_USE_MOUSE =
53		$try_xs
54		? sub () { $INC{'Mouse/Util.pm'} and Mouse::Util::MOUSE_XS() }
55		: sub () { !!0 };
56} #/ BEGIN
57
58{
59
60	sub _install_overloads {
61		no strict 'refs';
62		no warnings 'redefine', 'once';
63
64		# Coverage is checked on Perl 5.26
65		if ( $] < 5.010 ) {    # uncoverable statement
66			require overload;             # uncoverable statement
67			push @_, fallback => 1;       # uncoverable statement
68			goto \&overload::OVERLOAD;    # uncoverable statement
69		}
70
71		my $class = shift;
72		*{ $class . '::((' } = sub { };
73		*{ $class . '::()' } = sub { };
74		*{ $class . '::()' } = do { my $x = 1; \$x };
75		while ( @_ ) {
76			my $f = shift;
77			*{ $class . '::(' . $f } = ref $_[0] ? shift : do {
78				my $m = shift;
79				sub { shift->$m( @_ ) }
80			};
81		}
82	} #/ sub _install_overloads
83}
84
85__PACKAGE__->_install_overloads(
86	q("") => sub {
87		caller =~ m{^(Moo::HandleMoose|Sub::Quote)}
88			? $_[0]->_stringify_no_magic
89			: $_[0]->display_name;
90	},
91	q(bool) => sub { 1 },
92	q(&{})  => "_overload_coderef",
93	q(|)    => sub {
94		my @tc = _swap @_;
95		if ( !_FIXED_PRECEDENCE && $_[2] ) {
96			if ( blessed $tc[0] ) {
97				if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) {
98					my $type  = $tc[0]->{type};
99					my $param = $tc[0]->{param};
100					my $op    = $tc[0]->{op};
101					require Type::Tiny::Union;
102					return "Type::Tiny::_HalfOp"->new(
103						$op,
104						$param,
105						"Type::Tiny::Union"->new( type_constraints => [ $type, $tc[1] ] ),
106					);
107				} #/ if ( blessed $tc[0] eq...)
108			} #/ if ( blessed $tc[0] )
109			elsif ( ref $tc[0] eq 'ARRAY' ) {
110				require Type::Tiny::_HalfOp;
111				return "Type::Tiny::_HalfOp"->new( '|', @tc );
112			}
113		} #/ if ( !_FIXED_PRECEDENCE...)
114		require Type::Tiny::Union;
115		return "Type::Tiny::Union"->new( type_constraints => \@tc );
116	},
117	q(&) => sub {
118		my @tc = _swap @_;
119		if ( !_FIXED_PRECEDENCE && $_[2] ) {
120			if ( blessed $tc[0] ) {
121				if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) {
122					my $type  = $tc[0]->{type};
123					my $param = $tc[0]->{param};
124					my $op    = $tc[0]->{op};
125					require Type::Tiny::Intersection;
126					return "Type::Tiny::_HalfOp"->new(
127						$op,
128						$param,
129						"Type::Tiny::Intersection"->new( type_constraints => [ $type, $tc[1] ] ),
130					);
131				} #/ if ( blessed $tc[0] eq...)
132			} #/ if ( blessed $tc[0] )
133			elsif ( ref $tc[0] eq 'ARRAY' ) {
134				require Type::Tiny::_HalfOp;
135				return "Type::Tiny::_HalfOp"->new( '&', @tc );
136			}
137		} #/ if ( !_FIXED_PRECEDENCE...)
138		require Type::Tiny::Intersection;
139		"Type::Tiny::Intersection"->new( type_constraints => \@tc );
140	},
141	q(~)  => sub { shift->complementary_type },
142	q(==) => sub { $_[0]->equals( $_[1] ) },
143	q(!=) => sub { not $_[0]->equals( $_[1] ) },
144	q(<)  => sub { my $m = $_[0]->can( 'is_subtype_of' ); $m->( _swap @_ ) },
145	q(>)  => sub {
146		my $m = $_[0]->can( 'is_subtype_of' );
147		$m->( reverse _swap @_ );
148	},
149	q(<=) => sub { my $m = $_[0]->can( 'is_a_type_of' ); $m->( _swap @_ ) },
150	q(>=) => sub {
151		my $m = $_[0]->can( 'is_a_type_of' );
152		$m->( reverse _swap @_ );
153	},
154	q(eq)  => sub { "$_[0]" eq "$_[1]" },
155	q(cmp) => sub { $_[2] ? ( "$_[1]" cmp "$_[0]" ) : ( "$_[0]" cmp "$_[1]" ) },
156);
157
158__PACKAGE__->_install_overloads(
159	q(~~) => sub { $_[0]->check( $_[1] ) },
160) if Type::Tiny::SUPPORT_SMARTMATCH;
161
162# Would be easy to just return sub { $self->assert_return(@_) }
163# but try to build a more efficient coderef whenever possible.
164#
165sub _overload_coderef {
166	my $self = shift;
167
168	# Bypass generating a coderef if we've already got the best possible one.
169	#
170	return $self->{_overload_coderef} if $self->{_overload_coderef_no_rebuild};
171
172	# Subclasses of Type::Tiny might override assert_return to do some kind
173	# of interesting thing. In that case, we can't rely on it having identical
174	# behaviour to Type::Tiny::inline_assert.
175	#
176	$self->{_overrides_assert_return} =
177		( $self->can( 'assert_return' ) != \&assert_return )
178		unless exists $self->{_overrides_assert_return};
179
180	if ( $self->{_overrides_assert_return} ) {
181		$self->{_overload_coderef} ||= do {
182			Scalar::Util::weaken( my $weak = $self );
183			sub { $weak->assert_return( @_ ) };
184		};
185		++$self->{_overload_coderef_no_rebuild};
186	}
187	elsif ( exists( &Sub::Quote::quote_sub ) ) {
188
189		# Use `=` instead of `||=` because we want to overwrite non-Sub::Quote
190		# coderef if possible.
191		$self->{_overload_coderef} = $self->can_be_inlined
192			? Sub::Quote::quote_sub(
193			$self->inline_assert( '$_[0]' ),
194			)
195			: Sub::Quote::quote_sub(
196			$self->inline_assert( '$_[0]', '$type' ),
197			{ '$type' => \$self },
198			);
199		++$self->{_overload_coderef_no_rebuild};
200	} #/ elsif ( exists( &Sub::Quote::quote_sub...))
201	else {
202		require Eval::TypeTiny;
203		$self->{_overload_coderef} ||= $self->can_be_inlined
204			? Eval::TypeTiny::eval_closure(
205			source => sprintf(
206				'sub { %s }', $self->inline_assert( '$_[0]', undef, no_wrapper => 1 )
207			),
208			description => sprintf( "compiled assertion 'assert_%s'", $self ),
209			)
210			: Eval::TypeTiny::eval_closure(
211			source => sprintf(
212				'sub { %s }', $self->inline_assert( '$_[0]', '$type', no_wrapper => 1 )
213			),
214			description => sprintf( "compiled assertion 'assert_%s'", $self ),
215			environment => { '$type' => \$self },
216			);
217	} #/ else [ if ( $self->{_overrides_assert_return...})]
218
219	$self->{_overload_coderef};
220} #/ sub _overload_coderef
221
222our %ALL_TYPES;
223
224my $QFS;
225my $uniq = 1;
226my $subname;
227
228sub new {
229	my $class  = shift;
230	my %params = ( @_ == 1 ) ? %{ $_[0] } : @_;
231
232	for ( qw/ name display_name library / ) {
233		$params{$_} = $params{$_} . '' if defined $params{$_};
234	}
235
236	if ( exists $params{parent} ) {
237		$params{parent} =
238			ref( $params{parent} ) =~ /^Type::Tiny\b/
239			? $params{parent}
240			: Types::TypeTiny::to_TypeTiny( $params{parent} );
241
242		_croak "Parent must be an instance of %s", __PACKAGE__
243			unless blessed( $params{parent} )
244			&& $params{parent}->isa( __PACKAGE__ );
245
246		if ( $params{parent}->deprecated and not exists $params{deprecated} ) {
247			$params{deprecated} = 1;
248		}
249	} #/ if ( exists $params{parent...})
250
251	if ( exists $params{constraint}
252		and defined $params{constraint}
253		and not ref $params{constraint} )
254	{
255		require Eval::TypeTiny;
256		my $code = $params{constraint};
257		$params{constraint} = Eval::TypeTiny::eval_closure(
258			source      => sprintf( 'sub ($) { %s }', $code ),
259			description => "anonymous check",
260		);
261		$params{inlined} ||= sub {
262			my ( $type ) = @_;
263			my $inlined  = $_ eq '$_' ? "do { $code }" : "do { local \$_ = $_; $code }";
264			$type->has_parent ? ( undef, $inlined ) : $inlined;
265			}
266			if ( !exists $params{parent} or $params{parent}->can_be_inlined );
267	} #/ if ( exists $params{constraint...})
268
269	# canonicalize to a boolean
270	$params{deprecated} = !!$params{deprecated};
271
272	$params{name} = "__ANON__" unless exists $params{name};
273	$params{uniq} = $uniq++;
274
275	if ( $params{name} ne "__ANON__" ) {
276
277		# First try a fast ASCII-only expression, but fall back to Unicode
278		$params{name} =~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm
279			or eval q( use 5.008; $params{name} =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm )
280			or _croak '"%s" is not a valid type name', $params{name};
281	}
282
283	if ( exists $params{coercion} and !ref $params{coercion} and $params{coercion} )
284	{
285		$params{parent}->has_coercion
286			or _croak
287			"coercion => 1 requires type to have a direct parent with a coercion";
288
289		$params{coercion} = $params{parent}->coercion->type_coercion_map;
290	}
291
292	if ( !exists $params{inlined}
293		and exists $params{constraint}
294		and ( !exists $params{parent} or $params{parent}->can_be_inlined )
295		and $QFS ||= "Sub::Quote"->can( "quoted_from_sub" ) )
296	{
297		my ( undef, $perlstring, $captures ) = @{ $QFS->( $params{constraint} ) || [] };
298
299		$params{inlined} = sub {
300			my ( $self, $var ) = @_;
301			my $code = Sub::Quote::inlinify(
302				$perlstring,
303				$var,
304				$var eq q($_) ? '' : "local \$_ = $var;",
305				1,
306			);
307			$code = sprintf( '%s and %s', $self->parent->inline_check( $var ), $code )
308				if $self->has_parent;
309			return $code;
310			}
311			if $perlstring && !$captures;
312	} #/ if ( !exists $params{inlined...})
313
314	my $self = bless \%params, $class;
315
316	unless ( $params{tmp} ) {
317		my $uniq = $self->{uniq};
318
319		$ALL_TYPES{$uniq} = $self;
320		Scalar::Util::weaken( $ALL_TYPES{$uniq} );
321
322		my $tmp = $self;
323		Scalar::Util::weaken( $tmp );
324		$Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } = sub { $tmp };
325	} #/ unless ( $params{tmp} )
326
327	if ( ref( $params{coercion} ) eq q(CODE) ) {
328		require Types::Standard;
329		my $code = delete( $params{coercion} );
330		$self->{coercion} = $self->_build_coercion;
331		$self->coercion->add_type_coercions( Types::Standard::Any(), $code );
332	}
333	elsif ( ref( $params{coercion} ) eq q(ARRAY) ) {
334		my $arr = delete( $params{coercion} );
335		$self->{coercion} = $self->_build_coercion;
336		$self->coercion->add_type_coercions( @$arr );
337	}
338
339	# Documenting this here because it's too weird to be in the pod.
340	# There's a secret attribute called "_build_coercion" which takes a
341	# coderef. If present, then when $type->coercion is lazy built,
342	# the blank Type::Coercion object gets passed to the coderef,
343	# allowing the coderef to manipulate it a little. This is used by
344	# Types::TypeTiny to allow it to build a coercion for the TypeTiny
345	# type constraint without needing to load Type::Coercion yet.
346
347	if ( $params{my_methods} ) {
348		$subname =
349			eval   { require Sub::Util } ? \&Sub::Util::set_subname
350			: eval { require Sub::Name } ? \&Sub::Name::subname
351			: 0
352			if not defined $subname;
353		if ( $subname ) {
354			( Scalar::Util::reftype( $params{my_methods}{$_} ) eq 'CODE' ) && $subname->(
355				sprintf( "%s::my_%s", $self->qualified_name, $_ ),
356				$params{my_methods}{$_},
357			) for keys %{ $params{my_methods} };
358		}
359	} #/ if ( $params{my_methods...})
360
361	return $self;
362} #/ sub new
363
364sub DESTROY {
365	my $self = shift;
366	delete( $ALL_TYPES{ $self->{uniq} } );
367	delete( $Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } );
368	return;
369}
370
371sub _clone {
372	my $self = shift;
373	my %opts;
374	$opts{$_} = $self->{$_} for qw< name display_name message >;
375	$self->create_child_type( %opts );
376}
377
378sub _stringify_no_magic {
379	sprintf(
380		'%s=%s(0x%08x)', blessed( $_[0] ), Scalar::Util::reftype( $_[0] ),
381		Scalar::Util::refaddr( $_[0] )
382	);
383}
384
385our $DD;
386
387sub _dd {
388	@_ = $_ unless @_;
389	my ( $value ) = @_;
390
391	goto $DD if ref( $DD ) eq q(CODE);
392
393	require B;
394
395	!defined $value  ? 'Undef'
396		: !ref $value ? sprintf( 'Value %s', B::perlstring( $value ) )
397		: do {
398		my $N = 0+ ( defined( $DD ) ? $DD : 72 );
399		require Data::Dumper;
400		local $Data::Dumper::Indent   = 0;
401		local $Data::Dumper::Useqq    = 1;
402		local $Data::Dumper::Terse    = 1;
403		local $Data::Dumper::Sortkeys = 1;
404		local $Data::Dumper::Maxdepth = 2;
405		my $str;
406		eval {
407			$str = Data::Dumper::Dumper( $value );
408			$str = substr( $str, 0, $N - 12 ) . '...' . substr( $str, -1, 1 )
409				if length( $str ) >= $N;
410			1;
411		} or do { $str = 'which cannot be dumped' };
412		"Reference $str";
413	} #/ do
414} #/ sub _dd
415
416sub _loose_to_TypeTiny {
417	map +(
418		ref( $_ )
419		? Types::TypeTiny::to_TypeTiny( $_ )
420		: do { require Type::Utils; Type::Utils::dwim_type( $_ ) }
421	), @_;
422}
423
424sub name         { $_[0]{name} }
425sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name }
426sub parent       { $_[0]{parent} }
427sub constraint   { $_[0]{constraint} ||= $_[0]->_build_constraint }
428
429sub compiled_check {
430	$_[0]{compiled_type_constraint} ||= $_[0]->_build_compiled_check;
431}
432sub coercion             { $_[0]{coercion} ||= $_[0]->_build_coercion }
433sub message              { $_[0]{message} }
434sub library              { $_[0]{library} }
435sub inlined              { $_[0]{inlined} }
436sub deprecated           { $_[0]{deprecated} }
437sub constraint_generator { $_[0]{constraint_generator} }
438sub inline_generator     { $_[0]{inline_generator} }
439sub name_generator { $_[0]{name_generator} ||= $_[0]->_build_name_generator }
440sub coercion_generator { $_[0]{coercion_generator} }
441sub parameters         { $_[0]{parameters} }
442sub moose_type         { $_[0]{moose_type} ||= $_[0]->_build_moose_type }
443sub mouse_type         { $_[0]{mouse_type} ||= $_[0]->_build_mouse_type }
444sub deep_explanation   { $_[0]{deep_explanation} }
445sub my_methods         { $_[0]{my_methods} ||= $_[0]->_build_my_methods }
446sub sorter             { $_[0]{sorter} }
447
448sub has_parent               { exists $_[0]{parent} }
449sub has_library              { exists $_[0]{library} }
450sub has_inlined              { exists $_[0]{inlined} }
451sub has_constraint_generator { exists $_[0]{constraint_generator} }
452sub has_inline_generator     { exists $_[0]{inline_generator} }
453sub has_coercion_generator   { exists $_[0]{coercion_generator} }
454sub has_parameters           { exists $_[0]{parameters} }
455sub has_message              { defined $_[0]{message} }
456sub has_deep_explanation     { exists $_[0]{deep_explanation} }
457sub has_sorter               { exists $_[0]{sorter} }
458
459sub _default_message {
460	$_[0]{_default_message} ||= $_[0]->_build_default_message;
461}
462
463sub has_coercion {
464	$_[0]->coercion if $_[0]{_build_coercion};    # trigger auto build thing
465	$_[0]{coercion} and !!@{ $_[0]{coercion}->type_coercion_map };
466}
467
468sub _assert_coercion {
469	my $self = shift;
470	return $self->coercion if $self->{_build_coercion};    # trigger auto build thing
471	_croak "No coercion for this type constraint"
472		unless $self->has_coercion
473		&& @{ $self->coercion->type_coercion_map };
474	$self->coercion;
475}
476
477my $null_constraint = sub { !!1 };
478
479sub _build_display_name {
480	shift->name;
481}
482
483sub _build_constraint {
484	return $null_constraint;
485}
486
487sub _is_null_constraint {
488	shift->constraint == $null_constraint;
489}
490
491sub _build_coercion {
492	require Type::Coercion;
493	my $self = shift;
494	my %opts = ( type_constraint => $self );
495	$opts{display_name} = "to_$self" unless $self->is_anon;
496	my $coercion = "Type::Coercion"->new( %opts );
497	$self->{_build_coercion}->( $coercion ) if ref $self->{_build_coercion};
498	$coercion;
499}
500
501sub _build_default_message {
502	my $self = shift;
503	$self->{is_using_default_message} = 1;
504	return sub { sprintf '%s did not pass type constraint', _dd( $_[0] ) }
505		if "$self" eq "__ANON__";
506	my $name = "$self";
507	return sub {
508		sprintf '%s did not pass type constraint "%s"', _dd( $_[0] ), $name;
509	};
510} #/ sub _build_default_message
511
512sub _build_name_generator {
513	my $self = shift;
514	return sub {
515		my ( $s, @a ) = @_;
516		sprintf( '%s[%s]', $s, join q[,], @a );
517	};
518}
519
520sub _build_compiled_check {
521	my $self = shift;
522
523	local our $AvoidCallbacks = 0;
524
525	if ( $self->_is_null_constraint and $self->has_parent ) {
526		return $self->parent->compiled_check;
527	}
528
529	require Eval::TypeTiny;
530	return Eval::TypeTiny::eval_closure(
531		source      => sprintf( 'sub ($) { %s }',      $self->inline_check( '$_[0]' ) ),
532		description => sprintf( "compiled check '%s'", $self ),
533	) if $self->can_be_inlined;
534
535	my @constraints;
536	push @constraints, $self->parent->compiled_check if $self->has_parent;
537	push @constraints, $self->constraint             if !$self->_is_null_constraint;
538	return $null_constraint unless @constraints;
539
540	return sub ($) {
541		local $_ = $_[0];
542		for my $c ( @constraints ) {
543			return unless $c->( @_ );
544		}
545		return !!1;
546	};
547} #/ sub _build_compiled_check
548
549sub find_constraining_type {
550	my $self = shift;
551	if ( $self->_is_null_constraint and $self->has_parent ) {
552		return $self->parent->find_constraining_type;
553	}
554	$self;
555}
556
557our @CMP;
558
559sub CMP_SUPERTYPE ()  { -1 }
560sub CMP_EQUAL ()      { 0 }
561sub CMP_EQUIVALENT () { '0E0' }
562sub CMP_SUBTYPE ()    { 1 }
563sub CMP_UNKNOWN ()    { ''; }
564
565# avoid getting mixed up with cmp operator at compile time
566*cmp = sub {
567	my ( $A, $B ) = _loose_to_TypeTiny( $_[0], $_[1] );
568	return unless blessed( $A ) && $A->isa( "Type::Tiny" );
569	return unless blessed( $B ) && $B->isa( "Type::Tiny" );
570	for my $comparator ( @CMP ) {
571		my $result = $comparator->( $A, $B );
572		next if $result eq CMP_UNKNOWN;
573		if ( $result eq CMP_EQUIVALENT ) {
574			my $prefer = @_ == 3 ? $_[2] : CMP_EQUAL;
575			return $prefer;
576		}
577		return $result;
578	}
579	return CMP_UNKNOWN;
580};
581
582push @CMP, sub {
583	my ( $A, $B ) = @_;
584	return CMP_EQUAL
585		if Scalar::Util::refaddr( $A ) == Scalar::Util::refaddr( $B );
586
587	return CMP_EQUIVALENT
588		if Scalar::Util::refaddr( $A->compiled_check ) ==
589		Scalar::Util::refaddr( $B->compiled_check );
590
591	my $A_stem = $A->find_constraining_type;
592	my $B_stem = $B->find_constraining_type;
593	return CMP_EQUIVALENT
594		if Scalar::Util::refaddr( $A_stem ) == Scalar::Util::refaddr( $B_stem );
595	return CMP_EQUIVALENT
596		if Scalar::Util::refaddr( $A_stem->compiled_check ) ==
597		Scalar::Util::refaddr( $B_stem->compiled_check );
598
599	if ( $A_stem->can_be_inlined and $B_stem->can_be_inlined ) {
600		return 0
601			if $A_stem->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' );
602	}
603
604	A_IS_SUBTYPE: {
605		my $A_prime = $A_stem;
606		while ( $A_prime->has_parent ) {
607			$A_prime = $A_prime->parent;
608			return CMP_SUBTYPE
609				if Scalar::Util::refaddr( $A_prime ) == Scalar::Util::refaddr( $B_stem );
610			return CMP_SUBTYPE
611				if Scalar::Util::refaddr( $A_prime->compiled_check ) ==
612				Scalar::Util::refaddr( $B_stem->compiled_check );
613			if ( $A_prime->can_be_inlined and $B_stem->can_be_inlined ) {
614				return CMP_SUBTYPE
615					if $A_prime->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' );
616			}
617		} #/ while ( $A_prime->has_parent)
618	} #/ A_IS_SUBTYPE:
619
620	B_IS_SUBTYPE: {
621		my $B_prime = $B_stem;
622		while ( $B_prime->has_parent ) {
623			$B_prime = $B_prime->parent;
624			return CMP_SUPERTYPE
625				if Scalar::Util::refaddr( $B_prime ) == Scalar::Util::refaddr( $A_stem );
626			return CMP_SUPERTYPE
627				if Scalar::Util::refaddr( $B_prime->compiled_check ) ==
628				Scalar::Util::refaddr( $A_stem->compiled_check );
629			if ( $A_stem->can_be_inlined and $B_prime->can_be_inlined ) {
630				return CMP_SUPERTYPE
631					if $B_prime->inline_check( '$WOLFIE' ) eq $A_stem->inline_check( '$WOLFIE' );
632			}
633		} #/ while ( $B_prime->has_parent)
634	} #/ B_IS_SUBTYPE:
635
636	return CMP_UNKNOWN;
637};
638
639sub equals {
640	my $result = Type::Tiny::cmp( $_[0], $_[1] );
641	return unless defined $result;
642	$result eq CMP_EQUAL;
643}
644
645sub is_subtype_of {
646	my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE );
647	return unless defined $result;
648	$result eq CMP_SUBTYPE;
649}
650
651sub is_supertype_of {
652	my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE );
653	return unless defined $result;
654	$result eq CMP_SUPERTYPE;
655}
656
657sub is_a_type_of {
658	my $result = Type::Tiny::cmp( $_[0], $_[1] );
659	return unless defined $result;
660	$result eq CMP_SUBTYPE or $result eq CMP_EQUAL or $result eq CMP_EQUIVALENT;
661}
662
663sub strictly_equals {
664	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
665	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
666	return unless blessed( $other ) && $other->isa( "Type::Tiny" );
667	$self->{uniq} == $other->{uniq};
668}
669
670sub is_strictly_subtype_of {
671	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
672	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
673	return unless blessed( $other ) && $other->isa( "Type::Tiny" );
674
675	return unless $self->has_parent;
676	$self->parent->strictly_equals( $other )
677		or $self->parent->is_strictly_subtype_of( $other );
678}
679
680sub is_strictly_supertype_of {
681	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
682	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
683	return unless blessed( $other ) && $other->isa( "Type::Tiny" );
684
685	$other->is_strictly_subtype_of( $self );
686}
687
688sub is_strictly_a_type_of {
689	my ( $self, $other ) = _loose_to_TypeTiny( @_ );
690	return unless blessed( $self )  && $self->isa( "Type::Tiny" );
691	return unless blessed( $other ) && $other->isa( "Type::Tiny" );
692
693	$self->strictly_equals( $other ) or $self->is_strictly_subtype_of( $other );
694}
695
696sub qualified_name {
697	my $self = shift;
698	( exists $self->{library} and $self->name ne "__ANON__" )
699		? "$self->{library}::$self->{name}"
700		: $self->{name};
701}
702
703sub is_anon {
704	my $self = shift;
705	$self->name eq "__ANON__";
706}
707
708sub parents {
709	my $self = shift;
710	return unless $self->has_parent;
711	return ( $self->parent, $self->parent->parents );
712}
713
714sub find_parent {
715	my $self = shift;
716	my ( $test ) = @_;
717
718	local ( $_, $. );
719	my $type  = $self;
720	my $count = 0;
721	while ( $type ) {
722		if ( $test->( $_ = $type, $. = $count ) ) {
723			return wantarray ? ( $type, $count ) : $type;
724		}
725		else {
726			$type = $type->parent;
727			$count++;
728		}
729	}
730
731	return;
732} #/ sub find_parent
733
734sub check {
735	my $self = shift;
736	( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )->( @_ );
737}
738
739sub _strict_check {
740	my $self = shift;
741	local $_ = $_[0];
742
743	my @constraints =
744		reverse
745		map { $_->constraint }
746		grep { not $_->_is_null_constraint } ( $self, $self->parents );
747
748	for my $c ( @constraints ) {
749		return unless $c->( @_ );
750	}
751
752	return !!1;
753} #/ sub _strict_check
754
755sub get_message {
756	my $self = shift;
757	local $_ = $_[0];
758	$self->has_message
759		? $self->message->( @_ )
760		: $self->_default_message->( @_ );
761}
762
763sub validate {
764	my $self = shift;
765
766	return undef
767		if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )
768		->( @_ );
769
770	local $_ = $_[0];
771	return $self->get_message( @_ );
772} #/ sub validate
773
774sub validate_explain {
775	my $self = shift;
776	my ( $value, $varname ) = @_;
777	$varname = '$_' unless defined $varname;
778
779	return undef if $self->check( $value );
780
781	if ( $self->has_parent ) {
782		my $parent = $self->parent->validate_explain( $value, $varname );
783		return [
784			sprintf( '"%s" is a subtype of "%s"', $self, $self->parent ),
785			@$parent
786			]
787			if $parent;
788	}
789
790	my $message = sprintf(
791		'%s%s',
792		$self->get_message( $value ),
793		$varname eq q{$_} ? '' : sprintf( ' (in %s)', $varname ),
794	);
795
796	if ( $self->is_parameterized and $self->parent->has_deep_explanation ) {
797		my $deep = $self->parent->deep_explanation->( $self, $value, $varname );
798		return [ $message, @$deep ] if $deep;
799	}
800
801	return [
802		$message,
803		sprintf( '"%s" is defined as: %s', $self, $self->_perlcode )
804	];
805} #/ sub validate_explain
806
807my $b;
808
809sub _perlcode {
810	my $self = shift;
811
812	local our $AvoidCallbacks = 1;
813	return $self->inline_check( '$_' )
814		if $self->can_be_inlined;
815
816	$b ||= do {
817		require B::Deparse;
818		my $tmp = "B::Deparse"->new;
819		$tmp->ambient_pragmas( strict => "all", warnings => "all" )
820			if $tmp->can( 'ambient_pragmas' );
821		$tmp;
822	};
823
824	my $code = $b->coderef2text( $self->constraint );
825	$code =~ s/\s+/ /g;
826	return "sub $code";
827} #/ sub _perlcode
828
829sub assert_valid {
830	my $self = shift;
831
832	return !!1
833		if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )
834		->( @_ );
835
836	local $_ = $_[0];
837	$self->_failed_check( "$self", $_ );
838} #/ sub assert_valid
839
840sub assert_return {
841	my $self = shift;
842
843	return $_[0]
844		if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )
845		->( @_ );
846
847	local $_ = $_[0];
848	$self->_failed_check( "$self", $_ );
849} #/ sub assert_return
850
851sub can_be_inlined {
852	my $self = shift;
853	return $self->parent->can_be_inlined
854		if $self->has_parent && $self->_is_null_constraint;
855	return !!1
856		if !$self->has_parent && $self->_is_null_constraint;
857	return $self->has_inlined;
858}
859
860sub inline_check {
861	my $self = shift;
862	_croak 'Cannot inline type constraint check for "%s"', $self
863		unless $self->can_be_inlined;
864
865	return $self->parent->inline_check( @_ )
866		if $self->has_parent && $self->_is_null_constraint;
867	return '(!!1)'
868		if !$self->has_parent && $self->_is_null_constraint;
869
870	local $_ = $_[0];
871	my @r = $self->inlined->( $self, @_ );
872	if ( @r and not defined $r[0] ) {
873		_croak 'Inlining type constraint check for "%s" returned undef!', $self
874			unless $self->has_parent;
875		$r[0] = $self->parent->inline_check( @_ );
876	}
877	my $r = join " && " => map {
878		/[;{}]/ && !/\Ado \{.+\}\z/
879			? "do { package Type::Tiny; $_ }"
880			: "($_)"
881	} @r;
882	return @r == 1 ? $r : "($r)";
883} #/ sub inline_check
884
885sub inline_assert {
886	require B;
887	my $self = shift;
888	my ( $varname, $typevarname, %extras ) = @_;
889
890	my $inline_check;
891	if ( $self->can_be_inlined ) {
892		$inline_check = sprintf( '(%s)', $self->inline_check( $varname ) );
893	}
894	elsif ( $typevarname ) {
895		$inline_check = sprintf( '%s->check(%s)', $typevarname, $varname );
896	}
897	else {
898		_croak 'Cannot inline type constraint check for "%s"', $self;
899	}
900
901	my $do_wrapper = !delete $extras{no_wrapper};
902
903	my $inline_throw;
904	if ( $typevarname ) {
905		$inline_throw = sprintf(
906			'Type::Tiny::_failed_check(%s, %s, %s, %s)',
907			$typevarname,
908			B::perlstring( "$self" ),
909			$varname,
910			join(
911				',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ),
912				sort keys %extras
913			),
914		);
915	} #/ if ( $typevarname )
916	else {
917		$inline_throw = sprintf(
918			'Type::Tiny::_failed_check(%s, %s, %s, %s)',
919			$self->{uniq},
920			B::perlstring( "$self" ),
921			$varname,
922			join(
923				',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ),
924				sort keys %extras
925			),
926		);
927	} #/ else [ if ( $typevarname ) ]
928
929	$do_wrapper
930		? qq[do { no warnings "void"; package Type::Tiny; $inline_check or $inline_throw; $varname };]
931		: qq[     no warnings "void"; package Type::Tiny; $inline_check or $inline_throw; $varname   ];
932} #/ sub inline_assert
933
934sub _failed_check {
935	require Error::TypeTiny::Assertion;
936
937	my ( $self, $name, $value, %attrs ) = @_;
938	$self = $ALL_TYPES{$self} if defined $self && !ref $self;
939
940	my $exception_class =
941		delete( $attrs{exception_class} ) || "Error::TypeTiny::Assertion";
942
943	if ( $self ) {
944		$exception_class->throw(
945			message => $self->get_message( $value ),
946			type    => $self,
947			value   => $value,
948			%attrs,
949		);
950	}
951	else {
952		$exception_class->throw(
953			message =>
954				sprintf( '%s did not pass type constraint "%s"', _dd( $value ), $name ),
955			value => $value,
956			%attrs,
957		);
958	}
959} #/ sub _failed_check
960
961sub coerce {
962	my $self = shift;
963	$self->_assert_coercion->coerce( @_ );
964}
965
966sub assert_coerce {
967	my $self = shift;
968	$self->_assert_coercion->assert_coerce( @_ );
969}
970
971sub is_parameterizable {
972	shift->has_constraint_generator;
973}
974
975sub is_parameterized {
976	shift->has_parameters;
977}
978
979{
980	my %seen;
981
982	sub ____make_key {
983		#<<<
984		join ',', map {
985			Types::TypeTiny::is_TypeTiny( $_ )  ? sprintf( '$Type::Tiny::ALL_TYPES{%s}', defined( $_->{uniq} ) ? $_->{uniq} : '____CANNOT_KEY____' ) :
986			ref() eq 'ARRAY'                    ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '[%s]', ____make_key( @$_ ) ) } :
987			ref() eq 'HASH'                     ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '{%s}', ____make_key( %$_ ) ) } :
988			ref() eq 'SCALAR' || ref() eq 'REF' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '\\(%s)', ____make_key( $$_ ) ) } :
989			!defined()                          ? 'undef' :
990			!ref()                              ? do { require B; B::perlstring( $_ ) } :
991			'____CANNOT_KEY____';
992		} @_;
993		#>>>
994	} #/ sub ____make_key
995	my %param_cache;
996
997	sub parameterize {
998		my $self = shift;
999
1000		$self->is_parameterizable
1001			or @_
1002			? _croak( "Type '%s' does not accept parameters", "$self" )
1003			: return ( $self );
1004
1005		@_ = map Types::TypeTiny::to_TypeTiny( $_ ), @_;
1006
1007		# Generate a key for caching parameterized type constraints,
1008		# but only if all the parameters are strings or type constraints.
1009		%seen = ();
1010		my $key = $self->____make_key( @_ );
1011		undef( $key )             if $key =~ /____CANNOT_KEY____/;
1012		return $param_cache{$key} if defined $key && defined $param_cache{$key};
1013
1014		local $Type::Tiny::parameterize_type = $self;
1015		local $_                             = $_[0];
1016		my $P;
1017
1018		my ( $constraint, $compiled ) = $self->constraint_generator->( @_ );
1019
1020		if ( Types::TypeTiny::is_TypeTiny( $constraint ) ) {
1021			$P = $constraint;
1022		}
1023		else {
1024			my %options = (
1025				constraint   => $constraint,
1026				display_name => $self->name_generator->( $self, @_ ),
1027				parameters   => [@_],
1028			);
1029			$options{compiled_type_constraint} = $compiled
1030				if $compiled;
1031			$options{inlined} = $self->inline_generator->( @_ )
1032				if $self->has_inline_generator;
1033			exists $options{$_} && !defined $options{$_} && delete $options{$_}
1034				for keys %options;
1035
1036			$P = $self->create_child_type( %options );
1037
1038			if ( $self->has_coercion_generator ) {
1039				my @args = @_;
1040				$P->{_build_coercion} = sub {
1041					my $coercion = shift;
1042					my $built    = $self->coercion_generator->( $self, $P, @args );
1043					$coercion->add_type_coercions( @{ $built->type_coercion_map } ) if $built;
1044					$coercion->freeze;
1045				};
1046			}
1047		} #/ else [ if ( Types::TypeTiny::is_TypeTiny...)]
1048
1049		if ( defined $key ) {
1050			$param_cache{$key} = $P;
1051			Scalar::Util::weaken( $param_cache{$key} );
1052		}
1053
1054		$P->coercion->freeze unless $self->has_coercion_generator;
1055
1056		return $P;
1057	} #/ sub parameterize
1058}
1059
1060sub child_type_class {
1061	__PACKAGE__;
1062}
1063
1064sub create_child_type {
1065	my $self = shift;
1066	my %moreopts;
1067	$moreopts{is_object} = 1 if $self->{is_object};
1068	return $self->child_type_class->new( parent => $self, %moreopts, @_ );
1069}
1070
1071sub complementary_type {
1072	my $self = shift;
1073	my $r    = ( $self->{complementary_type} ||= $self->_build_complementary_type );
1074	Scalar::Util::weaken( $self->{complementary_type} )
1075		unless Scalar::Util::isweak( $self->{complementary_type} );
1076	return $r;
1077}
1078
1079sub _build_complementary_type {
1080	my $self = shift;
1081	my %opts = (
1082		constraint   => sub { not $self->check( $_ ) },
1083		display_name => sprintf( "~%s", $self ),
1084	);
1085	$opts{display_name} =~ s/^\~{2}//;
1086	$opts{inlined} = sub { shift; "not(" . $self->inline_check( @_ ) . ")" }
1087		if $self->can_be_inlined;
1088	$opts{display_name} = $opts{name} = $self->{complement_name}
1089		if $self->{complement_name};
1090	return "Type::Tiny"->new( %opts );
1091} #/ sub _build_complementary_type
1092
1093sub _instantiate_moose_type {
1094	my $self = shift;
1095	my %opts = @_;
1096	require Moose::Meta::TypeConstraint;
1097	return "Moose::Meta::TypeConstraint"->new( %opts );
1098}
1099
1100sub _build_moose_type {
1101	my $self = shift;
1102
1103	my $r;
1104	if ( $self->{_is_core} ) {
1105		require Moose::Util::TypeConstraints;
1106		$r = Moose::Util::TypeConstraints::find_type_constraint( $self->name );
1107		$r->{"Types::TypeTiny::to_TypeTiny"} = $self;
1108		Scalar::Util::weaken( $r->{"Types::TypeTiny::to_TypeTiny"} );
1109	}
1110	else {
1111		# Type::Tiny is more flexible than Moose, allowing
1112		# inlined to return a list. So we need to wrap the
1113		# inlined coderef to make sure Moose gets a single
1114		# string.
1115		#
1116		my $wrapped_inlined = sub {
1117			shift;
1118			$self->inline_check( @_ );
1119		};
1120
1121		my %opts;
1122		$opts{name}   = $self->qualified_name if $self->has_library && !$self->is_anon;
1123		$opts{parent} = $self->parent->moose_type if $self->has_parent;
1124		$opts{constraint} = $self->constraint unless $self->_is_null_constraint;
1125		$opts{message}    = $self->message   if $self->has_message;
1126		$opts{inlined}    = $wrapped_inlined if $self->has_inlined;
1127
1128		$r                                   = $self->_instantiate_moose_type( %opts );
1129		$r->{"Types::TypeTiny::to_TypeTiny"} = $self;
1130		$self->{moose_type}                  = $r;                                     # prevent recursion
1131		$r->coercion( $self->coercion->moose_coercion ) if $self->has_coercion;
1132	} #/ else [ if ( $self->{_is_core})]
1133
1134	return $r;
1135} #/ sub _build_moose_type
1136
1137sub _build_mouse_type {
1138	my $self = shift;
1139
1140	my %options;
1141	$options{name} = $self->qualified_name if $self->has_library && !$self->is_anon;
1142	$options{parent}     = $self->parent->mouse_type if $self->has_parent;
1143	$options{constraint} = $self->constraint unless $self->_is_null_constraint;
1144	$options{message}    = $self->message if $self->has_message;
1145
1146	require Mouse::Meta::TypeConstraint;
1147	my $r = "Mouse::Meta::TypeConstraint"->new( %options );
1148
1149	$self->{mouse_type} = $r;    # prevent recursion
1150	$r->_add_type_coercions(
1151		$self->coercion->freeze->_codelike_type_coercion_map( 'mouse_type' ) )
1152		if $self->has_coercion;
1153
1154	return $r;
1155} #/ sub _build_mouse_type
1156
1157sub _process_coercion_list {
1158	my $self = shift;
1159
1160	my @pairs;
1161	while ( @_ ) {
1162		my $next = shift;
1163		if ( blessed( $next )
1164			and $next->isa( 'Type::Coercion' )
1165			and $next->is_parameterized )
1166		{
1167			push @pairs => ( @{ $next->_reparameterize( $self )->type_coercion_map } );
1168		}
1169		elsif ( blessed( $next ) and $next->can( 'type_coercion_map' ) ) {
1170			push @pairs => (
1171				@{ $next->type_coercion_map },
1172			);
1173		}
1174		elsif ( ref( $next ) eq q(ARRAY) ) {
1175			unshift @_, @$next;
1176		}
1177		else {
1178			push @pairs => (
1179				Types::TypeTiny::to_TypeTiny( $next ),
1180				shift,
1181			);
1182		}
1183	} #/ while ( @_ )
1184
1185	return @pairs;
1186} #/ sub _process_coercion_list
1187
1188sub plus_coercions {
1189	my $self = shift;
1190	my $new  = $self->_clone;
1191	$new->coercion->add_type_coercions(
1192		$self->_process_coercion_list( @_ ),
1193		@{ $self->coercion->type_coercion_map },
1194	);
1195	$new->coercion->freeze;
1196	return $new;
1197} #/ sub plus_coercions
1198
1199sub plus_fallback_coercions {
1200	my $self = shift;
1201
1202	my $new = $self->_clone;
1203	$new->coercion->add_type_coercions(
1204		@{ $self->coercion->type_coercion_map },
1205		$self->_process_coercion_list( @_ ),
1206	);
1207	$new->coercion->freeze;
1208	return $new;
1209} #/ sub plus_fallback_coercions
1210
1211sub minus_coercions {
1212	my $self = shift;
1213
1214	my $new = $self->_clone;
1215	my @not = grep Types::TypeTiny::is_TypeTiny( $_ ),
1216		$self->_process_coercion_list( $new, @_ );
1217
1218	my @keep;
1219	my $c = $self->coercion->type_coercion_map;
1220	for ( my $i = 0 ; $i <= $#$c ; $i += 2 ) {
1221		my $keep_this = 1;
1222		NOT: for my $n ( @not ) {
1223			if ( $c->[$i] == $n ) {
1224				$keep_this = 0;
1225				last NOT;
1226			}
1227		}
1228
1229		push @keep, $c->[$i], $c->[ $i + 1 ] if $keep_this;
1230	} #/ for ( my $i = 0 ; $i <=...)
1231
1232	$new->coercion->add_type_coercions( @keep );
1233	$new->coercion->freeze;
1234	return $new;
1235} #/ sub minus_coercions
1236
1237sub no_coercions {
1238	my $new = shift->_clone;
1239	$new->coercion->freeze;
1240	$new;
1241}
1242
1243sub coercibles {
1244	my $self = shift;
1245	$self->has_coercion ? $self->coercion->_source_type_union : $self;
1246}
1247
1248sub isa {
1249	my $self = shift;
1250
1251	if ( $INC{"Moose.pm"}
1252		and ref( $self )
1253		and $_[0] =~ /^(?:Class::MOP|MooseX?::Meta)::(.+)$/ )
1254	{
1255		my $meta = $1;
1256
1257		return !!1                       if $meta eq 'TypeConstraint';
1258		return $self->is_parameterized   if $meta eq 'TypeConstraint::Parameterized';
1259		return $self->is_parameterizable if $meta eq 'TypeConstraint::Parameterizable';
1260		return $self->isa( 'Type::Tiny::Union' ) if $meta eq 'TypeConstraint::Union';
1261
1262		my $inflate = $self->moose_type;
1263		return $inflate->isa( @_ );
1264	} #/ if ( $INC{"Moose.pm"} ...)
1265
1266	if ( $INC{"Mouse.pm"}
1267		and ref( $self )
1268		and $_[0] eq 'Mouse::Meta::TypeConstraint' )
1269	{
1270		return !!1;
1271	}
1272
1273	$self->SUPER::isa( @_ );
1274} #/ sub isa
1275
1276sub _build_my_methods {
1277	return {};
1278}
1279
1280sub _lookup_my_method {
1281	my $self = shift;
1282	my ( $name ) = @_;
1283
1284	if ( $self->my_methods->{$name} ) {
1285		return $self->my_methods->{$name};
1286	}
1287
1288	if ( $self->has_parent ) {
1289		return $self->parent->_lookup_my_method( @_ );
1290	}
1291
1292	return;
1293} #/ sub _lookup_my_method
1294
1295my %object_methods = (
1296	with_attribute_values => 1, stringifies_to => 1,
1297	numifies_to           => 1
1298);
1299
1300sub can {
1301	my $self = shift;
1302
1303	return !!0
1304		if $_[0] eq 'type_parameter'
1305		&& blessed( $_[0] )
1306		&& $_[0]->has_parameters;
1307
1308	my $can = $self->SUPER::can( @_ );
1309	return $can if $can;
1310
1311	if ( ref( $self ) ) {
1312		if ( $INC{"Moose.pm"} ) {
1313			my $method = $self->moose_type->can( @_ );
1314			return sub { shift->moose_type->$method( @_ ) }
1315				if $method;
1316		}
1317		if ( $_[0] =~ /\Amy_(.+)\z/ ) {
1318			my $method = $self->_lookup_my_method( $1 );
1319			return $method if $method;
1320		}
1321		if ( $self->{is_object} && $object_methods{ $_[0] } ) {
1322			require Type::Tiny::ConstrainedObject;
1323			return Type::Tiny::ConstrainedObject->can( $_[0] );
1324		}
1325		for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) {
1326			if ( $_[0] eq $util ) {
1327				$self->{'_util'}{$util} ||= eval { $self->_build_util( $util ) };
1328				return unless $self->{'_util'}{$util};
1329				return sub { my $s = shift; $s->{'_util'}{$util}( @_ ) };
1330			}
1331		}
1332	} #/ if ( ref( $self ) )
1333
1334	return;
1335} #/ sub can
1336
1337sub AUTOLOAD {
1338	my $self = shift;
1339	my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ );
1340	return if $m eq 'DESTROY';
1341
1342	if ( ref( $self ) ) {
1343		if ( $INC{"Moose.pm"} ) {
1344			my $method = $self->moose_type->can( $m );
1345			return $self->moose_type->$method( @_ ) if $method;
1346		}
1347		if ( $m =~ /\Amy_(.+)\z/ ) {
1348			my $method = $self->_lookup_my_method( $1 );
1349			return &$method( $self, @_ ) if $method;
1350		}
1351		if ( $self->{is_object} && $object_methods{$m} ) {
1352			require Type::Tiny::ConstrainedObject;
1353			unshift @_, $self;
1354			no strict 'refs';
1355			goto \&{"Type::Tiny::ConstrainedObject::$m"};
1356		}
1357		for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) {
1358			if ( $m eq $util ) {
1359				return ( $self->{'_util'}{$util} ||= $self->_build_util( $util ) )->( @_ );
1360			}
1361		}
1362	} #/ if ( ref( $self ) )
1363
1364	_croak q[Can't locate object method "%s" via package "%s"], $m,
1365		ref( $self ) || $self;
1366} #/ sub AUTOLOAD
1367
1368sub DOES {
1369	my $self = shift;
1370
1371	return !!1
1372		if ref( $self )
1373		&& $_[0] =~ m{^ Type::API::Constraint (?: ::Coercible | ::Inlinable )? $}x;
1374	return !!1 if !ref( $self ) && $_[0] eq 'Type::API::Constraint::Constructor';
1375
1376	"UNIVERSAL"->can( "DOES" ) ? $self->SUPER::DOES( @_ ) : $self->isa( @_ );
1377} #/ sub DOES
1378
1379sub _has_xsub {
1380	require B;
1381	!!B::svref_2object( shift->compiled_check )->XSUB;
1382}
1383
1384sub _build_util {
1385	my ( $self, $func ) = @_;
1386	Scalar::Util::weaken( my $type = $self );
1387
1388	if ( $func eq 'grep'
1389		|| $func eq 'first'
1390		|| $func eq 'any'
1391		|| $func eq 'all'
1392		|| $func eq 'assert_any'
1393		|| $func eq 'assert_all' )
1394	{
1395		my ( $inline, $compiled );
1396
1397		if ( $self->can_be_inlined ) {
1398			$inline = $self->inline_check( '$_' );
1399		}
1400		else {
1401			$compiled = $self->compiled_check;
1402			$inline   = '$compiled->($_)';
1403		}
1404
1405		if ( $func eq 'grep' ) {
1406			return eval "sub { grep { $inline } \@_ }";
1407		}
1408		elsif ( $func eq 'first' ) {
1409			return eval "sub { for (\@_) { return \$_ if ($inline) }; undef; }";
1410		}
1411		elsif ( $func eq 'any' ) {
1412			return eval "sub { for (\@_) { return !!1 if ($inline) }; !!0; }";
1413		}
1414		elsif ( $func eq 'assert_any' ) {
1415			my $qname = B::perlstring( $self->name );
1416			return
1417				eval
1418				"sub { for (\@_) { return \@_ if ($inline) }; Type::Tiny::_failed_check(\$type, $qname, \@_ ? \$_[-1] : undef); }";
1419		}
1420		elsif ( $func eq 'all' ) {
1421			return eval "sub { for (\@_) { return !!0 unless ($inline) }; !!1; }";
1422		}
1423		elsif ( $func eq 'assert_all' ) {
1424			my $qname = B::perlstring( $self->name );
1425			return
1426				eval
1427				"sub { my \$idx = 0; for (\@_) { Type::Tiny::_failed_check(\$type, $qname, \$_, varname => sprintf('\$_[%d]', \$idx)) unless ($inline); ++\$idx }; \@_; }";
1428		}
1429	} #/ if ( $func eq 'grep' ||...)
1430
1431	if ( $func eq 'map' ) {
1432		my ( $inline, $compiled );
1433		my $c = $self->_assert_coercion;
1434
1435		if ( $c->can_be_inlined ) {
1436			$inline = $c->inline_coercion( '$_' );
1437		}
1438		else {
1439			$compiled = $c->compiled_coercion;
1440			$inline   = '$compiled->($_)';
1441		}
1442
1443		return eval "sub { map { $inline } \@_ }";
1444	} #/ if ( $func eq 'map' )
1445
1446	if ( $func eq 'sort' || $func eq 'rsort' ) {
1447		my ( $inline, $compiled );
1448
1449		my $ptype = $self->find_parent( sub { $_->has_sorter } );
1450		_croak "No sorter for this type constraint" unless $ptype;
1451
1452		my $sorter = $ptype->sorter;
1453
1454		# Schwarzian transformation
1455		if ( ref( $sorter ) eq 'ARRAY' ) {
1456			my $sort_key;
1457			( $sorter, $sort_key ) = @$sorter;
1458
1459			if ( $func eq 'sort' ) {
1460				return
1461					eval
1462					"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$a->[1],\$b->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }";
1463			}
1464			elsif ( $func eq 'rsort' ) {
1465				return
1466					eval
1467					"our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$b->[1],\$a->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }";
1468			}
1469		} #/ if ( ref( $sorter ) eq...)
1470
1471		# Simple sort
1472		else {
1473			if ( $func eq 'sort' ) {
1474				return eval "our (\$a, \$b); sub { sort { \$sorter->(\$a,\$b) } \@_ }";
1475			}
1476			elsif ( $func eq 'rsort' ) {
1477				return eval "our (\$a, \$b); sub { sort { \$sorter->(\$b,\$a) } \@_ }";
1478			}
1479		}
1480	} #/ if ( $func eq 'sort' ||...)
1481
1482	die "Unknown function: $func";
1483} #/ sub _build_util
1484
1485sub of    { shift->parameterize( @_ ) }
1486sub where { shift->create_child_type( constraint => @_ ) }
1487
1488# fill out Moose-compatible API
1489sub inline_environment        { +{} }
1490sub _inline_check             { shift->inline_check( @_ ) }
1491sub _compiled_type_constraint { shift->compiled_check( @_ ) }
1492sub meta { _croak( "Not really a Moose::Meta::TypeConstraint. Sorry!" ) }
1493sub compile_type_constraint           { shift->compiled_check }
1494sub _actually_compile_type_constraint { shift->_build_compiled_check }
1495sub hand_optimized_type_constraint { shift->{hand_optimized_type_constraint} }
1496
1497sub has_hand_optimized_type_constraint {
1498	exists( shift->{hand_optimized_type_constraint} );
1499}
1500sub type_parameter { ( shift->parameters || [] )->[0] }
1501
1502sub parameterized_from {
1503	$_[0]->is_parameterized ? shift->parent : _croak( "Not a parameterized type" );
1504}
1505sub has_parameterized_from { $_[0]->is_parameterized }
1506
1507# some stuff for Mouse-compatible API
1508sub __is_parameterized      { shift->is_parameterized( @_ ) }
1509sub _add_type_coercions     { shift->coercion->add_type_coercions( @_ ) }
1510sub _as_string              { shift->qualified_name( @_ ) }
1511sub _compiled_type_coercion { shift->coercion->compiled_coercion( @_ ) }
1512sub _identity               { Scalar::Util::refaddr( shift ) }
1513
1514sub _unite {
1515	require Type::Tiny::Union;
1516	"Type::Tiny::Union"->new( type_constraints => \@_ );
1517}
1518
1519# Hooks for Type::Tie
1520sub TIESCALAR {
1521	require Type::Tie;
1522	unshift @_, 'Type::Tie::SCALAR';
1523	goto \&Type::Tie::SCALAR::TIESCALAR;
1524}
1525
1526sub TIEARRAY {
1527	require Type::Tie;
1528	unshift @_, 'Type::Tie::ARRAY';
1529	goto \&Type::Tie::ARRAY::TIEARRAY;
1530}
1531
1532sub TIEHASH {
1533	require Type::Tie;
1534	unshift @_, 'Type::Tie::HASH';
1535	goto \&Type::Tie::HASH::TIEHASH;
1536}
1537
15381;
1539
1540__END__
1541
1542=pod
1543
1544=encoding utf-8
1545
1546=for stopwords Moo(se)-compatible MooseX MouseX MooX Moose-compat invocant
1547
1548=head1 NAME
1549
1550Type::Tiny - tiny, yet Moo(se)-compatible type constraint
1551
1552=head1 SYNOPSIS
1553
1554 use v5.12;
1555 use strict;
1556 use warnings;
1557
1558 package Horse {
1559   use Moo;
1560   use Types::Standard qw( Str Int Enum ArrayRef Object );
1561   use Type::Params qw( compile );
1562   use namespace::autoclean;
1563
1564   has name => (
1565     is       => 'ro',
1566     isa      => Str,
1567     required => 1,
1568   );
1569   has gender => (
1570     is       => 'ro',
1571     isa      => Enum[qw( f m )],
1572   );
1573   has age => (
1574     is       => 'rw',
1575     isa      => Int->where( '$_ >= 0' ),
1576   );
1577   has children => (
1578     is       => 'ro',
1579     isa      => ArrayRef[Object],
1580     default  => sub { return [] },
1581   );
1582
1583   sub add_child {
1584     state $check = compile( Object, Object );  # method signature
1585
1586     my ($self, $child) = $check->(@_);         # unpack @_
1587     push @{ $self->children }, $child;
1588
1589     return $self;
1590   }
1591 }
1592
1593 package main;
1594
1595 my $boldruler = Horse->new(
1596   name    => "Bold Ruler",
1597   gender  => 'm',
1598   age     => 16,
1599 );
1600
1601 my $secretariat = Horse->new(
1602   name    => "Secretariat",
1603   gender  => 'm',
1604   age     => 0,
1605 );
1606
1607 $boldruler->add_child( $secretariat );
1608
1609=head1 STATUS
1610
1611This module is covered by the
1612L<Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY">.
1613
1614=head1 DESCRIPTION
1615
1616This documents the internals of the L<Type::Tiny> class. L<Type::Tiny::Manual>
1617is a better starting place if you're new.
1618
1619L<Type::Tiny> is a small class for creating Moose-like type constraint
1620objects which are compatible with Moo, Moose and Mouse.
1621
1622   use Scalar::Util qw(looks_like_number);
1623   use Type::Tiny;
1624
1625   my $NUM = "Type::Tiny"->new(
1626      name       => "Number",
1627      constraint => sub { looks_like_number($_) },
1628      message    => sub { "$_ ain't a number" },
1629   );
1630
1631   package Ermintrude {
1632      use Moo;
1633      has favourite_number => (is => "ro", isa => $NUM);
1634   }
1635
1636   package Bullwinkle {
1637      use Moose;
1638      has favourite_number => (is => "ro", isa => $NUM);
1639   }
1640
1641   package Maisy {
1642      use Mouse;
1643      has favourite_number => (is => "ro", isa => $NUM);
1644   }
1645
1646Maybe now we won't need to have separate MooseX, MouseX and MooX versions
1647of everything? We can but hope...
1648
1649=head2 Constructor
1650
1651=over
1652
1653=item C<< new(%attributes) >>
1654
1655Moose-style constructor function.
1656
1657=back
1658
1659=head2 Attributes
1660
1661Attributes are named values that may be passed to the constructor. For
1662each attribute, there is a corresponding reader method. For example:
1663
1664   my $type = Type::Tiny->new( name => "Foo" );
1665   print $type->name, "\n";   # says "Foo"
1666
1667=head3 Important attributes
1668
1669These are the attributes you are likely to be most interested in
1670providing when creating your own type constraints, and most interested
1671in reading when dealing with type constraint objects.
1672
1673=over
1674
1675=item C<< constraint >>
1676
1677Coderef to validate a value (C<< $_ >>) against the type constraint.
1678The coderef will not be called unless the value is known to pass any
1679parent type constraint (see C<parent> below).
1680
1681Alternatively, a string of Perl code checking C<< $_ >> can be passed
1682as a parameter to the constructor, and will be converted to a coderef.
1683
1684Defaults to C<< sub { 1 } >> - i.e. a coderef that passes all values.
1685
1686=item C<< parent >>
1687
1688Optional attribute; parent type constraint. For example, an "Integer"
1689type constraint might have a parent "Number".
1690
1691If provided, must be a Type::Tiny object.
1692
1693=item C<< inlined >>
1694
1695A coderef which returns a string of Perl code suitable for inlining this
1696type. Optional.
1697
1698(The coderef will be called in list context and can actually return
1699a list of strings which will be joined with C<< && >>. If the first item
1700on the list is undef, it will be substituted with the type's parent's
1701inline check.)
1702
1703If C<constraint> (above) is a coderef generated via L<Sub::Quote>, then
1704Type::Tiny I<may> be able to automatically generate C<inlined> for you.
1705If C<constraint> (above) is a string, it will be able to.
1706
1707=item C<< name >>
1708
1709The name of the type constraint. These need to conform to certain naming
1710rules (they must begin with an uppercase letter and continue using only
1711letters, digits 0-9 and underscores).
1712
1713Optional; if not supplied will be an anonymous type constraint.
1714
1715=item C<< display_name >>
1716
1717A name to display for the type constraint when stringified. These don't
1718have to conform to any naming rules. Optional; a default name will be
1719calculated from the C<name>.
1720
1721=item C<< library >>
1722
1723The package name of the type library this type is associated with.
1724Optional. Informational only: setting this attribute does not install
1725the type into the package.
1726
1727=item C<< deprecated >>
1728
1729Optional boolean indicating whether a type constraint is deprecated.
1730L<Type::Library> will issue a warning if you attempt to import a deprecated
1731type constraint, but otherwise the type will continue to function as normal.
1732There will not be deprecation warnings every time you validate a value, for
1733instance. If omitted, defaults to the parent's deprecation status (or false
1734if there's no parent).
1735
1736=item C<< message >>
1737
1738Coderef that returns an error message when C<< $_ >> does not validate
1739against the type constraint. Optional (there's a vaguely sensible default.)
1740
1741=item C<< coercion >>
1742
1743A L<Type::Coercion> object associated with this type.
1744
1745Generally speaking this attribute should not be passed to the constructor;
1746you should rely on the default lazily-built coercion object.
1747
1748You may pass C<< coercion => 1 >> to the constructor to inherit coercions
1749from the constraint's parent. (This requires the parent constraint to have
1750a coercion.)
1751
1752=item C<< sorter >>
1753
1754A coderef which can be passed two values conforming to this type constraint
1755and returns -1, 0, or 1 to put them in order. Alternatively an arrayref
1756containing a pair of coderefs — a sorter and a pre-processor for the
1757Schwarzian transform. Optional.
1758
1759The idea is to allow for:
1760
1761  @sorted = Int->sort( 2, 1, 11 );    # => 1, 2, 11
1762  @sorted = Str->sort( 2, 1, 11 );    # => 1, 11, 2
1763
1764=item C<< my_methods >>
1765
1766Experimental hashref of additional methods that can be called on the type
1767constraint object.
1768
1769=back
1770
1771=head3 Attributes related to parameterizable and parameterized types
1772
1773The following additional attributes are used for parameterizable (e.g.
1774C<ArrayRef>) and parameterized (e.g. C<< ArrayRef[Int] >>) type
1775constraints. Unlike Moose, these aren't handled by separate subclasses.
1776
1777=over
1778
1779=item C<< constraint_generator >>
1780
1781Coderef that is called when a type constraint is parameterized. When called,
1782it is passed the list of parameters, though any parameter which looks like a
1783foreign type constraint (Moose type constraints, Mouse type constraints, etc,
1784I<< and coderefs(!!!) >>) is first coerced to a native Type::Tiny object.
1785
1786Note that for compatibility with the Moose API, the base type is I<not>
1787passed to the constraint generator, but can be found in the package variable
1788C<< $Type::Tiny::parameterize_type >>. The first parameter is also available
1789as C<< $_ >>.
1790
1791Types I<can> be parameterized with an empty parameter list. For example,
1792in L<Types::Standard>, C<Tuple> is just an alias for C<ArrayRef> but
1793C<< Tuple[] >> will only allow zero-length arrayrefs to pass the constraint.
1794If you wish C<< YourType >> and C<< YourType[] >> to mean the same thing,
1795then do:
1796
1797 return $Type::Tiny::parameterize_type unless @_;
1798
1799The constraint generator should generate and return a new constraint coderef
1800based on the parameters. Alternatively, the constraint generator can return a
1801fully-formed Type::Tiny object, in which case the C<name_generator>,
1802C<inline_generator>, and C<coercion_generator> attributes documented below
1803are ignored.
1804
1805Optional; providing a generator makes this type into a parameterizable
1806type constraint. If there is no generator, attempting to parameterize the
1807type constraint will throw an exception.
1808
1809=item C<< name_generator >>
1810
1811A coderef which generates a new display_name based on parameters. Called with
1812the same parameters and package variables as the C<constraint_generator>.
1813Expected to return a string.
1814
1815Optional; the default is reasonable.
1816
1817=item C<< inline_generator >>
1818
1819A coderef which generates a new inlining coderef based on parameters. Called
1820with the same parameters and package variables as the C<constraint_generator>.
1821Expected to return a coderef.
1822
1823Optional.
1824
1825=item C<< coercion_generator >>
1826
1827A coderef which generates a new L<Type::Coercion> object based on parameters.
1828Called with the same parameters and package variables as the
1829C<constraint_generator>. Expected to return a blessed object.
1830
1831Optional.
1832
1833=item C<< deep_explanation >>
1834
1835This API is not finalized. Coderef used by L<Error::TypeTiny::Assertion> to
1836peek inside parameterized types and figure out why a value doesn't pass the
1837constraint.
1838
1839=item C<< parameters >>
1840
1841In parameterized types, returns an arrayref of the parameters.
1842
1843=back
1844
1845=head3 Lazy generated attributes
1846
1847The following attributes should not be usually passed to the constructor;
1848unless you're doing something especially unusual, you should rely on the
1849default lazily-built return values.
1850
1851=over
1852
1853=item C<< compiled_check >>
1854
1855Coderef to validate a value (C<< $_[0] >>) against the type constraint.
1856This coderef is expected to also handle all validation for the parent
1857type constraints.
1858
1859=item C<< complementary_type >>
1860
1861A complementary type for this type. For example, the complementary type
1862for an integer type would be all things that are not integers, including
1863floating point numbers, but also alphabetic strings, arrayrefs, filehandles,
1864etc.
1865
1866=item C<< moose_type >>, C<< mouse_type >>
1867
1868Objects equivalent to this type constraint, but as a
1869L<Moose::Meta::TypeConstraint> or L<Mouse::Meta::TypeConstraint>.
1870
1871It should rarely be necessary to obtain a L<Moose::Meta::TypeConstraint>
1872object from L<Type::Tiny> because the L<Type::Tiny> object itself should
1873be usable pretty much anywhere a L<Moose::Meta::TypeConstraint> is expected.
1874
1875=back
1876
1877=head2 Methods
1878
1879=head3 Predicate methods
1880
1881These methods return booleans indicating information about the type
1882constraint. They are each tightly associated with a particular attribute.
1883(See L</"Attributes">.)
1884
1885=over
1886
1887=item C<has_parent>, C<has_library>, C<has_inlined>, C<has_constraint_generator>, C<has_inline_generator>, C<has_coercion_generator>, C<has_parameters>, C<has_message>, C<has_deep_explanation>, C<has_sorter>
1888
1889Simple Moose-style predicate methods indicating the presence or
1890absence of an attribute.
1891
1892=item C<has_coercion>
1893
1894Predicate method with a little extra DWIM. Returns false if the coercion is
1895a no-op.
1896
1897=item C<< is_anon >>
1898
1899Returns true iff the type constraint does not have a C<name>.
1900
1901=item C<< is_parameterized >>, C<< is_parameterizable >>
1902
1903Indicates whether a type has been parameterized (e.g. C<< ArrayRef[Int] >>)
1904or could potentially be (e.g. C<< ArrayRef >>).
1905
1906=item C<< has_parameterized_from >>
1907
1908Useless alias for C<is_parameterized>.
1909
1910=back
1911
1912=head3 Validation and coercion
1913
1914The following methods are used for coercing and validating values
1915against a type constraint:
1916
1917=over
1918
1919=item C<< check($value) >>
1920
1921Returns true iff the value passes the type constraint.
1922
1923=item C<< validate($value) >>
1924
1925Returns the error message for the value; returns an explicit undef if the
1926value passes the type constraint.
1927
1928=item C<< assert_valid($value) >>
1929
1930Like C<< check($value) >> but dies if the value does not pass the type
1931constraint.
1932
1933Yes, that's three very similar methods. Blame L<Moose::Meta::TypeConstraint>
1934whose API I'm attempting to emulate. :-)
1935
1936=item C<< assert_return($value) >>
1937
1938Like C<< assert_valid($value) >> but returns the value if it passes the type
1939constraint.
1940
1941This seems a more useful behaviour than C<< assert_valid($value) >>. I would
1942have just changed C<< assert_valid($value) >> to do this, except that there
1943are edge cases where it could break Moose compatibility.
1944
1945=item C<< get_message($value) >>
1946
1947Returns the error message for the value; even if the value passes the type
1948constraint.
1949
1950=item C<< validate_explain($value, $varname) >>
1951
1952Like C<validate> but instead of a string error message, returns an arrayref
1953of strings explaining the reasoning why the value does not meet the type
1954constraint, examining parent types, etc.
1955
1956The C<< $varname >> is an optional string like C<< '$foo' >> indicating the
1957name of the variable being checked.
1958
1959=item C<< coerce($value) >>
1960
1961Attempt to coerce C<< $value >> to this type.
1962
1963=item C<< assert_coerce($value) >>
1964
1965Attempt to coerce C<< $value >> to this type. Throws an exception if this is
1966not possible.
1967
1968=back
1969
1970=head3 Child type constraint creation and parameterization
1971
1972These methods generate new type constraint objects that inherit from the
1973constraint they are called upon:
1974
1975=over
1976
1977=item C<< create_child_type(%attributes) >>
1978
1979Construct a new Type::Tiny object with this object as its parent.
1980
1981=item C<< where($coderef) >>
1982
1983Shortcut for creating an anonymous child type constraint. Use it like
1984C<< HashRef->where(sub { exists($_->{name}) }) >>. That said, you can
1985get a similar result using overloaded C<< & >>:
1986
1987   HashRef & sub { exists($_->{name}) }
1988
1989Like the C<< constraint >> attribute, this will accept a string of Perl
1990code:
1991
1992   HashRef->where('exists($_->{name})')
1993
1994=item C<< child_type_class >>
1995
1996The class that create_child_type will construct by default.
1997
1998=item C<< parameterize(@parameters) >>
1999
2000Creates a new parameterized type; throws an exception if called on a
2001non-parameterizable type.
2002
2003=item C<< of(@parameters) >>
2004
2005A cute alias for C<parameterize>. Use it like C<< ArrayRef->of(Int) >>.
2006
2007=item C<< plus_coercions($type1, $code1, ...) >>
2008
2009Shorthand for creating a new child type constraint with the same coercions
2010as this one, but then adding some extra coercions (at a higher priority than
2011the existing ones).
2012
2013=item C<< plus_fallback_coercions($type1, $code1, ...) >>
2014
2015Like C<plus_coercions>, but added at a lower priority.
2016
2017=item C<< minus_coercions($type1, ...) >>
2018
2019Shorthand for creating a new child type constraint with fewer type coercions.
2020
2021=item C<< no_coercions >>
2022
2023Shorthand for creating a new child type constraint with no coercions at all.
2024
2025=back
2026
2027=head3 Type relationship introspection methods
2028
2029These methods allow you to determine a type constraint's relationship to
2030other type constraints in an organised hierarchy:
2031
2032=over
2033
2034=item C<< equals($other) >>, C<< is_subtype_of($other) >>, C<< is_supertype_of($other) >>, C<< is_a_type_of($other) >>
2035
2036Compare two types. See L<Moose::Meta::TypeConstraint> for what these all mean.
2037(OK, Moose doesn't define C<is_supertype_of>, but you get the idea, right?)
2038
2039Note that these have a slightly DWIM side to them. If you create two
2040L<Type::Tiny::Class> objects which test the same class, they're considered
2041equal. And:
2042
2043   my $subtype_of_Num = Types::Standard::Num->create_child_type;
2044   my $subtype_of_Int = Types::Standard::Int->create_child_type;
2045   $subtype_of_Int->is_subtype_of( $subtype_of_Num );  # true
2046
2047=item C<< strictly_equals($other) >>, C<< is_strictly_subtype_of($other) >>, C<< is_strictly_supertype_of($other) >>, C<< is_strictly_a_type_of($other) >>
2048
2049Stricter versions of the type comparison functions. These only care about
2050explicit inheritance via C<parent>.
2051
2052   my $subtype_of_Num = Types::Standard::Num->create_child_type;
2053   my $subtype_of_Int = Types::Standard::Int->create_child_type;
2054   $subtype_of_Int->is_strictly_subtype_of( $subtype_of_Num );  # false
2055
2056=item C<< parents >>
2057
2058Returns a list of all this type constraint's ancestor constraints. For
2059example, if called on the C<Str> type constraint would return the list
2060C<< (Value, Defined, Item, Any) >>.
2061
2062I<< Due to a historical misunderstanding, this differs from the Moose
2063implementation of the C<parents> method. In Moose, C<parents> only returns the
2064immediate parent type constraints, and because type constraints only have
2065one immediate parent, this is effectively an alias for C<parent>. The
2066extension module L<MooseX::Meta::TypeConstraint::Intersection> is the only
2067place where multiple type constraints are returned; and they are returned
2068as an arrayref in violation of the base class' documentation. I'm keeping
2069my behaviour as it seems more useful. >>
2070
2071=item C<< find_parent($coderef) >>
2072
2073Loops through the parent type constraints I<< including the invocant
2074itself >> and returns the nearest ancestor type constraint where the
2075coderef evaluates to true. Within the coderef the ancestor currently
2076being checked is C<< $_ >>. Returns undef if there is no match.
2077
2078In list context also returns the number of type constraints which had
2079been looped through before the matching constraint was found.
2080
2081=item C<< find_constraining_type >>
2082
2083Finds the nearest ancestor type constraint (including the type itself)
2084which has a C<constraint> coderef.
2085
2086Equivalent to:
2087
2088   $type->find_parent(sub { not $_->_is_null_constraint })
2089
2090=item C<< coercibles >>
2091
2092Return a type constraint which is the union of type constraints that can be
2093coerced to this one (including this one). If this type constraint has no
2094coercions, returns itself.
2095
2096=item C<< type_parameter >>
2097
2098In parameterized type constraints, returns the first item on the list of
2099parameters; otherwise returns undef. For example:
2100
2101   ( ArrayRef[Int] )->type_parameter;    # returns Int
2102   ( ArrayRef[Int] )->parent;            # returns ArrayRef
2103
2104Note that parameterizable type constraints can perfectly legitimately take
2105multiple parameters (several of the parameterizable type constraints in
2106L<Types::Standard> do). This method only returns the first such parameter.
2107L</"Attributes related to parameterizable and parameterized types">
2108documents the C<parameters> attribute, which returns an arrayref of all
2109the parameters.
2110
2111=item C<< parameterized_from >>
2112
2113Harder to spell alias for C<parent> that only works for parameterized
2114types.
2115
2116=back
2117
2118I<< Hint for people subclassing Type::Tiny: >>
2119Since version 1.006000, the methods for determining subtype, supertype, and
2120type equality should I<not> be overridden in subclasses of Type::Tiny. This
2121is because of the problem of diamond inheritance. If X and Y are both
2122subclasses of Type::Tiny, they I<both> need to be consulted to figure out
2123how type constraints are related; not just one of them should be overriding
2124these methods. See the source code for L<Type::Tiny::Enum> for an example of
2125how subclasses can give hints about type relationships to Type::Tiny.
2126Summary: push a coderef onto C<< @Type::Tiny::CMP >>. This coderef will be
2127passed two type constraints. It should then return one of the constants
2128Type::Tiny::CMP_SUBTYPE (first type is a subtype of second type),
2129Type::Tiny::CMP_SUPERTYPE (second type is a subtype of first type),
2130Type::Tiny::CMP_EQUAL (the two types are exactly the same),
2131Type::Tiny::CMP_EQUIVALENT (the two types are effectively the same), or
2132Type::Tiny::CMP_UNKNOWN (your coderef couldn't establish any relationship).
2133
2134=head3 Type relationship introspection function
2135
2136=over
2137
2138=item C<< Type::Tiny::cmp($type1, $type2) >>
2139
2140The subtype/supertype relationship between types results in a partial
2141ordering of type constraints.
2142
2143This function will return one of the constants:
2144Type::Tiny::CMP_SUBTYPE (first type is a subtype of second type),
2145Type::Tiny::CMP_SUPERTYPE (second type is a subtype of first type),
2146Type::Tiny::CMP_EQUAL (the two types are exactly the same),
2147Type::Tiny::CMP_EQUIVALENT (the two types are effectively the same), or
2148Type::Tiny::CMP_UNKNOWN (couldn't establish any relationship).
2149In numeric contexts, these evaluate to -1, 1, 0, 0, and 0, making it
2150potentially usable with C<sort> (though you may need to silence warnings
2151about treating the empty string as a numeric value).
2152
2153=back
2154
2155=head3 List processing methods
2156
2157=over
2158
2159=item C<< grep(@list) >>
2160
2161Filters a list to return just the items that pass the type check.
2162
2163  @integers = Int->grep(@list);
2164
2165=item C<< first(@list) >>
2166
2167Filters the list to return the first item on the list that passes
2168the type check, or undef if none do.
2169
2170  $first_lady = Woman->first(@people);
2171
2172=item C<< map(@list) >>
2173
2174Coerces a list of items. Only works on types which have a coercion.
2175
2176  @truths = Bool->map(@list);
2177
2178=item C<< sort(@list) >>
2179
2180Sorts a list of items according to the type's preferred sorting mechanism,
2181or if the type doesn't have a sorter coderef, uses the parent type. If no
2182ancestor type constraint has a sorter, throws an exception. The C<Str>,
2183C<StrictNum>, C<LaxNum>, and C<Enum> type constraints include sorters.
2184
2185  @sorted_numbers = Num->sort( Num->grep(@list) );
2186
2187=item C<< rsort(@list) >>
2188
2189Like C<sort> but backwards.
2190
2191=item C<< any(@list) >>
2192
2193Returns true if any of the list match the type.
2194
2195  if ( Int->any(@numbers) ) {
2196    say "there was at least one integer";
2197  }
2198
2199=item C<< all(@list) >>
2200
2201Returns true if all of the list match the type.
2202
2203  if ( Int->all(@numbers) ) {
2204    say "they were all integers";
2205  }
2206
2207=item C<< assert_any(@list) >>
2208
2209Like C<any> but instead of returning a boolean, returns the entire original
2210list if any item on it matches the type, and dies if none does.
2211
2212=item C<< assert_all(@list) >>
2213
2214Like C<all> but instead of returning a boolean, returns the original list if
2215all items on it match the type, but dies as soon as it finds one that does
2216not.
2217
2218=back
2219
2220=head3 Inlining methods
2221
2222=for stopwords uated
2223
2224The following methods are used to generate strings of Perl code which
2225may be pasted into stringy C<eval>uated subs to perform type checks:
2226
2227=over
2228
2229=item C<< can_be_inlined >>
2230
2231Returns boolean indicating if this type can be inlined.
2232
2233=item C<< inline_check($varname) >>
2234
2235Creates a type constraint check for a particular variable as a string of
2236Perl code. For example:
2237
2238   print( Types::Standard::Num->inline_check('$foo') );
2239
2240prints the following output:
2241
2242   (!ref($foo) && Scalar::Util::looks_like_number($foo))
2243
2244For Moose-compat, there is an alias C<< _inline_check >> for this method.
2245
2246=item C<< inline_assert($varname) >>
2247
2248Much like C<inline_check> but outputs a statement of the form:
2249
2250   ... or die ...;
2251
2252Can also be called line C<< inline_assert($varname, $typevarname, %extras) >>.
2253In this case, it will generate a string of code that may include
2254C<< $typevarname >> which is supposed to be the name of a variable holding
2255the type itself. (This is kinda complicated, but it allows a useful string
2256to still be produced if the type is not inlineable.) The C<< %extras >> are
2257additional options to be passed to L<Error::TypeTiny::Assertion>'s constructor
2258and must be key-value pairs of strings only, no references or undefs.
2259
2260=back
2261
2262=head3 Other methods
2263
2264=over
2265
2266=item C<< qualified_name >>
2267
2268For non-anonymous type constraints that have a library, returns a qualified
2269C<< "MyLib::MyType" >> sort of name. Otherwise, returns the same as C<name>.
2270
2271=item C<< isa($class) >>, C<< can($method) >>, C<< AUTOLOAD(@args) >>
2272
2273If Moose is loaded, then the combination of these methods is used to mock
2274a Moose::Meta::TypeConstraint.
2275
2276If Mouse is loaded, then C<isa> mocks Mouse::Meta::TypeConstraint.
2277
2278=item C<< DOES($role) >>
2279
2280Overridden to advertise support for various roles.
2281
2282See also L<Type::API::Constraint>, etc.
2283
2284=item C<< TIESCALAR >>, C<< TIEARRAY >>, C<< TIEHASH >>
2285
2286These are provided as hooks that wrap L<Type::Tie>. (Type::Tie is distributed
2287separately, and can be used with non-Type::Tiny type constraints too.) They
2288allow the following to work:
2289
2290   use Types::Standard qw(Int);
2291   tie my @list, Int;
2292   push @list, 123, 456;   # ok
2293   push @list, "Hello";    # dies
2294
2295=back
2296
2297The following methods exist for Moose/Mouse compatibility, but do not do
2298anything useful.
2299
2300=over
2301
2302=item C<< compile_type_constraint >>
2303
2304=item C<< hand_optimized_type_constraint >>
2305
2306=item C<< has_hand_optimized_type_constraint >>
2307
2308=item C<< inline_environment >>
2309
2310=item C<< meta >>
2311
2312=back
2313
2314=head2 Overloading
2315
2316=over
2317
2318=item *
2319
2320Stringification is overloaded to return the qualified name.
2321
2322=item *
2323
2324Boolification is overloaded to always return true.
2325
2326=item *
2327
2328Coderefification is overloaded to call C<assert_return>.
2329
2330=item *
2331
2332On Perl 5.10.1 and above, smart match is overloaded to call C<check>.
2333
2334=item *
2335
2336The C<< == >> operator is overloaded to call C<equals>.
2337
2338=item *
2339
2340The C<< < >> and C<< > >> operators are overloaded to call C<is_subtype_of>
2341and C<is_supertype_of>.
2342
2343=item *
2344
2345The C<< ~ >> operator is overloaded to call C<complementary_type>.
2346
2347=item *
2348
2349The C<< | >> operator is overloaded to build a union of two type constraints.
2350See L<Type::Tiny::Union>.
2351
2352=item *
2353
2354The C<< & >> operator is overloaded to build the intersection of two type
2355constraints. See L<Type::Tiny::Intersection>.
2356
2357=back
2358
2359Previous versions of Type::Tiny would overload the C<< + >> operator to
2360call C<plus_coercions> or C<plus_fallback_coercions> as appropriate.
2361Support for this was dropped after 0.040.
2362
2363=head2 Constants
2364
2365=over
2366
2367=item C<< Type::Tiny::SUPPORT_SMARTMATCH >>
2368
2369Indicates whether the smart match overload is supported on your
2370version of Perl.
2371
2372=back
2373
2374=head2 Package Variables
2375
2376=over
2377
2378=item C<< $Type::Tiny::DD >>
2379
2380This undef by default but may be set to a coderef that Type::Tiny
2381and related modules will use to dump data structures in things like
2382error messages.
2383
2384Otherwise Type::Tiny uses it's own routine to dump data structures.
2385C<< $DD >> may then be set to a number to limit the lengths of the
2386dumps. (Default limit is 72.)
2387
2388This is a package variable (rather than get/set class methods) to allow
2389for easy localization.
2390
2391=item C<< $Type::Tiny::AvoidCallbacks >>
2392
2393If this variable is set to true (you should usually do it in a
2394C<local> scope), it acts as a hint for type constraints, when
2395generating inlined code, to avoid making any callbacks to
2396variables and functions defined outside the inlined code itself.
2397
2398This should have the effect that C<< $type->inline_check('$foo') >>
2399will return a string of code capable of checking the type on
2400Perl installations that don't have Type::Tiny installed. This
2401is intended to allow Type::Tiny to be used with things like
2402L<Mite>.
2403
2404The variable works on the honour system. Types need to explicitly
2405check it and decide to generate different code based on its
2406truth value. The bundled types in L<Types::Standard>,
2407L<Types::Common::Numeric>, and L<Types::Common::String> all do.
2408(B<StrMatch> is sometimes unable to, and will issue a warning
2409if it needs to rely on callbacks when asked not to.)
2410
2411Most normal users can ignore this.
2412
2413=back
2414
2415=head2 Environment
2416
2417=over
2418
2419=item C<PERL_TYPE_TINY_XS>
2420
2421Currently this has more effect on L<Types::Standard> than Type::Tiny. In
2422future it may be used to trigger or suppress the loading XS implementations
2423of parts of Type::Tiny.
2424
2425=back
2426
2427=head1 BUGS
2428
2429Please report any bugs to
2430L<https://github.com/tobyink/p5-type-tiny/issues>.
2431
2432=head1 SEE ALSO
2433
2434L<The Type::Tiny homepage|https://typetiny.toby.ink/>.
2435
2436L<Type::Tiny::Manual>, L<Type::API>.
2437
2438L<Type::Library>, L<Type::Utils>, L<Types::Standard>, L<Type::Coercion>.
2439
2440L<Type::Tiny::Class>, L<Type::Tiny::Role>, L<Type::Tiny::Duck>,
2441L<Type::Tiny::Enum>, L<Type::Tiny::Union>, L<Type::Tiny::Intersection>.
2442
2443L<Moose::Meta::TypeConstraint>,
2444L<Mouse::Meta::TypeConstraint>.
2445
2446L<Type::Params>.
2447
2448L<Type::Tiny on GitHub|https://github.com/tobyink/p5-type-tiny>,
2449L<Type::Tiny on Travis-CI|https://travis-ci.com/tobyink/p5-type-tiny>,
2450L<Type::Tiny on AppVeyor|https://ci.appveyor.com/project/tobyink/p5-type-tiny>,
2451L<Type::Tiny on Codecov|https://codecov.io/gh/tobyink/p5-type-tiny>,
2452L<Type::Tiny on Coveralls|https://coveralls.io/github/tobyink/p5-type-tiny>.
2453
2454=head1 AUTHOR
2455
2456Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
2457
2458=head1 THANKS
2459
2460Thanks to Matt S Trout for advice on L<Moo> integration.
2461
2462=head1 COPYRIGHT AND LICENCE
2463
2464This software is copyright (c) 2013-2014, 2017-2021 by Toby Inkster.
2465
2466This is free software; you can redistribute it and/or modify it under
2467the same terms as the Perl 5 programming language system itself.
2468
2469=head1 DISCLAIMER OF WARRANTIES
2470
2471THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
2472WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
2473MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
2474