rewrite attribute validation regex to check everything
[p5sagit/Function-Parameters.git] / lib / Function / Parameters.pm
index 69078dc..82d7486 100644 (file)
@@ -8,7 +8,7 @@ use Carp qw(confess);
 
 use XSLoader;
 BEGIN {
-       our $VERSION = '1.00_01';
+       our $VERSION = '1.0103_01';
        our $XS_VERSION = $VERSION;
        $VERSION = eval $VERSION;
        XSLoader::load;
@@ -23,8 +23,36 @@ 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);
@@ -34,12 +62,14 @@ my %type_map = (
                default_arguments => 1,
                check_argument_count => 0,
                named_parameters => 1,
+               types => 1,
        },
        method   => {
                name => 'optional',
                default_arguments => 1,
                check_argument_count => 0,
                named_parameters => 1,
+               types => 1,
                attrs => ':method',
                shift => '$self',
                invocant => 1,
@@ -49,6 +79,7 @@ my %type_map = (
                default_arguments => 1,
                check_argument_count => 0,
                named_parameters => 1,
+               types => 1,
                attributes => ':method',
                shift => '$class',
                invocant => 1,
@@ -118,6 +149,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]}";
 
@@ -133,9 +165,10 @@ sub import {
                        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_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};
@@ -157,6 +190,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__
@@ -571,6 +666,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
@@ -584,6 +694,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
@@ -601,13 +749,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