File Coverage

blib/lib/Types/Standard.pm

Criterion	Covered	Total	%
statement	69	70	98.5
branch	9	20	45.0
condition	5	8	62.5
subroutine	21	21	100.0
pod	3	3	100.0
total	107	122	87.7

package Types::Standard;

use 5.008001;
use strict;
use warnings;

BEGIN {
	eval { require re };
	if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat }
}

BEGIN {
	$Types::Standard::AUTHORITY = 'cpan:TOBYINK';
	$Types::Standard::VERSION   = '2.010001';
}

$Types::Standard::VERSION =~ tr/_//d;

use Type::Library -base;

our @EXPORT_OK = qw( slurpy );

use Eval::TypeTiny  qw( set_subname );
use Scalar::Util    qw( blessed looks_like_number );
use Type::Tiny      ();
use Types::TypeTiny ();

my $is_class_loaded;

BEGIN {
	$is_class_loaded = q{sub {
		no strict 'refs';
		return !!0 if ref $_[0];
		return !!0 if not $_[0];
		return !!0 if ref(do { my $tmpstr = $_[0]; \$tmpstr }) ne 'SCALAR';
		my $stash = \%{"$_[0]\::"};
		return !!1 if exists($stash->{'ISA'}) && *{$stash->{'ISA'}}{ARRAY} && @{$_[0].'::ISA'};
		return !!1 if exists($stash->{'VERSION'});
		foreach my $globref (values %$stash) {
			return !!1
				if ref \$globref eq 'GLOB'
					? *{$globref}{CODE}
					: ref $globref; # const or sub ref
		}
		return !!0;
	}};

	*_is_class_loaded =
		Type::Tiny::_USE_XS
		? \&Type::Tiny::XS::Util::is_class_loaded
		: eval $is_class_loaded;

	*_HAS_REFUTILXS = eval {
		require Ref::Util::XS;
		Ref::Util::XS::->VERSION( 0.100 );
		1;
	}
		? sub () { !!1 }
		: sub () { !!0 };
} #/ BEGIN

my $add_core_type = sub {
	my $meta = shift;
	my ( $typedef ) = @_;

	my $name = $typedef->{name};
	my ( $xsub, $xsubname );

	# We want Map and Tuple to be XSified, even if they're not
	# really core.
	$typedef->{_is_core} = 1
		unless $name eq 'Map' || $name eq 'Tuple';

	if ( Type::Tiny::_USE_XS
		and not( $name eq 'RegexpRef' ) )
	{
		$xsub     = Type::Tiny::XS::get_coderef_for( $name );
		$xsubname = Type::Tiny::XS::get_subname_for( $name );
	}

	elsif ( Type::Tiny::_USE_MOUSE
		and not( $name eq 'RegexpRef' or $name eq 'Int' or $name eq 'Object' ) )
	{
		require Mouse::Util::TypeConstraints;
		$xsub     = "Mouse::Util::TypeConstraints"->can( $name );
		$xsubname = "Mouse::Util::TypeConstraints::$name" if $xsub;
	}

	if ( Type::Tiny::_USE_XS
		and Type::Tiny::XS->VERSION < 0.014
		and $name eq 'Bool' )
	{
		# Broken implementation of Bool
		$xsub = $xsubname = undef;
	}

	if ( Type::Tiny::_USE_XS
		and ( Type::Tiny::XS->VERSION < 0.016 or $] < 5.018 )
		and $name eq 'Int' )
	{
		# Broken implementation of Int
		$xsub = $xsubname = undef;
	}

	if ( Type::Tiny::_USE_XS
		and $name eq 'Int'
		and do { use Config (); $Config::Config{usequadmath} } )
	{
		# Broken implementation of Int
		$xsub = $xsubname = undef;
	}

	$typedef->{compiled_type_constraint} = $xsub if $xsub;

	my $orig_inlined = $typedef->{inlined};
	if (
		defined( $xsubname ) and (

			# These should be faster than their normal inlined
			# equivalents
			$name eq 'Str'
			or $name eq 'Bool'
			or $name eq 'Int'
			or $name eq 'ClassName'
			or $name eq 'RegexpRef'
			or $name eq 'FileHandle'
		)
		)
	{
		$typedef->{inlined} = sub {
			$Type::Tiny::AvoidCallbacks ? goto( $orig_inlined ) : "$xsubname\($_[1])";
		};
	} #/ if ( defined( $xsubname...))

	@_ = ( $meta, $typedef );
	goto \&Type::Library::add_type;
};

