Specio
view release on metacpan or search on metacpan
lib/Specio/Library/Builtins.pm view on Meta::CPAN
package Specio::Library::Builtins;
use strict;
use warnings;
our $VERSION = '0.51';
use parent 'Specio::Exporter';
use List::Util 1.33 ();
use overload ();
use re ();
use Scalar::Util ();
use Specio::Constraint::Parameterizable;
use Specio::Declare;
use Specio::Helpers ();
BEGIN {
local $@ = undef;
my $has_ref_util
= eval { require Ref::Util; Ref::Util->VERSION('0.112'); 1 };
sub _HAS_REF_UTIL () {$has_ref_util}
}
declare(
'Item',
inline => sub {'1'}
);
declare(
'Undef',
parent => t('Item'),
inline => sub {
'!defined(' . $_[1] . ')';
}
);
declare(
'Defined',
parent => t('Item'),
inline => sub {
'defined(' . $_[1] . ')';
}
);
declare(
'Bool',
parent => t('Item'),
inline => sub {
return sprintf( <<'EOF', ( $_[1] ) x 7 );
(
(
!ref( %s )
&& (
!defined( %s )
|| %s eq q{}
|| %s eq '1'
|| %s eq '0'
)
)
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, 'bool' )
)
)
EOF
}
);
declare(
'Value',
parent => t('Defined'),
inline => sub {
$_[0]->parent->inline_check( $_[1] ) . ' && !ref(' . $_[1] . ')';
}
);
declare(
'Ref',
parent => t('Defined'),
lib/Specio/Library/Builtins.pm view on Meta::CPAN
(
defined( %s )
&& !ref( %s )
&& (
do {
( my $val = %s ) =~
/\A
-?[0-9]+(?:\.[0-9]+)?
(?:[Ee][\-+]?[0-9]+)?
\z/x
}
)
)
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '0+' )
)
)
EOF
}
);
declare(
'Int',
parent => t('Num'),
inline => sub {
return sprintf( <<'EOF', ( $_[1] ) x 6 );
(
(
defined( %s )
&& !ref( %s )
&& (
do {
my $val1 = %s;
$val1 =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/
&& $val1 == int($val1)
}
)
)
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '0+' )
&& (
do {
my $val2 = %s + 0;
$val2 =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/
&& $val2 == int($val2)
}
)
)
)
EOF
}
);
{
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_plain_coderef(%s)'
: q{ref(%s) eq 'CODE'};
declare(
'CodeRef',
parent => t('Ref'),
inline => sub {
return sprintf( <<"EOF", ( $_[1] ) x 3 );
(
$ref_check
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '&{}' )
)
)
EOF
}
);
}
{
# This is a 5.8 back-compat shim stolen from Type::Tiny's Devel::Perl58Compat
# module.
unless ( exists &re::is_regexp || _HAS_REF_UTIL ) {
require B;
*re::is_regexp = sub {
## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
eval { B::svref_2object( $_[0] )->MAGIC->TYPE eq 'r' };
};
}
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_regexpref(%s)'
: 're::is_regexp(%s)';
declare(
'RegexpRef',
parent => t('Ref'),
inline => sub {
return sprintf( <<"EOF", ( $_[1] ) x 3 );
(
$ref_check
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, 'qr' )
)
)
EOF
},
);
}
{
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_plain_globref(%s)'
: q{ref( %s ) eq 'GLOB'};
declare(
'GlobRef',
parent => t('Ref'),
inline => sub {
return sprintf( <<"EOF", ( $_[1] ) x 3 );
(
$ref_check
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '*{}' )
)
)
EOF
}
);
}
{
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_plain_globref(%s)'
: q{ref( %s ) eq 'GLOB'};
# NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a
# filehandle
declare(
'FileHandle',
parent => t('Ref'),
inline => sub {
return sprintf( <<"EOF", ( $_[1] ) x 6 );
(
(
$ref_check
&& Scalar::Util::openhandle( %s )
)
||
(
Scalar::Util::blessed( %s )
&&
(
%s->isa('IO::Handle')
||
(
defined overload::Method( %s, '*{}' )
&& Scalar::Util::openhandle( *{ %s } )
)
)
)
)
EOF
}
);
}
{
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_blessed_ref(%s)'
: 'Scalar::Util::blessed(%s)';
declare(
'Object',
parent => t('Ref'),
inline => sub { sprintf( $ref_check, $_[1] ) },
);
}
declare(
'ClassName',
parent => t('Str'),
inline => sub {
return
sprintf(
<<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 2 );
(
( %s )
&& length "%s"
&& Specio::Helpers::is_class_loaded( "%s" )
)
EOF
},
);
{
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_plain_scalarref(%s) || Ref::Util::is_plain_refref(%s)'
: q{ref( %s ) eq 'SCALAR' || ref( %s ) eq 'REF'};
my $base_scalarref_check = sub {
return sprintf( <<"EOF", ( $_[0] ) x 4 );
(
(
$ref_check
)
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '\${}' )
)
)
EOF
};
declare(
'ScalarRef',
type_class => 'Specio::Constraint::Parameterizable',
parent => t('Ref'),
inline => sub { $base_scalarref_check->( $_[1] ) },
parameterized_inline_generator => sub {
shift;
my $parameter = shift;
my $val = shift;
return sprintf(
'( ( %s ) && ( %s ) )',
$base_scalarref_check->($val),
$parameter->inline_check( '${' . $val . '}' ),
);
}
);
}
{
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_plain_arrayref(%s)'
: q{ref( %s ) eq 'ARRAY'};
my $base_arrayref_check = sub {
return sprintf( <<"EOF", ( $_[0] ) x 3 );
(
$ref_check
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '\@{}' )
)
)
EOF
};
declare(
'ArrayRef',
type_class => 'Specio::Constraint::Parameterizable',
parent => t('Ref'),
inline => sub { $base_arrayref_check->( $_[1] ) },
parameterized_inline_generator => sub {
shift;
my $parameter = shift;
my $val = shift;
return sprintf(
'( ( %s ) && ( List::Util::all { %s } @{ %s } ) )',
$base_arrayref_check->($val),
$parameter->inline_check('$_'),
$val,
);
}
);
}
{
my $ref_check
= _HAS_REF_UTIL
? 'Ref::Util::is_plain_hashref(%s)'
: q{ref( %s ) eq 'HASH'};
my $base_hashref_check = sub {
return sprintf( <<"EOF", ( $_[0] ) x 3 );
(
$ref_check
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '%%{}' )
)
)
EOF
};
declare(
'HashRef',
type_class => 'Specio::Constraint::Parameterizable',
parent => t('Ref'),
inline => sub { $base_hashref_check->( $_[1] ) },
parameterized_inline_generator => sub {
shift;
my $parameter = shift;
my $val = shift;
return sprintf(
'( ( %s ) && ( List::Util::all { %s } values %%{ %s } ) )',
$base_hashref_check->($val),
$parameter->inline_check('$_'),
$val,
);
}
);
}
declare(
'Maybe',
type_class => 'Specio::Constraint::Parameterizable',
parent => t('Item'),
inline => sub {'1'},
parameterized_inline_generator => sub {
shift;
my $parameter = shift;
my $val = shift;
return sprintf( <<'EOF', $val, $parameter->inline_check($val) );
( !defined( %s ) || ( %s ) )
EOF
},
);
1;
# ABSTRACT: Implements type constraint objects for Perl's built-in types
__END__
=pod
=encoding UTF-8
( run in 0.306 second using v1.01-cache-2.11-cpan-2b0bae70ee8 )