[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