my $maybe_load_modules = sub {
	my $code = pop;
	if ( $Type::Tiny::AvoidCallbacks ) {
		$code = sprintf(
			'do { %s %s; %s }',
			$Type::Tiny::SafePackage,
			join( '; ', map "use $_ ()", @_ ),
			$code,
		);
	}
	$code;
};

sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }

my $meta = __PACKAGE__->meta;

# Stringable and LazyLoad are optimizations that complicate
# this module somewhat, but they have led to performance
# improvements. If Types::Standard wasn't such a key type
# library, I wouldn't use them. I strongly discourage anybody
# from using them in their own code. If you're looking for
# examples of how to write a type library sanely, you're
# better off looking at the code for Types::Common::Numeric
# and Types::Common::String.

{

	sub Stringable (&) {
		bless +{ code => $_[0] }, 'Types::Standard::_Stringable';
	}
	Types::Standard::_Stringable->Type::Tiny::_install_overloads(
		q[""] => sub { $_[0]{text} ||= $_[0]{code}->() } );

	sub LazyLoad ($$) {
		bless \@_, 'Types::Standard::LazyLoad';
	}
	'Types::Standard::LazyLoad'->Type::Tiny::_install_overloads(
		q[&{}] => sub {
			my ( $typename, $function ) = @{ $_[0] };
			my $type  = $meta->get_type( $typename );
			my $class = "Types::Standard::$typename";
			eval "require $class; 1" or die( $@ );

			# Majorly break encapsulation for Type::Tiny :-O
			for my $key ( keys %$type ) {
				next unless ref( $type->{$key} ) eq 'Types::Standard::LazyLoad';
				my $f = $type->{$key}[1];
				$type->{$key} = $class->can( "__$f" );
			}
			my $mm = $type->{my_methods} || {};
			for my $key ( keys %$mm ) {
				next unless ref( $mm->{$key} ) eq 'Types::Standard::LazyLoad';
				my $f = $mm->{$key}[1];
				$mm->{$key} = $class->can( "__$f" );
				set_subname(
					sprintf( "%s::my_%s", $type->qualified_name, $key ),
					$mm->{$key},
				);
			} #/ for my $key ( keys %$mm)
			return $class->can( "__$function" );
		},
	);
}

no warnings;

BEGIN {
	*STRICTNUM =
		$ENV{PERL_TYPES_STANDARD_STRICTNUM}
		? sub() { !!1 }
		: sub() { !!0 }
}

my $_any = $meta->$add_core_type(
	{
		name            => "Any",
		inlined         => sub { "!!1" },
		complement_name => 'None',
		type_default    => sub { return undef; },
	}
);

my $_item = $meta->$add_core_type(
	{
		name    => "Item",
		inlined => sub { "!!1" },
		parent  => $_any,
	}
);

my $_bool = $meta->$add_core_type(
	{
		name       => "Bool",
		parent     => $_item,
		constraint => sub {
			!ref $_ and ( !defined $_ or $_ eq q() or $_ eq '0' or $_ eq '1' );
		},
		inlined => sub {
			"!ref $_[1] and (!defined $_[1] or $_[1] eq q() or $_[1] eq '0' or $_[1] eq '1')";
		},
		type_default => sub { return !!0; },
	}
);

$_bool->coercion->add_type_coercions( $_any, q{!!$_} );

my $_undef = $meta->$add_core_type(
	{
		name       => "Undef",
		parent     => $_item,
		constraint => sub { !defined $_ },
		inlined    => sub { "!defined($_[1])" },
		type_default => sub { return undef; },
	}
);

my $_def = $meta->$add_core_type(
	{
		name               => "Defined",
		parent             => $_item,
		constraint         => sub { defined $_ },
		inlined            => sub { "defined($_[1])" },
		complementary_type => $_undef,
	}
);

# hackish, but eh
Scalar::Util::weaken( $_undef->{complementary_type} ||= $_def );

my $_val = $meta->$add_core_type(
	{
		name       => "Value",
		parent     => $_def,
		constraint => sub { not ref $_ },
		inlined    => sub { "defined($_[1]) and not ref($_[1])" },
	}
);

my $_str = $meta->$add_core_type(
	{
		name       => "Str",
		parent     => $_val,
		constraint => sub {
			ref( \$_ ) eq 'SCALAR' or ref( \( my $val = $_ ) ) eq 'SCALAR';
		},
		inlined    => sub {
			"defined($_[1]) and do { ref(\\$_[1]) eq 'SCALAR' or ref(\\(my \$val = $_[1])) eq 'SCALAR' }";
		},
		sorter     => sub { $_[0] cmp $_[1] },
		type_default => sub { return ''; },
	}
);

