[libtype-tiny-perl] 02/14: add Type::Utils::classifier

[Jonas Smedegaard]

This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.043_03
in repository libtype-tiny-perl.

commit 4a7a29c0b852893cd9d309909655a627805eae73
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Tue Apr 15 12:06:08 2014 +0100

    add Type::Utils::classifier
---
 lib/Type/Utils.pm                 | 39 +++++++++++++++++++++++++++
 t/20-unit/Type-Utils/classifier.t | 56 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+)

diff --git a/lib/Type/Utils.pm b/lib/Type/Utils.pm
index 01fd405..5a6f378 100644
--- a/lib/Type/Utils.pm
+++ b/lib/Type/Utils.pm
@@ -28,6 +28,7 @@ our @EXPORT_OK = (
 		extends type subtype
 		match_on_type compile_match_on_type
 		dwim_type english_list
+		classifier
 	>,
 );
 
@@ -444,6 +445,23 @@ sub compile_match_on_type
 	);
 }
 
+sub classifier
+{
+	my $i;
+	compile_match_on_type(
+		+(
+			map {
+				my $type = $_->[0];
+				$type => sub { $type };
+			}
+			sort { $b->[1] <=> $a->[1] or $a->[2] <=> $b->[2] }
+			map [$_, scalar(my @parents = $_->parents), ++$i],
+			@_
+		),
+		q[ undef ],
+	);
+}
+
 {
 	package #hide
 	Type::Registry::DWIM;
@@ -903,6 +921,27 @@ are good for this. (Same sort of idea as L<Type::Params>.)
 
 This function is not exported by default.
 
+=item C<< my $coderef = classifier(@types) >>
+
+Returns a coderef that can be used to classify values according to their
+type constraint. The coderef, when passed a value, returns a type
+constraint which the value satisfies.
+
+   use feature qw( say );
+   use Type::Utils qw( classifier );
+   use Types::Standard qw( Int Num Str Any );
+   
+   my $classifier = classifier(Str, Int, Num, Any);
+   
+   say $classifier->( "42"  )->name;   # Int
+   say $classifier->( "4.2" )->name;   # Num
+   say $classifier->( []    )->name;   # Any
+
+Note that, for example, "42" satisfies Int, but it would satisfy the
+type constraints Num, Str, and Any as well. In this case, the
+classifier has picked the most specific type constraint that "42"
+satisfies.
+
 =item C<< dwim_type($string, %options) >>
 
 Given a string like "ArrayRef[Int|CodeRef]", turns it into a type constraint
diff --git a/t/20-unit/Type-Utils/classifier.t b/t/20-unit/Type-Utils/classifier.t
new file mode 100644
index 0000000..37a5f0b
--- /dev/null
+++ b/t/20-unit/Type-Utils/classifier.t
@@ -0,0 +1,56 @@
+=pod
+
+=encoding utf-8
+
+=head1 PURPOSE
+
+Test L<Type::Utils> C<classifier> function.
+
+=head1 AUTHOR
+
+Toby Inkster E<lt>tobyink at cpan.orgE<gt>.
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2014 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 Test::More;
+
+use Type::Utils qw( classifier );
+use Types::Standard -types;
+
+my $classify = classifier(Num, Str, Int, Ref, ArrayRef, HashRef, Any, InstanceOf['Type::Tiny']);
+
+sub classified ($$)
+{
+	my $got       = $classify->($_[0]);
+	my $expected  = $_[1];
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+	is(
+		$got->name,
+		$expected->name,
+		sprintf("%s classified as %s", Type::Tiny::_dd($_[0]), $expected),
+	);
+}
+
+classified(42, Int);
+classified(1.1, Num);
+classified("Hello world", Str);
+classified("42", Int);
+classified("1.1", Num);
+classified((\(my $x)), Ref);
+classified([], ArrayRef);
+classified({}, HashRef);
+classified(undef, Any);
+classified(Num, InstanceOf['Type::Tiny']);
+
+done_testing;

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libtype-tiny-perl.git