The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Type::Library::Builtins;
{
  $Type::Library::Builtins::VERSION = '0.05'; # TRIAL
}

use strict;
use warnings;

use parent 'Type::Exporter';

use Class::Load qw( is_class_loaded );
use List::MoreUtils ();
use overload        ();
use re qw( is_regexp );
use Scalar::Util    ();
use Type::Constraint::Parameterizable;
use Type::Declare;

declare(
    'Any',
    inline => sub { '1' }
);

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 {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . ' overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "bool")' . ' : ('
            . '!defined('
            . $_[1] . ') ' . '|| '
            . $_[1]
            . ' eq "" ' . '|| ('
            . $_[1]
            . '."") eq "1" ' . '|| ('
            . $_[1]
            . '."") eq "0"' . ')';
    }
);

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 {
        'Scalar::Util::blessed('
            . $_[1] . ')'
            . ' && overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', q{""})'
            . ' ? 1 : '
            . $_[0]->parent()->inline_check( $_[1] ) . ' && '
            . '( ref(\\'
            . $_[1]
            . ') eq "SCALAR"'
            . ' || ref(\\(my $val = '
            . $_[1]
            . ')) eq "SCALAR"' . ')';
    }
);

my $value_type = t('Value');
declare(
    'Num',
    parent => t('Str'),
    inline => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . ' overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "0+")' . ' : ( '
            . $value_type->inline_check( $_[1] )
            . ' && ( my $val = '
            . $_[1]
            . ' ) =~ /\\A-?[0-9]+(?:\\.[0-9]+)?\\z/ )';
    }
);

declare(
    'Int',
    parent => t('Num'),
    inline => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . ' overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "0+") && '
            . ' ( ( my $val1 = '
            . $_[1]
            . ' + 0 ) =~ /\A-?[0-9]+\z/ )'
            . ' : ( ( '
            . $value_type->inline_check( $_[1] )
            . ') && ( my $val2 = '
            . $_[1]
            . ' ) =~ /\A-?[0-9]+\z/ )';
    }
);

declare(
    'CodeRef',
    parent => t('Ref'),
    inline => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . ' overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "&{}") '
            . ' : ref('
            . $_[1]
            . ') eq "CODE"';
    },
);

declare(
    'RegexpRef',
    parent => t('Ref'),
    inline => sub {
        '( Scalar::Util::blessed('
            . $_[1] . ') && '
            . ' overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "qr") ) || '
            . 're::is_regexp('
            . $_[1] . ')';
    },
);

declare(
    'GlobRef',
    parent => t('Ref'),
    inline => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . 'overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "*{}") '
            . ' : ( ref('
            . $_[1]
            . ') eq "GLOB" )';
    },
);

# NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a
# filehandle
declare(
    'FileHandle',
    parent => t('Ref'),
    inline => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . $_[1]
            . '->isa("IO::Handle") || '
            . '( overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "*{}") '
            . '&& Scalar::Util::openhandle( *{'
            . $_[1] . '} ) )'
            . ' : ref('
            . $_[1]
            . ') eq "GLOB" '
            . '&& Scalar::Util::openhandle('
            . $_[1] . ')';
    },
);

declare(
    'Object',
    parent => t('Ref'),
    inline => sub { 'Scalar::Util::blessed(' . $_[1] . ')' },
);

declare(
    'ClassName',
    parent => t('Str'),
    inline => sub {
        'defined( '
            . $_[1]
            . ') && Class::Load::is_class_loaded("'
            . $_[1] . '")';
    },
);

declare(
    'ScalarRef',
    type_class => 'Type::Constraint::Parameterizable',
    parent     => t('Ref'),
    inline     => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . 'overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "\\${}") '
            . ' : ref( '
            . $_[1]
            . q{ ) eq 'SCALAR' || ref( }
            . $_[1]
            . q{ ) eq 'REF' };
    },
    parameterized_inline_generator => sub {
        my $self      = shift;
        my $parameter = shift;
        my $val       = shift;

        return
              'Scalar::Util::blessed(' 
            . $val . ') ? '
            . 'overload::Overloaded('
            . $val
            . ') && defined overload::Method('
            . $val
            . ', "\\${}") ' . ' && '
            . $parameter->inline_check( '${ ( ' . $val . ' ) }' )
            . ' : ( ref( '
            . $val
            . q{ ) eq 'SCALAR' || ref( }
            . $val
            . q{ ) eq 'REF' ) } . ' && '
            . $parameter->inline_check( '${ ( ' . $val . ' ) }' );
    },
);

declare(
    'ArrayRef',
    type_class => 'Type::Constraint::Parameterizable',
    parent     => t('Ref'),
    inline     => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . 'overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "\\@{}") '
            . ' : ref('
            . $_[1]
            . q{) eq 'ARRAY'};
    },
    parameterized_inline_generator => sub {
        my $self      = shift;
        my $parameter = shift;
        my $val       = shift;

        return
              '( ( Scalar::Util::blessed(' 
            . $val . ') && '
            . 'overload::Overloaded('
            . $val
            . ') && defined overload::Method('
            . $val
            . ', "\\@{}") ) || '
            . '( ref('
            . $val
            . ') eq "ARRAY" )'
            . '&& List::MoreUtils::all {'
            . $parameter->inline_check('$_') . ' } ' . '@{'
            . $val . '}' . ' )';
    },
);

declare(
    'HashRef',
    type_class => 'Type::Constraint::Parameterizable',
    parent     => t('Ref'),
    inline     => sub {
        'Scalar::Util::blessed('
            . $_[1] . ') ? '
            . 'overload::Overloaded('
            . $_[1]
            . ') && defined overload::Method('
            . $_[1]
            . ', "%{}") '
            . ' : ref('
            . $_[1]
            . q{) eq 'HASH'};
    },
    parameterized_inline_generator => sub {
        my $self      = shift;
        my $parameter = shift;
        my $val       = shift;

        return
              '( ( Scalar::Util::blessed(' 
            . $val . ') && '
            . 'overload::Overloaded('
            . $val
            . ') && defined overload::Method('
            . $val
            . ', "%{}") ) || '
            . '( ref('
            . $val
            . ') eq "HASH" )'
            . '&& List::MoreUtils::all {'
            . $parameter->inline_check('$_') . ' } '
            . 'values %{'
            . $val . '}' . ' )';
    },
);

declare(
    'Maybe',
    type_class                     => 'Type::Constraint::Parameterizable',
    parent                         => t('Item'),
    inline                         => sub { '1' },
    parameterized_inline_generator => sub {
        my $self      = shift;
        my $parameter = shift;
        my $val       = shift;

        return
              '!defined(' 
            . $val . ') ' . '|| ('
            . $parameter->inline_check($val) . ')';
    },
);

1;

# ABSTRACT: Implements type constraint objects for Perl's built-in types



=pod

=head1 NAME

Type::Library::Builtins - Implements type constraint objects for Perl's built-in types

=head1 VERSION

version 0.05

=head1 DESCRIPTION

See the documentation in L<Type> for a list of types that this library
implements.

This library uses L<Type::Exporter> to export its types.

=head1 AUTHOR

Dave Rolsky <autarch@urth.org>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2012 by Dave Rolsky.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

=cut


__END__