X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FFunction%2FParameters.pm;h=0f89fc29603d3a04a0ff1a238c91d5acea0a8966;hb=3746f91712a43dd4dde6e338f902ceb5ad0c7ad4;hp=fd8c459506d9779c78b87fe1e0a63e0ae14c2c41;hpb=fb3ea8633b25d6fbf244e36c0936ea7d960a85c2;p=p5sagit%2FFunction-Parameters.git diff --git a/lib/Function/Parameters.pm b/lib/Function/Parameters.pm index fd8c459..0f89fc2 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.00'; + our $VERSION = '1.0201'; XSLoader::load; } @@ -21,35 +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:(] ) (?¶m)?+ \s*+ + (?: + (?: : \s*+ )? + (?&ident) (?! [^\s:(] ) (?¶m)?+ \s*+ + )*+ + \z + + (?(DEFINE) + (? + [^\W\d] + \w*+ + ) + (? + \( + [^()\\]*+ + (?: + (?: + \\ . + | + (?¶m) + ) + [^()\\]*+ + )*+ + \) + ) + ) + }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, + 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, - 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, - 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) { @@ -59,6 +102,8 @@ for my $k (keys %type_map) { }; } +our @type_reifiers = \&_reify_type_default; + sub import { my $class = shift; @@ -108,14 +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{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]}"; @@ -126,17 +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_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}; + $^H{HINTK_REIFY_ . $kw} = $type->{reify_type} // 0; $^H{+HINTK_KEYWORDS} .= "$kw "; } } @@ -155,6 +218,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__ @@ -390,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 @@ -521,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|Carp>. +Currently this flag is overloaded to also enable type checks (see +L below). + +=item C + +Valid values: code references. The function specified here will be called to +turn type annotations into constraint objects (see +L 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 is equivalent to: { - name => 'optional', - invocant => 0, - default_arguments => 1, + name => 'optional', + invocant => 0, + default_arguments => 1, check_argument_count => 0, } @@ -537,11 +679,11 @@ These are all default values, so C is also equivalent to C<{}>. C 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 +691,11 @@ C is equivalent to: C 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 +711,21 @@ C<< use Function::Parameters { fun => 'function', method => 'method' } >>. C 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 (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 (if it knows nothing about the function) +or a L object describing the parameter list. + +Note: This feature is implemented using L, so you'll need to have L +installed if you want to call C (alternatively, if +L is already loaded by the time C is first +called, it will use that instead). + +See L for examples. + =head2 Wrapping C If you want to write a wrapper around C, you only have to @@ -582,6 +739,46 @@ 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 +types. That is, before each parameter you can put a type specification +consisting of identifiers (C), unions (C<... | ...>), and parametric types +(C<...[...]>). Example: + + fun foo(Int $n, ArrayRef[String | CodeRef] $cb) { ... } + +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 and forwards to +L|Moose::Util::TypeConstraints/find_or_parse_type_constraint>, +which creates L. + +If you are in "lax" mode, nothing further happens and the types are ignored. If +you are in "strict" mode, C 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 object returned by +L|/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 +(providing C and C methods). + +Note that these expressions are evaluated (once) at parse time (similar to +C 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 and uses @@ -599,13 +796,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 + +=item RT, CPAN's request tracker + +L + +=item AnnoCPAN, Annotated CPAN documentation + +L + +=item CPAN Ratings + +L + +=item Search CPAN + +L + +=back + +=head1 SEE ALSO + +L + =head1 AUTHOR Lukas Mai, C<< >> =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