package Specio::Library::Builtins;
use strict;
use warnings;
our $VERSION = '0.42';
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'),
# no need to call parent - ref also checks for definedness
inline => sub { 'ref(' . $_[1] . ')' }
);
declare(
'Str',
parent => t('Value'),
inline => sub {
return sprintf( <<'EOF', ( $_[1] ) x 6 );
(
(
defined( %s )
&& !ref( %s )
&& (
( ref( \%s ) eq 'SCALAR' )
|| do { ( ref( \( my $val = %s ) ) eq 'SCALAR' ) }
)
)
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, q{""} )
)
)
EOF
}
);
my $value_type = t('Value');
declare(
'Num',
parent => t('Str'),
inline => sub {
return sprintf( <<'EOF', ( $_[1] ) x 5 );
(
(
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 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/ }
)
)
||
(
Scalar::Util::blessed( %s )
&& defined overload::Method( %s, '0+' )
&& do { ( my $val2 = %s + 0 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/ }
)
)
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 {
my $self = 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 {
my $self = 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 {
my $self = 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 {
my $self = 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
=head1 NAME
Specio::Library::Builtins - Implements type constraint objects for Perl's built-in types
=head1 VERSION
version 0.42
=head1 DESCRIPTION
This library provides a set of types parallel to those provided by Moose.
The types are in the following hierarchy
Item
Bool
Maybe (of `a)
Undef
Defined
Value
Str
Num
Int
ClassName
Ref
ScalarRef (of `a)
ArrayRef (of `a)
HashRef (of `a)
CodeRef
RegexpRef
GlobRef
FileHandle
Object
=head2 Item
Accepts any value
=head2 Bool
Accepts a non-reference that is C<undef>, an empty string, C<0>, or C<1>. It
also accepts any object which overloads boolification.
=head2 Maybe (of `a)
A parameterizable type which accepts C<undef> or the type C<`a>. If not
parameterized this type will accept any value.
=head2 Undef
Only accepts C<undef>.
=head2 Value
Accepts any non-reference value.
=head2 Str
Accepts any non-reference value or an object which overloads stringification.
=head2 Num
Accepts nearly the same values as C<Scalar::Util::looks_like_number>, but does
not accept numbers with leading or trailing spaces, infinities, or NaN. Also
accepts an object which overloads numification.
=head2 Int
Accepts any integer value, or an object which overloads numification and
numifies to an integer.
=head2 ClassName
Accepts any value which passes C<Str> where the string is a loaded package.
=head2 Ref
Accepts any reference.
=head2 ScalarRef (of `a)
Accepts a scalar reference or an object which overloads scalar
dereferencing. If parameterized, the dereferenced value must be of type C<`a>.
=head2 ArrayRef (of `a)
Accepts a array reference or an object which overloads array dereferencing. If
parameterized, the values in the arrayref must be of type C<`a>.
=head2 HashRef (of `a)
Accepts a hash reference or an object which overloads hash dereferencing. If
parameterized, the values in the hashref must be of type C<`a>.
=head2 CodeRef
Accepts a code (sub) reference or an object which overloads code
dereferencing.
=head2 RegexpRef
Accepts a regex object created by C<qr//> or an object which overloads
regex interpolation.
=head2 GlobRef
Accepts a glob reference or an object which overloads glob dereferencing.
=head2 FileHandle
Accepts a glob reference which is an open file handle, any C<IO::Handle>
Object or subclass, or an object which overloads glob dereferencing and
returns a glob reference which is an open file handle.
=head2 Object
Accepts any blessed object.
=head1 SUPPORT
Bugs may be submitted at L<https://github.com/houseabsolute/Specio/issues>.
I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
=head1 SOURCE
The source code repository for Specio can be found at L<https://github.com/houseabsolute/Specio>.
=head1 AUTHOR
Dave Rolsky <autarch@urth.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2012 - 2017 by Dave Rolsky.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
The full text of the license can be found in the
F<LICENSE> file included with this distribution.
=cut