support for deprecated types

lib/Type/Library.pm

@@ -164,8 +164,15 @@ sub _exporter_install_sub
 	my ($name, $value, $globals, $sym) = @_;
 
 	my $package = $globals->{into};
+	my $type = $class->get_type($name);
 
-	if (!ref $package and my $type = $class->get_type($name))
+	Exporter::Tiny::_carp(
+		"Exporting deprecated type %s to %s",
+		$type->qualified_name,
+		ref($package) ? "reference" : "package $package",
+	) 	if (defined $type and $type->deprecated and not $globals->{allow_deprecated});
+
+	if (!ref $package and defined $type)
 	{
 		my ($prefix) = grep defined, $value->{-prefix}, $globals->{prefix}, q();
 		my ($suffix) = grep defined, $value->{-suffix}, $globals->{suffix}, q();

lib/Type/Tiny.pm

@@ -194,8 +194,16 @@ sub new
 
 		_croak "Parent must be an instance of %s", __PACKAGE__
 			unless blessed($params{parent}) && $params{parent}->isa(__PACKAGE__);
+
+		if ($params{parent}->deprecated and not $params{allow_deprecated})
+		{
+			$params{deprecated} = 1 unless exists $params{deprecated};
+		}
 	}
 
+	# canonicalize to a boolean
+	$params{deprecated} = !!$params{deprecated};
+
 	$params{name} = "__ANON__" unless exists $params{name};
 	$params{uniq} = $uniq++;
 
@@ -347,6 +355,7 @@ sub coercion                 { $_[0]{coercion}       ||= $_[0]->_build_coercion
 sub message                  { $_[0]{message} }
 sub library                  { $_[0]{library} }
 sub inlined                  { $_[0]{inlined} }
+sub deprecated               { $_[0]{deprecated} }
 sub constraint_generator     { $_[0]{constraint_generator} }
 sub inline_generator         { $_[0]{inline_generator} }
 sub name_generator           { $_[0]{name_generator} ||= $_[0]->_build_name_generator }
@@ -1343,6 +1352,15 @@ The package name of the type library this type is associated with.
 Optional. Informational only: setting this attribute does not install
 the type into the package.
 
+=item C<< deprecated >>
+
+Optional boolean indicating whether a type constraint is deprecated.
+L<Type::Library> will issue a warning if you attempt to import a deprecated
+type constraint, but otherwise the type will continue to function as normal.
+There will not be deprecation warnings every time you validate a value, for
+instance. If omitted, defaults to the parent's deprecation status (or false
+if there's no parent).
+
 =item C<< message >>
 
 Coderef that returns an error message when C<< $_ >> does not validate

t/20-unit/Type-Library/deprecation.t

@@ -0,0 +1,75 @@
+=pod
+
+=encoding utf-8
+
+=head1 PURPOSE
+
+Checks Type::Library warns about deprecated types.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2018 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use strict;
+use warnings;
+use lib qw( ./lib ./t/lib ../inc ./inc );
+
+use Test::More;
+use Test::Fatal;
+use Test::TypeTiny;
+
+use Type::Tiny;
+
+BEGIN {
+	package Local::Library;
+	use Type::Library -base;
+	my $t1 = Type::Tiny->new(name => "Base");
+	my $t2 = Type::Tiny->new(name => "Derived_1", parent => $t1);
+	my $t3 = Type::Tiny->new(name => "Derived_2", parent => $t1, deprecated => 1);
+	my $t4 = Type::Tiny->new(name => "Double_Derived_1", parent => $t3);
+	my $t5 = Type::Tiny->new(name => "Double_Derived_2", parent => $t3, deprecated => 0);
+	__PACKAGE__->meta->add_type($_) for $t1, $t2, $t3, $t4, $t5;
+	$INC{'Local/Library.pm'} = __FILE__;
+};
+
+{
+	my @WARNINGS;
+	sub get_warnings { [@WARNINGS] }
+	sub reset_warnings { @WARNINGS = () }
+	$SIG{__WARN__} = sub { push @WARNINGS, $_[0] };
+};
+
+reset_warnings();
+eval q{
+	package Local::Example1;
+	use Local::Library qw(Derived_1);
+	1;
+} or die($@);
+is_deeply(get_warnings(), []);
+
+reset_warnings();
+eval q{
+	package Local::Example2;
+	use Local::Library qw(Derived_2);
+	1;
+} or die($@);
+like(get_warnings()->[0], qr/^Exporting deprecated type Derived_2 to package Local::Example2/);
+
+reset_warnings();
+eval q{
+	package Local::Example3;
+	use Local::Library -allow_deprecated, qw(Derived_2);
+	1;
+} or die($@);
+is_deeply(get_warnings(), []);
+
+done_testing;

t/20-unit/Type-Tiny/deprecation.t

@@ -0,0 +1,44 @@
+=pod
+
+=encoding utf-8
+
+=head1 PURPOSE
+
+Checks Type::Tiny's C<deprecated> attribute works.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2018 by Toby Inkster.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
+
+use strict;
+use warnings;
+use lib qw( ./lib ./t/lib ../inc ./inc );
+
+use Test::More;
+use Test::Fatal;
+use Test::TypeTiny;
+
+use Type::Tiny;
+
+my $t1 = Type::Tiny->new(name => "Base");
+my $t2 = Type::Tiny->new(name => "Derived_1", parent => $t1);
+my $t3 = Type::Tiny->new(name => "Derived_2", parent => $t1, deprecated => 1);
+my $t4 = Type::Tiny->new(name => "Double_Derived_1", parent => $t3);
+my $t5 = Type::Tiny->new(name => "Double_Derived_2", parent => $t3, deprecated => 0);
+
+ok not $t1->deprecated;
+ok not $t2->deprecated;
+ok     $t3->deprecated;
+ok     $t4->deprecated;
+ok not $t5->deprecated;
+
+done_testing;