my $_laxnum = $meta->add_type(
	{
		name       => "LaxNum",
		parent     => $_str,
		constraint => sub { looks_like_number( $_ ) and ref( \$_ ) ne 'GLOB' },
		inlined    => sub {
			$maybe_load_modules->(
				qw/ Scalar::Util /,
				'Scalar::Util'->VERSION ge '1.18'    # RT 132426
				? "defined($_[1]) && !ref($_[1]) && Scalar::Util::looks_like_number($_[1])"
				: "defined($_[1]) && !ref($_[1]) && Scalar::Util::looks_like_number($_[1]) && ref(\\($_[1])) ne 'GLOB'"
			);
		},
		sorter     => sub { $_[0] <=> $_[1] },
		type_default => sub { return 0; },
	}
);

my $_strictnum = $meta->add_type(
	{
		name       => "StrictNum",
		parent     => $_str,
		constraint => sub {
			my $val = $_;
			( $val =~ /\A[+-]?[0-9]+\z/ )
				|| (
				$val =~ /\A(?:[+-]?)                #matches optional +- in the beginning
					(?=[0-9]|\.[0-9])                #matches previous +- only if there is something like 3 or .3
					[0-9]*                           #matches 0-9 zero or more times
					(?:\.[0-9]+)?                    #matches optional .89 or nothing
					(?:[Ee](?:[+-]?[0-9]+))?         #matches E1 or e1 or e-1 or e+1 etc
					\z/x
				);
		},
		inlined    => sub {
			'my $val = '
				. $_[1] . ';'
				. Value()->inline_check( '$val' )
				. ' && ( $val =~ /\A[+-]?[0-9]+\z/ || '
				. '$val =~ /\A(?:[+-]?)              # matches optional +- in the beginning
			(?=[0-9]|\.[0-9])                 # matches previous +- only if there is something like 3 or .3
			[0-9]*                            # matches 0-9 zero or more times
			(?:\.[0-9]+)?                     # matches optional .89 or nothing
			(?:[Ee](?:[+-]?[0-9]+))?          # matches E1 or e1 or e-1 or e+1 etc
		\z/x ); '
		},
		sorter     => sub { $_[0] <=> $_[1] },
		type_default => sub { return 0; },
	}
);

my $_num = $meta->add_type(
	{
		name   => "Num",
		parent => ( STRICTNUM ? $_strictnum : $_laxnum ),
	}
);

$meta->$add_core_type(
	{
		name       => "Int",
		parent     => $_num,
		constraint => sub { /\A-?[0-9]+\z/ },
		inlined    => sub {
			"do { my \$tmp = $_[1]; defined(\$tmp) and !ref(\$tmp) and \$tmp =~ /\\A-?[0-9]+\\z/ }";
		},
		type_default => sub { return 0; },
	}
);

my $_classn = $meta->add_type(
	{
		name       => "ClassName",
		parent     => $_str,
		constraint => \&_is_class_loaded,
		inlined    => sub {
			$Type::Tiny::AvoidCallbacks
				? "($is_class_loaded)->(do { my \$tmp = $_[1] })"
				: "Types::Standard::_is_class_loaded(do { my \$tmp = $_[1] })";
		},
	}
);

$meta->add_type(
	{
		name       => "RoleName",
		parent     => $_classn,
		constraint => sub { not $_->can( "new" ) },
		inlined    => sub {
			$Type::Tiny::AvoidCallbacks
				? "($is_class_loaded)->(do { my \$tmp = $_[1] }) and not $_[1]\->can('new')"
				: "Types::Standard::_is_class_loaded(do { my \$tmp = $_[1] }) and not $_[1]\->can('new')";
		},
	}
);

my $_ref = $meta->$add_core_type(
	{
		name                 => "Ref",
		parent               => $_def,
		constraint           => sub { ref $_ },
		inlined              => sub { "!!ref($_[1])" },
		constraint_generator => sub {
			return $meta->get_type( 'Ref' ) unless @_;

			Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Ref', \@_, 1 );
			my $reftype = shift;
			$reftype =~
				/^(SCALAR|ARRAY|HASH|CODE|REF|GLOB|LVALUE|FORMAT|IO|VSTRING|REGEXP|Regexp)$/i
				or _croak(
				"Parameter to Ref[`a] expected to be a Perl ref type; got $reftype" );

			$reftype = "$reftype";
			return sub {
				ref( $_[0] ) and Scalar::Util::reftype( $_[0] ) eq $reftype;
			}
		},
		inline_generator => sub {
			my $reftype = shift;
			return sub {
				my $v = $_[1];
				$maybe_load_modules->(
					qw/ Scalar::Util /,
					"ref($v) and Scalar::Util::reftype($v) eq q($reftype)"
				);
			};
		},
		deep_explanation => sub {
			require B;
			my ( $type, $value, $varname ) = @_;
			my $param = $type->parameters->[0];
			return if $type->check( $value );
			my $reftype = Scalar::Util::reftype( $value );
			return [
				sprintf(
					'"%s" constrains reftype(%s) to be equal to %s', $type, $varname,
					B::perlstring( $param )
				),
				sprintf(
					'reftype(%s) is %s', $varname,
					defined( $reftype ) ? B::perlstring( $reftype ) : "undef"
				),
			];
		},
	}
);

