Skip to content

Commit

Permalink
tidy
Browse files Browse the repository at this point in the history
  • Loading branch information
@tobyink
tobyink committed Nov 17, 2020
1 parent b906fed commit a17ca5d
Show file tree
Hide file tree
Showing 2 changed files with 90 additions and 84 deletions.
173 changes: 90 additions & 83 deletions lib/Type/Tiny/XS.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,34 +8,37 @@ package Type::Tiny::XS;
our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION = '0.022';

__PACKAGE__->XSLoader::load($VERSION);
__PACKAGE__->XSLoader::load( $VERSION );

use Scalar::Util qw(refaddr);

my %names = (map +( $_ => __PACKAGE__ . "::$_" ), qw/
Any ArrayRef Bool ClassName CodeRef Defined
FileHandle GlobRef HashRef Int Num Object
Ref RegexpRef ScalarRef Str Undef Value
PositiveInt PositiveOrZeroInt NonEmptyStr
ArrayLike HashLike CodeLike StringLike
Map Tuple Enum AnyOf AllOf
/);
my %names = (
map +( $_ => __PACKAGE__ . "::$_" ), qw/
Any ArrayRef Bool ClassName CodeRef Defined
FileHandle GlobRef HashRef Int Num Object
Ref RegexpRef ScalarRef Str Undef Value
PositiveInt PositiveOrZeroInt NonEmptyStr
ArrayLike HashLike CodeLike StringLike
Map Tuple Enum AnyOf AllOf
/
);
$names{Item} = $names{Any};

my %coderefs;

sub _know {
my ($coderef, $type) = @_;
$coderefs{refaddr($coderef)} = $type;
my ( $coderef, $type ) = @_;
$coderefs{ refaddr( $coderef ) } = $type;
}

sub is_known {
my $coderef = shift;
$coderefs{refaddr($coderef)};
$coderefs{ refaddr( $coderef ) };
}

