X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=0f89fc29603d3a04a0ff1a238c91d5acea0a8966;hb=3746f91712a43dd4dde6e338f902ceb5ad0c7ad4;hp=a7d06c30bcf263ee0f7c498f84197d51c831ee7a;hpb=d54d249f6778acae4532a85f6ca279028ce15857;p=p5sagit%2FFunction-Parameters.git

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index a7d06c3..0f89fc2 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -1,16 +1,13 @@
 package Function::Parameters;
 
 use v5.14.0;
-
 use warnings;
 
 use Carp qw(confess);
 
 use XSLoader;
 BEGIN {
-	our $VERSION = '1.00_02';
-	our $XS_VERSION = $VERSION;
-	$VERSION = eval $VERSION;
+	our $VERSION = '1.0201';
 	XSLoader::load;
 }
 
@@ -23,38 +20,79 @@ sub _assert_valid_identifier {
 
 sub _assert_valid_attributes {
 	my ($attrs) = @_;
-	$attrs =~ /^\s*:\s*[^\W\d]\w*\s*(?:(?:\s|:\s*)[^\W\d]\w*\s*)*(?:\(|\z)/
-		or confess qq{"$attrs" doesn't look like valid attributes};
+	$attrs =~ m{
+		^ \s*+
+		: \s*+
+		(?&ident) (?! [^\s:(] ) (?&param)?+ \s*+
+		(?:
+			(?: : \s*+ )?
+			(?&ident) (?! [^\s:(] ) (?&param)?+ \s*+
+		)*+
+		\z
+
+		(?(DEFINE)
+			(?<ident>
+				[^\W\d]
+				\w*+
+			)
+			(?<param>
+				\(
+				[^()\\]*+
+				(?:
+					(?:
+						\\ .
+					|
+						(?&param)
+					)
+					[^()\\]*+
+				)*+
+				\)
+			)
+		)
+	}sx or confess qq{"$attrs" doesn't look like valid attributes};
+}
+
+sub _reify_type_default {
+	require Moose::Util::TypeConstraints;
+	Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0])
+}
+
+sub _delete_default {
+	my ($href, $key, $default) = @_;
+	exists $href->{$key} ? delete $href->{$key} : $default
 }
 
 my @bare_arms = qw(function method);
 my %type_map = (
-	function => {
-		name => 'optional',
-		default_arguments => 1,
+	function    => {
+		name                 => 'optional',
+		default_arguments    => 1,
 		check_argument_count => 0,
-		named_parameters => 1,
-		types => 1,
+		named_parameters     => 1,
+		types                => 1,
+		reify_type           => \&_reify_type_default,
 	},
-	method   => {
-		name => 'optional',
-		default_arguments => 1,
+	method      => {
+		name                 => 'optional',
+		default_arguments    => 1,
 		check_argument_count => 0,
-		named_parameters => 1,
-		types => 1,
-		attrs => ':method',
-		shift => '$self',
-		invocant => 1,
+		named_parameters     => 1,
+		types                => 1,
+		reify_type           => \&_reify_type_default,
+		attrs                => ':method',
+		shift                => '$self',
+		invocant             => 1,
 	},
-	classmethod   => {
-		name => 'optional',
-		default_arguments => 1,
+	classmethod => {
+		name                 => 'optional',
+		default_arguments    => 1,
 		check_argument_count => 0,
-		named_parameters => 1,
-		types => 1,
-		attributes => ':method',
-		shift => '$class',
-		invocant => 1,
+		named_parameters     => 1,
+		types                => 1,
+		reify_type           => \&_reify_type_default,
+		attributes           => ':method',
+		shift                => '$class',
+		invocant             => 1,
 	},
 );
 for my $k (keys %type_map) {
@@ -64,6 +102,8 @@ for my $k (keys %type_map) {
 	};
 }
 
+our @type_reifiers = \&_reify_type_default;
+
 sub import {
 	my $class = shift;
 
@@ -113,15 +153,30 @@ sub import {
 		$clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs);
 		_assert_valid_attributes $clean{attrs} if $clean{attrs};
 		
-		$clean{default_arguments} =
-			exists $type{default_arguments}
-			? !!delete $type{default_arguments}
-			: 1
-		;
-		$clean{check_argument_count} = !!delete $type{check_argument_count};
-		$clean{invocant} = !!delete $type{invocant};
-		$clean{named_parameters} = !!delete $type{named_parameters};
-		$clean{types} = !!delete $type{types};
+		$clean{default_arguments} = _delete_default \%type, 'default_arguments', 1;
+		$clean{named_parameters}  = _delete_default \%type, 'named_parameters',  1;
+		$clean{types}             = _delete_default \%type, 'types',             1;
+
+		$clean{check_argument_count} = _delete_default \%type, 'check_argument_count', 0;
+		$clean{invocant}             = _delete_default \%type, 'invocant',             0;
+
+		if (my $rt = delete $type{reify_type}) {
+			ref $rt eq 'CODE' or confess qq{"$rt" doesn't look like a type reifier};
+
+			my $index;
+			for my $i (0 .. $#type_reifiers) {
+				if ($type_reifiers[$i] == $rt) {
+					$index = $i;
+					last;
+				}
+			}
+			unless (defined $index) {
+				$index = @type_reifiers;
+				push @type_reifiers, $rt;
+			}
+
+			$clean{reify_type} = $index;
+		}
 
 		%type and confess "Invalid keyword property: @{[keys %type]}";
 
@@ -132,18 +187,19 @@ sub import {
 		my $type = $spec{$kw};
 
 		my $flags =
-			$type->{name} eq 'prohibited' ? FLAG_ANON_OK :
-			$type->{name} eq 'required' ? FLAG_NAME_OK :
-			FLAG_ANON_OK | FLAG_NAME_OK
+			$type->{name} eq 'prohibited' ? FLAG_ANON_OK                :
+			$type->{name} eq 'required'   ? FLAG_NAME_OK                :
+			                                FLAG_ANON_OK | FLAG_NAME_OK
 		;
-		$flags |= FLAG_DEFAULT_ARGS if $type->{default_arguments};
+		$flags |= FLAG_DEFAULT_ARGS                   if $type->{default_arguments};
 		$flags |= FLAG_CHECK_NARGS | FLAG_CHECK_TARGS if $type->{check_argument_count};
-		$flags |= FLAG_INVOCANT if $type->{invocant};
-		$flags |= FLAG_NAMED_PARAMS if $type->{named_parameters};
-		$flags |= FLAG_TYPES_OK if $type->{types};
+		$flags |= FLAG_INVOCANT                       if $type->{invocant};
+		$flags |= FLAG_NAMED_PARAMS                   if $type->{named_parameters};
+		$flags |= FLAG_TYPES_OK                       if $type->{types};
 		$^H{HINTK_FLAGS_ . $kw} = $flags;
 		$^H{HINTK_SHIFT_ . $kw} = $type->{shift};
 		$^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
+		$^H{HINTK_REIFY_ . $kw} = $type->{reify_type} // 0;
 		$^H{+HINTK_KEYWORDS} .= "$kw ";
 	}
 }
@@ -459,7 +515,7 @@ exchange the order of the arguments doesn't matter anymore. As with hash
 initialization, you can specify the same key multiple times and the last
 occurrence wins:
 
-  rectangle(height => 1, width => 2, height => 2, height => 5;
+  rectangle(height => 1, width => 2, height => 2, height => 5);
   # same as: rectangle(width => 2, height => 5);
 
 You can combine positional and named parameters as long as the positional
@@ -590,14 +646,31 @@ automatically check that they have been passed all required arguments and no
 excess arguments. If this check fails, an exception will by thrown via
 L<C<Carp::croak>|Carp>.
 
+Currently this flag is overloaded to also enable type checks (see
+L</Experimental feature: Types> below).
+
+=item C<reify_type>
+
+Valid values: code references. The function specified here will be called to
+turn type annotations into constraint objects (see
+L</Experimental feature: Types> below). It will receive two arguments: a string
+containing the type description, and the name of the current package.
+
+The default type reifier is equivalent to:
+
+ sub {
+     require Moose::Util::TypeConstraints;
+     Moose::Util::TypeConstraints::find_or_create_isa_type_constraint($_[0])
+ }
+
 =back
 
 The predefined type C<function> is equivalent to:
 
  {
-   name => 'optional',
-   invocant => 0,
-   default_arguments => 1,
+   name                 => 'optional',
+   invocant             => 0,
+   default_arguments    => 1,
    check_argument_count => 0,
  }
 
@@ -606,11 +679,11 @@ These are all default values, so C<function> is also equivalent to C<{}>.
 C<method> is equivalent to:
 
  {
-   name => 'optional',
-   shift => '$self',
-   invocant => 1,
-   attributes => ':method',
-   default_arguments => 1,
+   name                 => 'optional',
+   shift                => '$self',
+   invocant             => 1,
+   attributes           => ':method',
+   default_arguments    => 1,
    check_argument_count => 0,
  }
 
@@ -618,11 +691,11 @@ C<method> is equivalent to:
 C<classmethod> is equivalent to:
 
  {
-   name => 'optional',
-   shift => '$class',
-   invocant => 1,
-   attributes => ':method',
-   default_arguments => 1,
+   name                 => 'optional',
+   shift                => '$class',
+   invocant             => 1,
+   attributes           => ':method',
+   default_arguments    => 1,
    check_argument_count => 0,
  }
 
@@ -646,6 +719,11 @@ exported, so you have to call it by its full name). It takes a reference to a
 function, and returns either C<undef> (if it knows nothing about the function)
 or a L<Function::Parameters::Info> object describing the parameter list.
 
+Note: This feature is implemented using L<Moo>, so you'll need to have L<Moo>
+installed if you want to call C<Function::Parameters::info> (alternatively, if
+L<Moose> is already loaded by the time C<Function::Parameters::info> is first
+called, it will use that instead).
+
 See L<Function::Parameters::Info> for examples.
 
 =head2 Wrapping C<Function::Parameters>
@@ -664,15 +742,17 @@ affects the file that is currently being compiled.
 =head2 Experimental feature: Types
 
 An experimental feature is now available: You can annotate parameters with
-L<Moose types|Moose::Manual::Types>. That is, before each parameter you can put
-a type specification consisting of identifiers (C<Foo>), unions (C<... | ...>),
-and parametric types (C<...[...]>). Example:
+types. That is, before each parameter you can put a type specification
+consisting of identifiers (C<Foo>), unions (C<... | ...>), and parametric types
+(C<...[...]>). Example:
 
   fun foo(Int $n, ArrayRef[String | CodeRef] $cb) { ... }
 
-If you do this, L<Moose> will be loaded automatically (if that hasn't happened
-yet). These specifications are parsed and validated using
-L<C<Moose::Util::TypeConstraints::find_or_parse_type_constraint>|Moose::Util::TypeConstraints/find_or_parse_type_constraint>.
+If you do this, the type reification function corresponding to the keyword will
+be called to turn the type (a string) into a constraint object. The default
+type reifier simply loads L<Moose> and forwards to
+L<C<Moose::Util::TypeConstraints::find_or_parse_type_constraint>|Moose::Util::TypeConstraints/find_or_parse_type_constraint>,
+which creates L<Moose types|Moose::Manual::Types>.
 
 If you are in "lax" mode, nothing further happens and the types are ignored. If
 you are in "strict" mode, C<Function::Parameters> generates code to make sure
@@ -759,7 +839,7 @@ Lukas Mai, C<< <l.mai at web.de> >>
 
 =head1 COPYRIGHT & LICENSE
 
-Copyright 2010, 2011, 2012 Lukas Mai.
+Copyright 2010-2013 Lukas Mai.
 
 This program is free software; you can redistribute it and/or modify it
 under the terms of either: the GNU General Public License as published