X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=101a34fa420ef612a865d49137fa883e2245f6f9;hb=d72d56ce74efe8558da8154d85aea834ff87dfc6;hp=4bcec7e94b0809302c309ddf265ebaf1aec2cdf2;hpb=096dbcecd7c2a600af8aa92c236dbc96b59373ca;p=p5sagit%2FFunction-Parameters.git

diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm
index 4bcec7e..101a34f 100644
--- a/lib/Function/Parameters.pm
+++ b/lib/Function/Parameters.pm
@@ -1,14 +1,13 @@
 package Function::Parameters;
 
 use v5.14.0;
-
 use warnings;
 
 use Carp qw(confess);
 
 use XSLoader;
 BEGIN {
-	our $VERSION = '1.0003';
+	our $VERSION = '1.0104';
 	XSLoader::load;
 }
 
@@ -21,35 +20,66 @@ 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};
 }
 
 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,
+		named_parameters     => 1,
+		types                => 1,
 	},
-	method   => {
-		name => 'optional',
-		default_arguments => 1,
+	method      => {
+		name                 => 'optional',
+		default_arguments    => 1,
 		check_argument_count => 0,
-		named_parameters => 1,
-		attrs => ':method',
-		shift => '$self',
-		invocant => 1,
+		named_parameters     => 1,
+		types                => 1,
+		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,
-		attributes => ':method',
-		shift => '$class',
-		invocant => 1,
+		named_parameters     => 1,
+		types                => 1,
+		attributes           => ':method',
+		shift                => '$class',
+		invocant             => 1,
 	},
 );
 for my $k (keys %type_map) {
@@ -116,6 +146,7 @@ sub import {
 		$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};
 
 		%type and confess "Invalid keyword property: @{[keys %type]}";
 
@@ -126,14 +157,15 @@ 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_CHECK_NARGS if $type->{check_argument_count};
-		$flags |= FLAG_INVOCANT if $type->{invocant};
-		$flags |= FLAG_NAMED_PARAMS if $type->{named_parameters};
+		$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};
 		$^H{HINTK_FLAGS_ . $kw} = $flags;
 		$^H{HINTK_SHIFT_ . $kw} = $type->{shift};
 		$^H{HINTK_ATTRS_ . $kw} = $type->{attrs};
@@ -155,6 +187,68 @@ sub unimport {
 }
 
 
+our %metadata;
+
+sub _register_info {
+	my (
+		$key,
+		$declarator,
+		$invocant,
+		$invocant_type,
+		$positional_required,
+		$positional_optional,
+		$named_required,
+		$named_optional,
+		$slurpy,
+		$slurpy_type,
+	) = @_;
+
+	my $info = {
+		declarator => $declarator,
+		invocant => defined $invocant ? [$invocant, $invocant_type] : undef,
+		slurpy   => defined $slurpy   ? [$slurpy  , $slurpy_type  ] : undef,
+		positional_required => $positional_required,
+		positional_optional => $positional_optional,
+		named_required => $named_required,
+		named_optional => $named_optional,
+	};
+
+	$metadata{$key} = $info;
+}
+
+sub _mkparam1 {
+	my ($pair) = @_;
+	my ($v, $t) = @{$pair || []} or return undef;
+	Function::Parameters::Param->new(
+		name => $v,
+		type => $t,
+	)
+}
+
+sub _mkparams {
+	my @r;
+	while (my ($v, $t) = splice @_, 0, 2) {
+		push @r, Function::Parameters::Param->new(
+			name => $v,
+			type => $t,
+		);
+	}
+	\@r
+}
+
+sub info {
+	my ($func) = @_;
+	my $key = _cv_root $func or return undef;
+	my $info = $metadata{$key} or return undef;
+	require Function::Parameters::Info;
+	Function::Parameters::Info->new(
+		keyword => $info->{declarator},
+		invocant => _mkparam1($info->{invocant}),
+		slurpy => _mkparam1($info->{slurpy}),
+		(map +("_$_" => _mkparams @{$info->{$_}}), glob '{positional,named}_{required,optional}')
+	)
+}
+
 'ok'
 
 __END__
@@ -526,9 +620,9 @@ L<C<Carp::croak>|Carp>.
 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,
  }
 
@@ -537,11 +631,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,
  }
 
@@ -549,11 +643,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,
  }
 
@@ -569,6 +663,21 @@ C<< use Function::Parameters { fun => 'function', method => 'method' } >>.
 C<use Function::Parameters qw(:strict)> is equivalent to
 C<< use Function::Parameters { fun => 'function_strict', method => 'method_strict' } >>.
 
+=head2 Introspection
+
+You can ask a function at runtime what parameters it has. This functionality is
+available through the function C<Function::Parameters::info> (which is not
+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>
 
 If you want to write a wrapper around C<Function::Parameters>, you only have to
@@ -582,6 +691,44 @@ affects the file that is currently being compiled.
    # or Function::Parameters->import(@custom_import_args);
  }
 
+=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:
+
+  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 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
+any values passed in conform to the type (via
+L<< C<< $constraint->check($value) >>|Moose::Meta::TypeConstraint/$constraint->check($value) >>).
+
+In addition, these type constraints are inspectable through the
+L<Function::Parameters::Info> object returned by
+L<C<Function::Parameters::info>|/Introspection>.
+
+=head2 Experimental experimental feature: Type expressions
+
+An even more experimental feature is the ability to specify arbitrary
+expressions as types. The syntax for this is like the literal types described
+above, but with an expression wrapped in parentheses (C<( EXPR )>). Example:
+
+  fun foo(('Int') $n, ($othertype) $x) { ... }
+
+Every type expression must return either a string (which is resolved as for
+literal types), or a L<type constraint object|Moose::Meta::TypeConstraint>
+(providing C<check> and C<get_message> methods).
+
+Note that these expressions are evaluated (once) at parse time (similar to
+C<BEGIN> blocks), so make sure that any variables you use are set and any
+functions you call are defined at parse time.
+
 =head2 How it works
 
 The module is actually written in L<C|perlxs> and uses
@@ -599,13 +746,50 @@ generated code corresponds to:
   # ... turns into ...
   sub bar :method { my $self = shift; my ($x, $y, @z) = @_; sub bar; ... }
 
+=head1 SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+    perldoc Function::Parameters
+
+You can also look for information at:
+
+=over
+
+=item MetaCPAN
+
+L<https://metacpan.org/module/Function%3A%3AParameters>
+
+=item RT, CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Function-Parameters>
+
+=item AnnoCPAN, Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Function-Parameters>
+
+=item CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Function-Parameters>
+
+=item Search CPAN
+
+L<http://search.cpan.org/dist/Function-Parameters/>
+
+=back
+
+=head1 SEE ALSO
+
+L<Function::Parameters::Info>
+
 =head1 AUTHOR
 
 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