[libtype-tiny-perl] 37/46: improvements to dwim_type

Jonas Smedegaard dr at jones.dk
Fri Sep 12 18:48:05 UTC 2014


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

js pushed a commit to tag 1.001_000
in repository libtype-tiny-perl.

commit 23060c05fe1210a8eb33ef41be3d2553933c67ba
Author: Toby Inkster <mail at tobyinkster.co.uk>
Date:   Sun Sep 7 16:39:58 2014 +0100

    improvements to dwim_type
---
 lib/Type/Utils.pm                 | 151 +++++++++++++++++++++++++-------------
 t/20-unit/Type-Utils/dwim-moose.t |   3 +
 t/20-unit/Type-Utils/dwim-mouse.t |   5 ++
 3 files changed, 108 insertions(+), 51 deletions(-)

diff --git a/lib/Type/Utils.pm b/lib/Type/Utils.pm
index 5b7c08f..67d6f2a 100644
--- a/lib/Type/Utils.pm
+++ b/lib/Type/Utils.pm
@@ -476,11 +476,46 @@ sub classifier
 		my $r = $self->SUPER::foreign_lookup(@_);
 		return $r if $r;
 		
-		if (defined($self->{"~~assume"})
+		if (my $assume = $self->{"~~assume"}
 		and $_[0] =~ /[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/)
 		{
-			my $method = $self->{"~~assume"};
-			return $self->$method(@_);
+			my @methods = ref($assume) ? @$assume : $assume;
+			
+			for my $method (@methods) 
+			{
+				$r = $self->$method(@_);
+				return $r if $r;
+			}
+		}
+		
+		return;
+	}
+	
+	sub lookup_via_moose
+	{
+		my $self = shift;
+		
+		if ($INC{'Moose.pm'})
+		{
+			require Moose::Util::TypeConstraints;
+			require Types::TypeTiny;
+			my $r = Moose::Util::TypeConstraints::find_type_constraint($_[0]);
+			return Types::TypeTiny::to_TypeTiny($r) if defined $r;
+		}
+		
+		return;
+	}
+	
+	sub lookup_via_mouse
+	{
+		my $self = shift;
+		
+		if ($INC{'Mouse.pm'})
+		{
+			require Mouse::Util::TypeConstraints;
+			require Types::TypeTiny;
+			my $r = Mouse::Util::TypeConstraints::find_type_constraint($_[0]);
+			return Types::TypeTiny::to_TypeTiny($r) if defined $r;
 		}
 		
 		return;
@@ -508,30 +543,6 @@ sub classifier
 		# Only continue any further if we've been called from Type::Parser.
 		return unless $_[1];
 		
-		my $moose_lookup = sub
-		{
-			if ($INC{'Moose.pm'})
-			{
-				require Moose::Util::TypeConstraints;
-				require Types::TypeTiny;
-				$r = Moose::Util::TypeConstraints::find_type_constraint($_[0]);
-				$r = Types::TypeTiny::to_TypeTiny($r) if defined $r;
-			}
-			defined $r;
-		};
-		
-		my $mouse_lookup = sub
-		{
-			if ($INC{'Mouse.pm'})
-			{
-				require Mouse::Util::TypeConstraints;
-				require Types::TypeTiny;
-				$r = Mouse::Util::TypeConstraints::find_type_constraint($_[0]);
-				$r = Types::TypeTiny::to_TypeTiny($r) if defined $r;
-			}
-			defined $r;
-		};
-		
 		my $meta;
 		if (defined $self->{"~~chained"})
 		{
@@ -541,16 +552,14 @@ sub classifier
 		
 		if ($meta and $meta->isa('Class::MOP::Module'))
 		{
-			$moose_lookup->(@_) and return $r;
+			$r = $self->lookup_via_moose(@_);
+			return $r if $r;
 		}
+		
 		elsif ($meta and $meta->isa('Mouse::Meta::Module'))
 		{
-			$mouse_lookup->(@_) and return $r;
-		}
-		else
-		{
-			$moose_lookup->(@_) and return $r;
-			$mouse_lookup->(@_) and return $r;
+			$r = $self->lookup_via_mouse(@_);
+			return $r if $r;
 		}
 		
 		return $self->foreign_lookup(@_);
@@ -569,9 +578,20 @@ sub dwim_type
 	};
 	
 	local $dwimmer->{'~~chained'} = $opts{for};
-	local $dwimmer->{'~~assume'}  = $opts{does} ? 'make_role_type' : 'make_class_type';
+	local $dwimmer->{'~~assume'}  = $opts{fallback} || [
+		qw/ lookup_via_moose lookup_via_mouse /,
+		$opts{does} ? 'make_role_type' : 'make_class_type',
+	];
+	
+	local $@ = undef;
+	my $type;
+	unless (eval { $type = $dwimmer->lookup($string); 1 })
+	{
+		my $e = $@;
+		die($e) unless $e =~ /not a known type constraint/;
+	}
 	
-	$dwimmer->lookup($string);
+	$type;
 }
 
 sub english_list
@@ -978,25 +998,54 @@ object, hopefully doing what you mean.
 
 It uses the syntax of L<Type::Parser>. Firstly the L<Type::Registry>
 for the caller package is consulted; if that doesn't have a match,
-L<Types::Standard> is consulted for type constraint names; and if
-there's still no match, then if a type constraint looks like a class
-name, a new L<Type::Tiny::Class> object is created for it.
+L<Types::Standard> is consulted for standard type constraint names.
+
+If none of the above yields a type constraint, and the caller class
+is a Moose-based class, then C<dwim_type> attempts to look the type
+constraint up in the Moose type registry. If it's a Mouse-based class,
+then the Mouse type registry is used instead.
+
+If no type constraint can be found via these normal methods, several
+fallbacks are available:
+
+=over
+
+=item C<lookup_via_moose>
+
+Lookup in Moose registry even if caller is non-Moose class.
+
+=item C<lookup_via_mouse>
 
-Somewhere along the way, it also checks Moose/Mouse's type constraint
-registries if they are loaded.
+Lookup in Mouse registry even if caller is non-Mouse class.
+
+=item C<make_class_type>
+
+Create a new Type::Tiny::Class constraint.
+
+=item C<make_role_type>
+
+Create a new Type::Tiny::Role constraint.
+
+=back
+
+You can alter which should be attempted, and in which order, by passing
+an option to C<dwim_type>:
+
+   my $type = Type::Utils::dwim_type(
+      "ArrayRef[Int]",
+      fallback      => [ "lookup_via_mouse" , "make_role_type" ],
+   );
+
+For historical reasons, by default the fallbacks attempted are:
+
+   lookup_via_moose, lookup_via_mouse, make_class_type
+
+You may set C<fallback> to an empty arrayref to avoid using any of
+these fallbacks.
 
 You can specify an alternative for the caller using the C<for> option.
-If you'd rather create a L<Type::Tiny::Role> object, set the C<does>
-option to true.
 
-   # An arrayref of objects, each of which must do role Foo.
-   my $type = dwim_type("ArrayRef[Foo]", does => 1);
-   
-   Type::Registry->for_me->add_types("-Standard");
-   Type::Registry->for_me->alias_type("Int" => "Foo");
-   
-   # An arrayref of integers.
-   my $type = dwim_type("ArrayRef[Foo]", does => 1);
+   my $type = dwim_type("ArrayRef", for => "Moose::Object");
 
 While it's probably better overall to use the proper L<Type::Registry>
 interface for resolving type constraint strings, this function often does
diff --git a/t/20-unit/Type-Utils/dwim-moose.t b/t/20-unit/Type-Utils/dwim-moose.t
index ac55363..adab841 100644
--- a/t/20-unit/Type-Utils/dwim-moose.t
+++ b/t/20-unit/Type-Utils/dwim-moose.t
@@ -83,6 +83,9 @@ should_fail([3, 4, 3], $threes);
 	should_pass([bless({}, $testclass)], $fallbackp);
 	should_pass([], $fallbackp);
 	should_fail([bless({}, 'main')], $fallbackp);
+	
+	my $fallbacku = dwim_type("ArrayRef[$testclass]", fallback => []);
+	is($fallbacku, undef);
 }
 
 {
diff --git a/t/20-unit/Type-Utils/dwim-mouse.t b/t/20-unit/Type-Utils/dwim-mouse.t
index b281b9f..3cac698 100644
--- a/t/20-unit/Type-Utils/dwim-mouse.t
+++ b/t/20-unit/Type-Utils/dwim-mouse.t
@@ -83,6 +83,9 @@ should_fail([3, 4, 3], $threes);
 	should_pass([bless({}, $testclass)], $fallbackp);
 	should_pass([], $fallbackp);
 	should_fail([bless({}, 'main')], $fallbackp);
+	
+	my $fallbacku = dwim_type("ArrayRef[$testclass]", fallback => []);
+	is($fallbacku, undef);
 }
 
 {
@@ -97,4 +100,6 @@ should_fail([3, 4, 3], $threes);
 	should_fail([bless({}, 'main')], $fallbackp);
 }
 
+
+
 done_testing;

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



More information about the Pkg-perl-cvs-commits mailing list