for (reverse sort keys %names) {
for ( reverse sort keys %names ) {
no strict qw(refs);
_know \&{$names{$_}}, $_;
_know \&{ $names{$_} }, $_;
}

my $id = 0;
Expand All @@ -45,138 +48,143 @@ sub get_coderef_for {

return do {
no strict qw(refs);
\&{ $names{$type} }
\&{ $names{$type} };
} if exists $names{$type};

my $made;

if ($type =~ /^ArrayRef\[(.+)\]$/) {
my $child = get_coderef_for($1) or return;
$made = _parameterize_ArrayRef_for($child);
if ( $type =~ /^ArrayRef\[(.+)\]$/ ) {
my $child = get_coderef_for( $1 ) or return;
$made = _parameterize_ArrayRef_for( $child );
}

elsif ($type =~ /^HashRef\[(.+)\]$/) {
my $child = get_coderef_for($1) or return;
$made = _parameterize_HashRef_for($child);
elsif ( $type =~ /^HashRef\[(.+)\]$/ ) {
my $child = get_coderef_for( $1 ) or return;
$made = _parameterize_HashRef_for( $child );
}

elsif ($type =~ /^Map\[(.+),(.+)\]$/) {
elsif ( $type =~ /^Map\[(.+),(.+)\]$/ ) {
my @children;
if (eval { require Type::Parser }) {
@children = map scalar(get_coderef_for($_)), _parse_parameters($type);
if ( eval { require Type::Parser } ) {
@children = map scalar( get_coderef_for( $_ ) ), _parse_parameters( $type );
}
else {
push @children, get_coderef_for($1);
push @children, get_coderef_for($2);
push @children, get_coderef_for( $1 );
push @children, get_coderef_for( $2 );
}
@children==2 or return;
defined or return for @children;
@children == 2 or return;
defined or return for @children;
$made = _parameterize_Map_for( \@children );
}
} #/ elsif ( $type =~ /^Map\[(.+),(.+)\]$/)

elsif ($type =~ /^(AnyOf|AllOf|Tuple)\[(.+)\]$/) {
elsif ( $type =~ /^(AnyOf|AllOf|Tuple)\[(.+)\]$/ ) {
my $base = $1;
my @children =
map scalar(get_coderef_for($_)),
(eval { require Type::Parser })
? _parse_parameters($type)
: split(/,/, $2);
map scalar( get_coderef_for( $_ ) ),
( eval { require Type::Parser } )
? _parse_parameters( $type )
: split( /,/, $2 );
defined or return for @children;
my $maker = __PACKAGE__->can("_parameterize_${base}_for");
$made = $maker->(\@children) if $maker;
}
my $maker = __PACKAGE__->can( "_parameterize_${base}_for" );
$made = $maker->( \@children ) if $maker;
} #/ elsif ( $type =~ /^(AnyOf|AllOf|Tuple)\[(.+)\]$/)

elsif ($type =~ /^Maybe\[(.+)\]$/) {
my $child = get_coderef_for($1) or return;
$made = _parameterize_Maybe_for($child);
elsif ( $type =~ /^Maybe\[(.+)\]$/ ) {
my $child = get_coderef_for( $1 ) or return;
$made = _parameterize_Maybe_for( $child );
}

elsif ($type =~ /^InstanceOf\[(.+)\]$/) {
elsif ( $type =~ /^InstanceOf\[(.+)\]$/ ) {
my $class = $1;
return unless Type::Tiny::XS::Util::is_valid_class_name($class);
$made = Type::Tiny::XS::Util::generate_isa_predicate_for($class);
return unless Type::Tiny::XS::Util::is_valid_class_name( $class );
$made = Type::Tiny::XS::Util::generate_isa_predicate_for( $class );
}

elsif ($type =~ /^HasMethods\[(.+)\]$/) {
my $methods = [ sort(split /,/, $1) ];
elsif ( $type =~ /^HasMethods\[(.+)\]$/ ) {
my $methods = [ sort( split /,/, $1 ) ];
/^[^\W0-9]\w*$/ or return for @$methods;
$made = Type::Tiny::XS::Util::generate_can_predicate_for($methods);
$made = Type::Tiny::XS::Util::generate_can_predicate_for( $methods );
}

# Type::Tiny::Enum > 1.010003 double-quotes its enums
elsif ($type =~ /^Enum\[".*"\]$/) {
if (eval { require Type::Parser }) {
my $parsed = Type::Parser::parse($type);
if ($parsed->{type} eq "parameterized") {
elsif ( $type =~ /^Enum\[".*"\]$/ ) {
if ( eval { require Type::Parser } ) {
my $parsed = Type::Parser::parse( $type );
if ( $parsed->{type} eq "parameterized" ) {
my @todo = $parsed->{params};
my @strings;
my $bad;
while (my $todo = shift @todo) {
if ($todo->{type} eq 'list') {
push @todo, @{$todo->{list}};
} elsif ($todo->{type} eq "expression" && $todo->{op}->type eq Type::Parser::COMMA()) {
while ( my $todo = shift @todo ) {
if ( $todo->{type} eq 'list' ) {
push @todo, @{ $todo->{list} };
}
elsif ( $todo->{type} eq "expression"
&& $todo->{op}->type eq Type::Parser::COMMA() )
{
push @todo, $todo->{lhs}, $todo->{rhs};
} elsif ($todo->{type} eq "primary" && $todo->{token}->type eq "QUOTELIKE") {
push @strings, eval($todo->{token}->spelling);
} else {
}
elsif ( $todo->{type} eq "primary" && $todo->{token}->type eq "QUOTELIKE" ) {
push @strings, eval( $todo->{token}->spelling );
}
else {
# Unexpected entry in the parse-tree, bail out
$bad = 1;
}
}
$made = _parameterize_Enum_for(\@strings) unless $bad;
}
}
}
} #/ while ( my $todo = shift ...)
$made = _parameterize_Enum_for( \@strings ) unless $bad;
} #/ if ( $parsed->{type} eq...)
} #/ if ( eval { require Type::Parser...})
} #/ elsif ( $type =~ /^Enum\[".*"\]$/)

elsif ($type =~ /^Enum\[(.+)\]$/) {
my $strings = [ sort(split /,/, $1) ];
$made = _parameterize_Enum_for($strings);
elsif ( $type =~ /^Enum\[(.+)\]$/ ) {
my $strings = [ sort( split /,/, $1 ) ];
$made = _parameterize_Enum_for( $strings );
}

if ($made) {
if ( $made ) {
no strict qw(refs);
my $slot = sprintf('%s::AUTO::TC%d', __PACKAGE__, ++$id);
my $slot = sprintf( '%s::AUTO::TC%d', __PACKAGE__, ++$id );
$names{$type} = $slot;
_know($made, $type);
_know( $made, $type );
*$slot = $made;
return $made;
}

return;
}
} #/ sub get_coderef_for

sub get_subname_for {
my $type = $_[0];
get_coderef_for($type) unless exists $names{$type};
get_coderef_for( $type ) unless exists $names{$type};
$names{$type};
}

sub _parse_parameters {
my $got = Type::Parser::parse(@_);
my $got = Type::Parser::parse( @_ );
$got->{params} or return;
_handle_expr($got->{params});
_handle_expr( $got->{params} );
}

sub _handle_expr {
my $e = shift;

if ($e->{type} eq 'list') {
return map _handle_expr($_), @{$e->{list}};
if ( $e->{type} eq 'list' ) {
return map _handle_expr( $_ ), @{ $e->{list} };
}
if ($e->{type} eq 'parameterized') {
my ($base) = _handle_expr($e->{base});
my @params = _handle_expr($e->{params});
return sprintf('%s[%s]', $base, join(q[,], @params));
if ( $e->{type} eq 'parameterized' ) {
my ( $base ) = _handle_expr( $e->{base} );
my @params = _handle_expr( $e->{params} );
return sprintf( '%s[%s]', $base, join( q[,], @params ) );
}
if ($e->{type} eq 'expression' and $e->{op}->type eq Type::Parser::COMMA()) {
return _handle_expr($e->{lhs}), _handle_expr($e->{rhs})
if ( $e->{type} eq 'expression' and $e->{op}->type eq Type::Parser::COMMA() ) {
return _handle_expr( $e->{lhs} ), _handle_expr( $e->{rhs} );
}
if ($e->{type} eq 'primary') {
if ( $e->{type} eq 'primary' ) {
return $e->{token}->spelling;
}

'****';
}
} #/ sub _handle_expr

1;

Expand Down Expand Up @@ -270,4 +278,3 @@ the same terms as the Perl 5 programming language system itself.
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
1 change: 0 additions & 1 deletion lib/Type/Tiny/XS/Util.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,4 +50,3 @@ the same terms as the Perl 5 programming language system itself.
THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

0 comments on commit a17ca5d

Please sign in to comment.