package Function::Parameters;
use v5.14.0;
-
use warnings;
use Carp qw(confess);
use XSLoader;
BEGIN {
- our $VERSION = '1.0003';
+ our $VERSION = '1.0202';
XSLoader::load;
}
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)
+ (?<ident>
+ [^\W\d]
+ \w*+
+ )
+ (?<param>
+ \(
+ [^()\\]*+
+ (?:
+ (?:
+ \\ .
+ |
+ (?¶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,
- check_argument_count => 0,
- named_parameters => 1,
+ function => {}, # all default settings
+ function_strict => {
+ defaults => 'function',
+ strict => 1,
},
- method => {
- name => 'optional',
- default_arguments => 1,
- check_argument_count => 0,
- named_parameters => 1,
- attrs => ':method',
- shift => '$self',
- invocant => 1,
- },
- classmethod => {
- name => 'optional',
- default_arguments => 1,
- check_argument_count => 0,
- named_parameters => 1,
+ method => {
+ defaults => 'function',
attributes => ':method',
- shift => '$class',
- invocant => 1,
+ shift => '$self',
+ invocant => 1,
+ },
+ method_strict => {
+ defaults => 'method',
+ strict => 1,
+ },
+ classmethod => {
+ defaults => 'method',
+ shift => '$class',
+ },
+ classmethod_strict => {
+ defaults => 'classmethod',
+ strict => 1,
},
);
-for my $k (keys %type_map) {
- $type_map{$k . '_strict'} = {
- %{$type_map{$k}},
- check_argument_count => 1,
- };
-}
+
+our @type_reifiers = \&_reify_type_default;
sub import {
my $class = shift;
my ($name, $proto_type) = @$item;
_assert_valid_identifier $name;
- unless (ref $proto_type) {
- # use '||' instead of 'or' to preserve $proto_type in the error message
- $proto_type = $type_map{$proto_type}
- || confess qq["$proto_type" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
- }
+ $proto_type = {defaults => $proto_type} unless ref $proto_type;
my %type = %$proto_type;
+ while (my $defaults = delete $type{defaults}) {
+ my $base = $type_map{$defaults}
+ or confess qq["$defaults" doesn't look like a valid type (one of ${\join ', ', sort keys %type_map})];
+ %type = (%$base, %type);
+ }
+
my %clean;
- $clean{name} = delete $type{name} || 'optional';
+ $clean{name} = delete $type{name} // 'optional';
$clean{name} =~ /^(?:optional|required|prohibited)\z/
or confess qq["$clean{name}" doesn't look like a valid name attribute (one of optional, required, prohibited)];
- $clean{shift} = delete $type{shift} || '';
+ $clean{shift} = delete $type{shift} // '';
_assert_valid_identifier $clean{shift}, 1 if $clean{shift};
- $clean{attrs} = join ' ', map delete $type{$_} || (), qw(attributes attrs);
+ $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{invocant} = _delete_default \%type, 'invocant', 0;
+ $clean{check_argument_count} = _delete_default \%type, 'check_argument_count', 0;
+ $clean{check_argument_types} = _delete_default \%type, 'check_argument_types', 0;
+ $clean{check_argument_count} = $clean{check_argument_types} = 1 if delete $type{strict};
+
+ 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]}";
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_CHECK_NARGS if $type->{check_argument_count};
+ $flags |= FLAG_CHECK_TARGS if $type->{check_argument_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 ";
}
}
$key,
$declarator,
$invocant,
+ $invocant_type,
$positional_required,
$positional_optional,
$named_required,
$named_optional,
$slurpy,
+ $slurpy_type,
) = @_;
- my $blob = pack '(Z*)*',
- $declarator,
- $invocant // '',
- join(' ', @$positional_required),
- join(' ', @$positional_optional),
- join(' ', @$named_required),
- join(' ', @$named_optional),
- $slurpy // '',
- ;
-
- $metadata{$key} = $blob;
+ 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 $blob = $metadata{$key} or return undef;
- my @info = unpack '(Z*)*', $blob;
+ my $info = $metadata{$key} or return undef;
require Function::Parameters::Info;
Function::Parameters::Info->new(
- keyword => $info[0],
- invocant => $info[1] || undef,
- _positional_required => [split ' ', $info[2]],
- _positional_optional => [split ' ', $info[3]],
- _named_required => [split ' ', $info[4]],
- _named_optional => [split ' ', $info[5]],
- slurpy => $info[6] || undef,
+ keyword => $info->{declarator},
+ invocant => _mkparam1($info->{invocant}),
+ slurpy => _mkparam1($info->{slurpy}),
+ (map +("_$_" => _mkparams @{$info->{$_}}), glob '{positional,named}_{required,optional}')
)
}
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
=over
+=item C<defaults>
+
+Valid values: One of the predefined types C<function>, C<method>,
+C<classmethod>, C<function_strict>, C<method_strict>, C<classmethod_strict>.
+This will set the defaults for all other keys from the specified type, which is
+useful if you only want to override some properties:
+
+ use Function::Parameters { defmethod => { defaults => 'method', shift => '$this' } };
+
+This example defines a keyword called C<defmethod> that works like the standard
+C<method> keyword, but the implicit object variable is called C<$this> instead
+of C<$self>.
+
+Using the string types directly is equivalent to C<defaults> with no further
+customization:
+
+ use Function::Parameters {
+ foo => 'function', # like: foo => { defaults => 'function' },
+ bar => 'function_strict', # like: bar => { defaults => 'function_strict' },
+ baz => 'method_strict', # like: baz => { defaults => 'method_strict' },
+ };
+
=item C<name>
Valid values: C<optional> (default), C<required> (all functions defined with
excess arguments. If this check fails, an exception will by thrown via
L<C<Carp::croak>|Carp>.
+=item C<check_argument_types>
+
+Valid values: booleans. If turned on, functions defined with this keyword will
+automatically check that the arguments they are passed pass the declared type
+constraints (if any). See L</Experimental feature: Types> below.
+
+=item C<strict>
+
+Valid values: booleans. This turns on both C<check_argument_count> and
+C<check_argument_types>.
+
+=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,
+ name => 'optional',
default_arguments => 1,
- check_argument_count => 0,
+ strict => 0,
+ invocant => 0,
}
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,
- check_argument_count => 0,
+ defaults => 'function',
+ attributes => ':method',
+ shift => '$self',
+ invocant => 1,
}
C<classmethod> is equivalent to:
{
- name => 'optional',
- shift => '$class',
- invocant => 1,
- attributes => ':method',
- default_arguments => 1,
- check_argument_count => 0,
+ defaults => 'method',
+ shift => '$class',
}
C<function_strict>, C<method_strict>, and
C<classmethod_strict> are like C<function>, C<method>, and
-C<classmethod>, respectively, but with C<< check_argument_count => 1 >>.
+C<classmethod>, respectively, but with C<< strict => 1 >>.
=back
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>.
+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.
# 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<Foo>), unions (C<... | ...>), and parametric types
+(C<...[...]>). Example:
+
+ fun foo(Int $n, ArrayRef[Str | 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<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
+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
# ... 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 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