$meta->$add_core_type(
	{
		name       => "CodeRef",
		parent     => $_ref,
		constraint => sub { ref $_ eq "CODE" },
		inlined    => sub {
			_HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks
				? "Ref::Util::XS::is_plain_coderef($_[1])"
				: "ref($_[1]) eq 'CODE'";
		},
		type_default => sub { return sub {}; },
	}
);

my $_regexp = $meta->$add_core_type(
	{
		name       => "RegexpRef",
		parent     => $_ref,
		constraint => sub {
			ref( $_ ) && !!re::is_regexp( $_ ) or blessed( $_ ) && $_->isa( 'Regexp' );
		},
		inlined    => sub {
			my $v = $_[1];
			$maybe_load_modules->(
				qw/ Scalar::Util re /,
				"ref($v) && !!re::is_regexp($v) or Scalar::Util::blessed($v) && $v\->isa('Regexp')"
			);
		},
		type_default => sub { return qr//; },
	}
);

$meta->$add_core_type(
	{
		name       => "GlobRef",
		parent     => $_ref,
		constraint => sub { ref $_ eq "GLOB" },
		inlined    => sub {
			_HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks
				? "Ref::Util::XS::is_plain_globref($_[1])"
				: "ref($_[1]) eq 'GLOB'";
		},
	}
);

$meta->$add_core_type(
	{
		name       => "FileHandle",
		parent     => $_ref,
		constraint => sub {
			( ref( $_ ) && Scalar::Util::openhandle( $_ ) )
				or ( blessed( $_ ) && $_->isa( "IO::Handle" ) );
		},
		inlined => sub {
			$maybe_load_modules->(
				qw/ Scalar::Util /,
				"(ref($_[1]) && Scalar::Util::openhandle($_[1])) "
					. "or (Scalar::Util::blessed($_[1]) && $_[1]\->isa(\"IO::Handle\"))"
			);
		},
	}
);

my $_arr = $meta->$add_core_type(
	{
		name       => "ArrayRef",
		parent     => $_ref,
		constraint => sub { ref $_ eq "ARRAY" },
		inlined    => sub {
			_HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks
				? "Ref::Util::XS::is_plain_arrayref($_[1])"
				: "ref($_[1]) eq 'ARRAY'";
		},
		constraint_generator => LazyLoad( ArrayRef => 'constraint_generator' ),
		inline_generator     => LazyLoad( ArrayRef => 'inline_generator' ),
		deep_explanation     => LazyLoad( ArrayRef => 'deep_explanation' ),
		coercion_generator   => LazyLoad( ArrayRef => 'coercion_generator' ),
		type_default         => sub { return []; },
		type_default_generator => sub {
			return $Type::Tiny::parameterize_type->type_default if @_ < 2;
			return undef;
		},
	}
);

my $_hash = $meta->$add_core_type(
	{
		name       => "HashRef",
		parent     => $_ref,
		constraint => sub { ref $_ eq "HASH" },
		inlined    => sub {
			_HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks
				? "Ref::Util::XS::is_plain_hashref($_[1])"
				: "ref($_[1]) eq 'HASH'";
		},
		constraint_generator => LazyLoad( HashRef => 'constraint_generator' ),
		inline_generator     => LazyLoad( HashRef => 'inline_generator' ),
		deep_explanation     => LazyLoad( HashRef => 'deep_explanation' ),
		coercion_generator   => LazyLoad( HashRef => 'coercion_generator' ),
		type_default         => sub { return {}; },
		type_default_generator => sub {
			return $Type::Tiny::parameterize_type->type_default if @_ < 2;
			return undef;
		},
		my_methods           => {
			hashref_allows_key   => LazyLoad( HashRef => 'hashref_allows_key' ),
			hashref_allows_value => LazyLoad( HashRef => 'hashref_allows_value' ),
		},
	}
);

$meta->$add_core_type(
	{
		name                 => "ScalarRef",
		parent               => $_ref,
		constraint           => sub { ref $_ eq "SCALAR" or ref $_ eq "REF" },
		inlined              => sub { "ref($_[1]) eq 'SCALAR' or ref($_[1]) eq 'REF'" },
		constraint_generator => LazyLoad( ScalarRef => 'constraint_generator' ),
		inline_generator     => LazyLoad( ScalarRef => 'inline_generator' ),
		deep_explanation     => LazyLoad( ScalarRef => 'deep_explanation' ),
		coercion_generator   => LazyLoad( ScalarRef => 'coercion_generator' ),
		type_default         => sub { my $x; return \$x; },
	}
);

my $_obj = $meta->$add_core_type(
	{
		name       => "Object",
		parent     => $_ref,
		constraint => sub { blessed $_ },
		inlined    => sub {
			_HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks
				? "Ref::Util::XS::is_blessed_ref($_[1])"
				: $maybe_load_modules->(
				'Scalar::Util',
				"Scalar::Util::blessed($_[1])"
				);
		},
		is_object => 1,
	}
);

$meta->$add_core_type(
	{
		name                 => "Maybe",
		parent               => $_item,
		constraint_generator => sub {
			return $meta->get_type( 'Maybe' ) unless @_;

			Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Maybe', \@_, 1 );
			my $param = Types::TypeTiny::to_TypeTiny( shift );
			Types::TypeTiny::is_TypeTiny( $param )
				or _croak(
				"Parameter to Maybe[`a] expected to be a type constraint; got $param" );

			my $param_compiled_check = $param->compiled_check;
			my @xsub;
			if ( Type::Tiny::_USE_XS ) {
				my $paramname = Type::Tiny::XS::is_known( $param_compiled_check );
				push @xsub, Type::Tiny::XS::get_coderef_for( "Maybe[$paramname]" )
					if $paramname;
			}
			elsif ( Type::Tiny::_USE_MOUSE and $param->_has_xsub ) {
				require Mouse::Util::TypeConstraints;
				my $maker = "Mouse::Util::TypeConstraints"->can( "_parameterize_Maybe_for" );
				push @xsub, $maker->( $param ) if $maker;
			}

			return (
				sub {
					my $value = shift;
					return !!1 unless defined $value;
					return $param->check( $value );
				},
				@xsub,
			);
		},
		inline_generator => sub {
			my $param = shift;

			my $param_compiled_check = $param->compiled_check;
			my $xsubname;
			if ( Type::Tiny::_USE_XS ) {
				my $paramname = Type::Tiny::XS::is_known( $param_compiled_check );
				$xsubname = Type::Tiny::XS::get_subname_for( "Maybe[$paramname]" );
			}

			return unless $param->can_be_inlined;
			return sub {
				my $v = $_[1];
				return "$xsubname\($v\)" if $xsubname && !$Type::Tiny::AvoidCallbacks;
				my $param_check = $param->inline_check( $v );
				"!defined($v) or $param_check";
			};
		},
		deep_explanation => sub {
			my ( $type, $value, $varname ) = @_;
			my $param = $type->parameters->[0];

			return [
				sprintf( '%s is defined', Type::Tiny::_dd( $value ) ),
				sprintf(
					'"%s" constrains the value with "%s" if it is defined', $type, $param
				),
				@{ $param->validate_explain( $value, $varname ) },
			];
		},
		coercion_generator => sub {
			my ( $parent, $child, $param ) = @_;
			return unless $param->has_coercion;
			return $param->coercion;
		},
		type_default       => sub { return undef; },
		type_default_generator => sub {
			$_[0]->type_default || $Type::Tiny::parameterize_type->type_default ;
		},
	}
);

my $_map = $meta->$add_core_type(
	{
		name                 => "Map",
		parent               => $_hash,
		constraint_generator => LazyLoad( Map => 'constraint_generator' ),
		inline_generator     => LazyLoad( Map => 'inline_generator' ),
		deep_explanation     => LazyLoad( Map => 'deep_explanation' ),
		coercion_generator   => LazyLoad( Map => 'coercion_generator' ),
		my_methods           => {
			hashref_allows_key   => LazyLoad( Map => 'hashref_allows_key' ),
			hashref_allows_value => LazyLoad( Map => 'hashref_allows_value' ),
		},
		type_default_generator => sub {
			return $Type::Tiny::parameterize_type->type_default;
		},
	}
);

my $_Optional = $meta->add_type(
	{
		name                 => "Optional",
		parent               => $_item,
		constraint_generator => sub {
			return $meta->get_type( 'Optional' ) unless @_;

			Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Optional', \@_, 1 );
			my $param = Types::TypeTiny::to_TypeTiny( shift );
			Types::TypeTiny::is_TypeTiny( $param )
				or _croak(
				"Parameter to Optional[`a] expected to be a type constraint; got $param" );

			sub { $param->check( $_[0] ) }
		},
		inline_generator => sub {
			my $param = shift;
			return unless $param->can_be_inlined;
			return sub {
				my $v = $_[1];
				$param->inline_check( $v );
			};
		},
		deep_explanation => sub {
			my ( $type, $value, $varname ) = @_;
			my $param = $type->parameters->[0];

			return [
				sprintf( '%s exists', $varname ),
				sprintf( '"%s" constrains %s with "%s" if it exists', $type, $varname, $param ),
				@{ $param->validate_explain( $value, $varname ) },
			];
		},
		coercion_generator => sub {
			my ( $parent, $child, $param ) = @_;
			return unless $param->has_coercion;
			return $param->coercion;
		},
		type_default_generator => sub {
			return $_[0]->type_default;
		},
	}
);

my $_slurpy;
$_slurpy = $meta->add_type(
	{
		name                 => "Slurpy",
		slurpy               => 1,
		parent               => $_item,
		constraint_generator => sub {
			my $self  = $_slurpy;

			Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Slurpy', \@_, 1 );
			my $param = @_ ? Types::TypeTiny::to_TypeTiny(shift) : $_any;
			Types::TypeTiny::is_TypeTiny( $param )
				or _croak(
				"Parameter to Slurpy[`a] expected to be a type constraint; got $param" );

			return $self->create_child_type(
				slurpy          => 1,
				display_name    => $self->name_generator->( $self, $param ),
				parameters      => [ $param ],
				constraint      => sub { $param->check( $_[0] ) },
				type_default    => $param->type_default,
				_build_coercion => sub {
					my $coercion = shift;
					$coercion->add_type_coercions( @{ $param->coercion->type_coercion_map } )
						if $param->has_coercion;
					$coercion->freeze;
				},
				$param->can_be_inlined
					? ( inlined => sub { $param->inline_check( $_[1] ) } )
					: (),
			);
		},
		deep_explanation => sub {
			my ( $type, $value, $varname ) = @_;
			my $param = $type->parameters->[0];
			return [
				sprintf( '%s is slurpy', $varname ),
				@{ $param->validate_explain( $value, $varname ) },
			];
		},
		my_methods => {
			'unslurpy' => sub {
				my $self  = shift;
				$self->{_my_unslurpy} ||= $self->find_parent(
					sub { $_->parent->{uniq} == $_slurpy->{uniq} }
				)->type_parameter;
			},
			'slurp_into' => sub {
				my $self  = shift;
				my $parameters = $self->find_parent(
					sub { $_->parent->{uniq} == $_slurpy->{uniq} }
				)->parameters;
				if ( $parameters->[1] ) {
					return $parameters->[1];
				}
				my $constraint = $parameters->[0];
				return 'HASH'
					if $constraint->is_a_type_of( HashRef() )
					or $constraint->is_a_type_of( Map() )
					or $constraint->is_a_type_of( Dict() );
				return 'ARRAY';
			},
		},
	}
);

sub slurpy {
	my $t = shift;
	my $s = $_slurpy->of( $t );
	$s->{slurpy} ||= 1;
	wantarray ? ( $s, @_ ) : $s;
}

$meta->$add_core_type(
	{
		name           => "Tuple",
		parent         => $_arr,
		name_generator => sub {
			my ( $s, @a ) = @_;
			sprintf( '%s[%s]', $s, join q[,], @a );
		},
		constraint_generator => LazyLoad( Tuple => 'constraint_generator' ),
		inline_generator     => LazyLoad( Tuple => 'inline_generator' ),
		deep_explanation     => LazyLoad( Tuple => 'deep_explanation' ),
		coercion_generator   => LazyLoad( Tuple => 'coercion_generator' ),
	}
);

$meta->add_type(
	{
		name           => "CycleTuple",
		parent         => $_arr,
		name_generator => sub {
			my ( $s, @a ) = @_;
			sprintf( '%s[%s]', $s, join q[,], @a );
		},
		constraint_generator => LazyLoad( CycleTuple => 'constraint_generator' ),
		inline_generator     => LazyLoad( CycleTuple => 'inline_generator' ),
		deep_explanation     => LazyLoad( CycleTuple => 'deep_explanation' ),
		coercion_generator   => LazyLoad( CycleTuple => 'coercion_generator' ),
	}
);

$meta->add_type(
	{
		name           => "Dict",
		parent         => $_hash,
		name_generator => sub {
			my ( $s, @p ) = @_;
			my $l = @p
				&& Types::TypeTiny::is_TypeTiny( $p[-1] )
				&& $p[-1]->is_strictly_a_type_of( Types::Standard::Slurpy() )
				? pop(@p)
				: undef;
			my %a = @p;
			sprintf(
				'%s[%s%s]', $s,
				join( q[,], map sprintf( "%s=>%s", $_, $a{$_} ), sort keys %a ),
				$l ? ",$l" : ''
			);
		},
		constraint_generator => LazyLoad( Dict => 'constraint_generator' ),
		inline_generator     => LazyLoad( Dict => 'inline_generator' ),
		deep_explanation     => LazyLoad( Dict => 'deep_explanation' ),
		coercion_generator   => LazyLoad( Dict => 'coercion_generator' ),
		my_methods           => {
			dict_is_slurpy       => LazyLoad( Dict => 'dict_is_slurpy' ),
			hashref_allows_key   => LazyLoad( Dict => 'hashref_allows_key' ),
			hashref_allows_value => LazyLoad( Dict => 'hashref_allows_value' ),
		},
	}
);

$meta->add_type(
	{
		name       => "Overload",
		parent     => $_obj,
		constraint => sub { require overload; overload::Overloaded( $_ ) },
		inlined    => sub {
			$maybe_load_modules->(
				qw/ Scalar::Util overload /,
				$INC{'overload.pm'}
				? "Scalar::Util::blessed($_[1]) and overload::Overloaded($_[1])"
				: "Scalar::Util::blessed($_[1]) and do { use overload (); overload::Overloaded($_[1]) }"
			);
		},
		constraint_generator => sub {
			return $meta->get_type( 'Overload' ) unless @_;

			my @operations = map {
				Types::TypeTiny::is_StringLike( $_ )
					? "$_"
					: _croak( "Parameters to Overload[`a] expected to be a strings; got $_" );
			} @_;

			require overload;
			return sub {
				my $value = shift;
				for my $op ( @operations ) {
					return unless overload::Method( $value, $op );
				}
				return !!1;
			}
		},
		inline_generator => sub {
			my @operations = @_;
			return sub {
				require overload;
				my $v = $_[1];
				$maybe_load_modules->(
					qw/ Scalar::Util overload /,
					join " and ",
					"Scalar::Util::blessed($v)",
					map "overload::Method($v, q[$_])", @operations
				);
			};
		},
		is_object => 1,
	}
);

$meta->add_type(
	{
		name                 => "StrMatch",
		parent               => $_str,
		constraint_generator => LazyLoad( StrMatch => 'constraint_generator' ),
		inline_generator     => LazyLoad( StrMatch => 'inline_generator' ),
	}
);

$meta->add_type(
	{
		name       => "OptList",
		parent     => $_arr,
		constraint => sub {
			for my $inner ( @$_ ) {
				return unless ref( $inner ) eq q(ARRAY);
				return unless @$inner == 2;
				return unless is_Str( $inner->[0] );
			}
			return !!1;
		},
		inlined => sub {
			my ( $self, $var ) = @_;
			my $Str_check = Str()->inline_check( '$inner->[0]' );
			my @code      = 'do { my $ok = 1; ';
			push @code, sprintf( 'for my $inner (@{%s}) { no warnings; ', $var );
			push @code,
				sprintf(
				'($ok=0) && last unless ref($inner) eq q(ARRAY) && @$inner == 2 && (%s); ',
				$Str_check
				);
			push @code, '} ';
			push @code, '$ok }';
			return ( undef, join( q( ), @code ) );
		},
		type_default => sub { return [] },
	}
);

$meta->add_type(
	{
		name       => "Tied",
		parent     => $_ref,
		constraint => sub {
			!!tied(
				Scalar::Util::reftype( $_ ) eq 'HASH'             ? %{$_}
				: Scalar::Util::reftype( $_ ) eq 'ARRAY'          ? @{$_}
				: Scalar::Util::reftype( $_ ) =~ /^(SCALAR|REF)$/ ? ${$_}
				:                                                   undef
			);
		},
		inlined => sub {
			my ( $self, $var ) = @_;
			$maybe_load_modules->(
				qw/ Scalar::Util /,
				$self->parent->inline_check( $var )
					. " and !!tied(Scalar::Util::reftype($var) eq 'HASH' ? \%{$var} : Scalar::Util::reftype($var) eq 'ARRAY' ? \@{$var} : Scalar::Util::reftype($var) =~ /^(SCALAR|REF)\$/ ? \${$var} : undef)"
			);
		},
		name_generator => sub {
			my $self  = shift;
			my $param = Types::TypeTiny::to_TypeTiny( shift );
			unless ( Types::TypeTiny::is_TypeTiny( $param ) ) {
				Types::TypeTiny::is_StringLike( $param )
					or _croak( "Parameter to Tied[`a] expected to be a class name; got $param" );
				require B;
				return sprintf( "%s[%s]", $self, B::perlstring( $param ) );
			}
			return sprintf( "%s[%s]", $self, $param );
		},
		constraint_generator => LazyLoad( Tied => 'constraint_generator' ),
		inline_generator     => LazyLoad( Tied => 'inline_generator' ),
	}
);

$meta->add_type(
	{
		name                 => "InstanceOf",
		parent               => $_obj,
		constraint_generator => sub {
			return $meta->get_type( 'InstanceOf' ) unless @_;
			require Type::Tiny::Class;
			my @classes = map {
				Types::TypeTiny::is_TypeTiny( $_ )
					? $_
					: "Type::Tiny::Class"->new(
					class        => $_,
					display_name => sprintf( 'InstanceOf[%s]', B::perlstring( $_ ) )
					)
			} @_;
			return $classes[0] if @classes == 1;

			require B;
			require Type::Tiny::Union;
			return "Type::Tiny::Union"->new(
				type_constraints => \@classes,
				display_name     => sprintf(
					'InstanceOf[%s]', join q[,], map B::perlstring( $_->class ), @classes
				),
			);
		},
	}
);

$meta->add_type(
	{
		name                 => "ConsumerOf",
		parent               => $_obj,
		constraint_generator => sub {
			return $meta->get_type( 'ConsumerOf' ) unless @_;
			require B;
			require Type::Tiny::Role;
			my @roles = map {
				Types::TypeTiny::is_TypeTiny( $_ )
					? $_
					: "Type::Tiny::Role"->new(
					role         => $_,
					display_name => sprintf( 'ConsumerOf[%s]', B::perlstring( $_ ) )
					)
			} @_;
			return $roles[0] if @roles == 1;

			require Type::Tiny::Intersection;
			return "Type::Tiny::Intersection"->new(
				type_constraints => \@roles,
				display_name     => sprintf(
					'ConsumerOf[%s]', join q[,], map B::perlstring( $_->role ), @roles
				),
			);
		},
	}
);

$meta->add_type(
	{
		name                 => "HasMethods",
		parent               => $_obj,
		constraint_generator => sub {
			return $meta->get_type( 'HasMethods' ) unless @_;
			require B;
			require Type::Tiny::Duck;
			return "Type::Tiny::Duck"->new(
				methods      => \@_,
				display_name =>
					sprintf( 'HasMethods[%s]', join q[,], map B::perlstring( $_ ), @_ ),
			);
		},
	}
);

$meta->add_type(
	{
		name                 => "Enum",
		parent               => $_str,
		constraint_generator => sub {
			return $meta->get_type( 'Enum' ) unless @_;
			my $coercion;
			if ( ref( $_[0] ) and ref( $_[0] ) eq 'SCALAR' ) {
				$coercion = ${ +shift };
			}
			elsif ( ref( $_[0] ) && !blessed( $_[0] )
				or blessed( $_[0] ) && $_[0]->isa( 'Type::Coercion' ) )
			{
				$coercion = shift;
			}
			require B;
			require Type::Tiny::Enum;
			return "Type::Tiny::Enum"->new(
				values       => \@_,
				display_name => sprintf( 'Enum[%s]', join q[,], map B::perlstring( $_ ), @_ ),
				$coercion ? ( coercion => $coercion ) : (),
			);
		},
		type_default => undef,
	}
);

$meta->add_coercion(
	{
		name              => "MkOpt",
		type_constraint   => $meta->get_type( "OptList" ),
		type_coercion_map => [
			$_arr,   q{ Exporter::Tiny::mkopt($_) },
			$_hash,  q{ Exporter::Tiny::mkopt($_) },
			$_undef, q{ [] },
		],
	}
);

$meta->add_coercion(
	{
		name               => "Join",
		type_constraint    => $_str,
		coercion_generator => sub {
			my ( $self, $target, $sep ) = @_;
			Types::TypeTiny::is_StringLike( $sep )
				or _croak( "Parameter to Join[`a] expected to be a string; got $sep" );
			require B;
			$sep = B::perlstring( $sep );
			return ( ArrayRef(), qq{ join($sep, \@\$_) } );
		},
	}
);

$meta->add_coercion(
	{
		name               => "Split",
		type_constraint    => $_arr,
		coercion_generator => sub {
			my ( $self, $target, $re ) = @_;
			ref( $re ) eq q(Regexp)
				or _croak(
				"Parameter to Split[`a] expected to be a regular expression; got $re" );
			my $regexp_string = "$re";
			$regexp_string =~ s/\\\//\\\\\//g;    # toothpicks
			return ( Str(), qq{ [split /$regexp_string/, \$_] } );
		},
	}
);

__PACKAGE__->meta->make_immutable;

1;

__END__