# ABSTRACT: Data::Object Type Library for Perl 5
package Data::Object::Library;

use 5.10.0;

use strict;
use warnings;

use Type::Library -base;
use Type::Utils   -all;

use Data::Object;

our $VERSION = '0.03'; # VERSION

extends 'Types::Standard';
extends 'Types::Common::Numeric';
extends 'Types::Common::String';

sub DECLARE {
    my ($name, %opts) = @_;

    return map +(DECLARE($_, %opts)), @$name if ref $name;

    ($opts{name} = $name) =~ s/:://g;

    my $registry = __PACKAGE__->meta;

    my @cans = ref($opts{can})  eq 'ARRAY' ? @{$opts{can}}  : $opts{can}  // ();
    my @isas = ref($opts{isa})  eq 'ARRAY' ? @{$opts{isa}}  : $opts{isa}  // ();
    my @does = ref($opts{does}) eq 'ARRAY' ? @{$opts{does}} : $opts{does} // ();

    my $code = $opts{constraint};
    my $text = $opts{inlined};

    $opts{constraint} = sub {
        my @args = @_;
        return if @isas and grep(not($args[0]->isa($_)),  @isas);
        return if @cans and grep(not($args[0]->can($_)),  @cans);
        return if @does and grep(not($args[0]->does($_)), @does);
        return if $code and not $code->(@args);
        return 1;
    };
    $opts{inlined} = sub {
        my $blessed = "Scalar::Util::blessed($_[1])";
        return join(' && ', map "($_)",
            join(' && ', map "($blessed and $_[1]->isa('$_'))",  @isas),
            join(' && ', map "($blessed and $_[1]->does('$_'))", @does),
            join(' && ', map "($blessed and $_[1]->can('$_'))",  @cans),
        $text ? $text : (),
        );
    };

    $opts{bless}   = "Type::Tiny";
    $opts{parent}  = "Object" unless $opts{parent};
    $opts{coerion} = 1;

    { no warnings "numeric"; $opts{_caller_level}++ }

    my $coerce = delete $opts{coerce};
    my $type   = declare(%opts);

    my $functions = {
        'Data::Object::Array'     => 'data_array',
        'Data::Object::Code'      => 'data_code',
        'Data::Object::Float'     => 'data_float',
        'Data::Object::Hash'      => 'data_hash',
        'Data::Object::Integer'   => 'data_integer',
        'Data::Object::Number'    => 'data_number',
        'Data::Object::Regexp'    => 'data_regexp',
        'Data::Object::Scalar'    => 'data_scalar',
        'Data::Object::String'    => 'data_string',
        'Data::Object::Undef'     => 'data_undef',
        'Data::Object::Universal' => 'data_universal',
    };

    my ($key) = grep { $functions->{$_} } @isas;

    for my $coercive ('ARRAY' eq ref $coerce ? @$coerce : $coerce) {
        my $object   = $registry->get_type($coercive);
        my $function = $$functions{$key};

        my $forward = Data::Object->can($function);
        coerce $opts{name}, from $coercive, via { $forward->($_) };

       $object->coercion->i_really_want_to_unfreeze;

        my $reverse = Data::Object->can('deduce_deep');
        coerce $coercive, from $opts{name}, via { $reverse->($_) };

        $object->coercion->freeze;
    }

    return $type;
}

DECLARE ["ArrayObj", "ArrayObject"] => (
    isa    => ["Data::Object::Array"],
    does   => ["Data::Object::Role::Array"],
    can    => ["data", "dump"],
    coerce => ["ArrayRef"],
    constraint_generator => sub {
        return Data::Object::Library::ArrayObject() unless @_;

        my $param = Types::TypeTiny::to_TypeTiny(shift);

        Types::TypeTiny::TypeTiny->check($param)
            or Types::Standard::_croak(
                "Parameter to ArrayObject[`a] expected ".
                "to be a type constraint; got $param"
            );

        return sub {
            my $arrayobj = shift;
            $param->check($_) || return for @$arrayobj;
            return !!1;
        }
    },
    deep_explanation => sub {
        my ($type, $value, $varname) = @_;
        my $param = $type->parameters->[0];

        for my $i (0 .. $#$value) {
            my $item = $value->[$i];
            next if $param->check($item);
            my $message  = '"%s" constrains each value in the array with "%s"';
            my @criteria = @{ $param->validate_explain($item, sprintf('%s->[%d]', $varname, $i)) };
            return [sprintf($message, $type, $param), @criteria]
        }

        return;
    },
);

DECLARE ["CodeObj", "CodeObject"] => (
    isa    => ["Data::Object::Code"],
    does   => ["Data::Object::Role::Code"],
    can    => ["data", "dump"],
    coerce => ["CodeRef"],
);

DECLARE ["FloatObj", "FloatObject"] => (
    isa    => ["Data::Object::Float"],
    does   => ["Data::Object::Role::Float"],
    can    => ["data", "dump"],
    coerce => ["Str", "Num", "LaxNum"],
);

DECLARE ["HashObj", "HashObject"] => (
    isa    => ["Data::Object::Hash"],
    does   => ["Data::Object::Role::Hash"],
    can    => ["data", "dump"],
    coerce => ["HashRef"],
    constraint_generator => sub {
        return Data::Object::Library::HashObject() unless @_;

        my $param = Types::TypeTiny::to_TypeTiny(shift);

        Types::TypeTiny::TypeTiny->check($param)
            or Types::Standard::_croak(
                "Parameter to HashObject[`a] expected ".
                "to be a type constraint; got $param"
            );

        return sub {
            my $hashobj = shift;
            $param->check($_) || return for values %$hashobj;
            return !!1;
        }
    },
    deep_explanation => sub {
        my ($type, $value, $varname) = @_;
        my $param = $type->parameters->[0];

        for my $k (sort keys %$value) {
            my $item = $value->{$k};
            next if $param->check($item);
            my $message  = '"%s" constrains each value in the hash object with "%s"';
            my @criteria = @{ $param->validate_explain($item, sprintf('%s->{%s}', $varname, B::perlstring($k))) };
            return [sprintf($message, $type, $param), @criteria]
        }

        return;
    },
    my_methods => {
        hashref_allows_key => sub {
            my $self = shift;
            Data::Object::Library::Str()->check($_[0]);
        },
        hashref_allows_value => sub {
            my $self = shift;
            my ($key, $value) = @_;

            return !!0 unless $self->my_hashref_allows_key($key);
            return !!1 if $self == Data::Object::Library::HashRef();

            my $href  = $self->find_parent(sub {
                $_->has_parent && $_->parent == Data::Object::Library::HashRef()
            });

            my $param = $href->type_parameter;

            Data::Object::Library::Str()->check($key) and $param->check($value);
        },
    },
);

DECLARE ["IntObj", "IntObject", "IntegerObj", "IntegerObject"] => (
    isa    => ["Data::Object::Integer"],
    does   => ["Data::Object::Role::Integer"],
    can    => ["data", "dump"],
    coerce => ["Str", "Num", "LaxNum", "StrictNum", "Int"],
);

DECLARE ["NumObj", "NumObject", "NumberObj", "NumberObject"] => (
    isa    => ["Data::Object::Number"],
    does   => ["Data::Object::Role::Number"],
    can    => ["data", "dump"],
    coerce => ["Str", "Num", "LaxNum", "StrictNum"],
);

DECLARE ["RegexpObj", "RegexpObject"] => (
    isa    => ["Data::Object::Regexp"],
    does   => ["Data::Object::Role::Regexp"],
    can    => ["data", "dump"],
    coerce => ["RegexpRef"],
);

DECLARE ["ScalarObj", "ScalarObject"] => (
    isa    => ["Data::Object::Scalar"],
    does   => ["Data::Object::Role::Scalar"],
    can    => ["data", "dump"],
    coerce => ["ScalarRef"],
);

DECLARE ["StrObj", "StrObject", "StringObj", "StringObject"] => (
    isa    => ["Data::Object::String"],
    does   => ["Data::Object::Role::String"],
    can    => ["data", "dump"],
    coerce => ["Str"],
);

DECLARE ["UndefObj", "UndefObject"] => (
    isa    => ["Data::Object::Undef"],
    does   => ["Data::Object::Role::Undef"],
    can    => ["data", "dump"],
    coerce => ["Undef"],
);

DECLARE ["AnyObj", "AnyObject", "UniversalObj", "UniversalObject"] => (
    isa    => ["Data::Object::Universal"],
    does   => ["Data::Object::Role::Universal"],
    can    => ["data", "dump"],
    coerce => ["Any"],
);

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::Object::Library - Data::Object Type Library for Perl 5

=head1 VERSION

version 0.03

=head1 SYNOPSIS

    use Data::Object::Library;

=head1 DESCRIPTION

Data::Object::Library is a L<Type::Tiny> library that extends the
L<Types::Standard>, L<Types::Common::Numeric>, and L<Types::Common::String>
libraries and adds additional type constraints and coercions which validate and
transform L<Data::Object> data type objects.

=head2 TYPES

This following is a complete list of type constraints provided by this library.

=over

=item C<< Any >>

The Any type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< AnyObj >>

The AnyObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Universal>.

=item C<< AnyObject >>

The AnyObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Universal>.

=item C<< ArrayObj >>

The ArrayObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Array>.

=item C<< ArrayObject >>

The ArrayObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Array>.

=item C<< ArrayRef >>

The ArrayRef type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Bool >>

The Bool type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< ClassName >>

The ClassName type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< CodeObj >>

The CodeObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Code>.

=item C<< CodeObject >>

The CodeObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Code>.

=item C<< CodeRef >>

The CodeRef type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< ConsumerOf >>

The ConsumerOf type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Defined >>

The Defined type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Dict >>

The Dict type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< Enum >>

The Enum type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< FileHandle >>

The FileHandle type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< FloatObj >>

The FloatObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Float>.

=item C<< FloatObject >>

The FloatObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Float>.

=item C<< GlobRef >>

The GlobRef type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< HasMethods >>

The HasMethods type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< HashObj >>

The HashObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Hash>.

=item C<< HashObject >>

The HashObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Hash>.

=item C<< HashRef >>

The HashRef type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< InstanceOf >>

The InstanceOf type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Int >>

The Int type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< IntObj >>

The IntObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Integer>.

=item C<< IntObject >>

The IntObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Integer>.

=item C<< IntegerObj >>

The IntegerObj type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Integer>.

=item C<< IntegerObject >>

The IntegerObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Integer>.

=item C<< Item >>

The Item type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< LaxNum >>

The LaxNum type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< LowerCaseSimpleStr >>

The LowerCaseSimpleStr type constraint is provided by the
L<Types::Common::String> library. Please see that documentation.

=item C<< LowerCaseStr >>

The LowerCaseStr type constraint is provided by the L<Types::Common::String>
library. Please see that documentation.

=item C<< Map >>

The Map type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< Maybe >>

The Maybe type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< NegativeInt >>

The NegativeInt type constraint is provided by the L<Types::Common::Numeric>
library. Please see that documentation.

=item C<< NegativeNum >>

The NegativeNum type constraint is provided by the L<Types::Common::Numeric>
library. Please see that documentation.

=item C<< NegativeOrZeroInt >>

The NegativeOrZeroInt type constraint is provided by the
L<Types::Common::Numeric> library. Please see that documentation.

=item C<< NegativeOrZeroNum >>

The NegativeOrZeroNum type constraint is provided by the
L<Types::Common::Numeric> library. Please see that documentation.

=item C<< NonEmptySimpleStr >>

The NonEmptySimpleStr type constraint is provided by the
L<Types::Common::String> library. Please see that documentation.

=item C<< NonEmptyStr >>

The NonEmptyStr type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Num >>

The Num type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< NumObj >>

The NumObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Number>.

=item C<< NumObject >>

The NumObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Number>.

=item C<< NumberObj >>

The NumberObj type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Number>.

=item C<< NumberObject >>

The NumberObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Number>.

=item C<< NumericCode >>

The NumericCode type constraint is provided by the L<Types::Common::String>
library. Please see that documentation.

=item C<< Object >>

The Object type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< OptList >>

The OptList type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Optional >>

The Optional type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Overload >>

The Overload type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< Password >>

The Password type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< PositiveInt >>

The PositiveInt type constraint is provided by the L<Types::Common::Numeric>
library. Please see that documentation.

=item C<< PositiveNum >>

The PositiveNum type constraint is provided by the L<Types::Common::Numeric>
library. Please see that documentation.

=item C<< PositiveOrZeroInt >>

The PositiveOrZeroInt type constraint is provided by the
L<Types::Common::Numeric> library. Please see that documentation.

=item C<< PositiveOrZeroNum >>

The PositiveOrZeroNum type constraint is provided by the
L<Types::Common::Numeric> library. Please see that documentation.

=item C<< Ref >>

The Ref type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< RegexpObj >>

The RegexpObj type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Regexp>.

=item C<< RegexpObject >>

The RegexpObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Regexp>.

=item C<< RegexpRef >>

The RegexpRef type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< RoleName >>

The RoleName type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< ScalarObj >>

The ScalarObj type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Scalar>.

=item C<< ScalarObject >>

The ScalarObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Scalar>.

=item C<< ScalarRef >>

The ScalarRef type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< SimpleStr >>

The SimpleStr type constraint is provided by the L<Types::Common::String>
library. Please see that documentation.

=item C<< SingleDigit >>

The SingleDigit type constraint is provided by the L<Types::Common::Numeric>
library. Please see that documentation.

=item C<< Str >>

The Str type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< StrMatch >>

The StrMatch type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< StrObj >>

The StrObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::String>.

=item C<< StrObject >>

The StrObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::String>.

=item C<< StrictNum >>

The StrictNum type constraint is provided by the L<Types::Standard> library.
Please see that documentation.

=item C<< StringObj >>

The StringObj type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::String>.

=item C<< StringObject >>

The StringObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::String>.

=item C<< StrongPassword >>

The StrongPassword type constraint is provided by the L<Types::Common::String>
library. Please see that documentation.

=item C<< Tied >>

The Tied type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< Tuple >>

The Tuple type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< Undef >>

The Undef type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=item C<< UndefObj >>

The UndefObj type constraint is provided by this library and accepts any object
that is, or is derived from, a L<Data::Object::Undef>.

=item C<< UndefObject >>

The UndefObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Undef>.

=item C<< UniversalObj >>

The UniversalObj type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Universal>.

=item C<< UniversalObject >>

The UniversalObject type constraint is provided by this library and accepts any
object that is, or is derived from, a L<Data::Object::Universal>.

=item C<< UpperCaseSimpleStr >>

The UpperCaseSimpleStr type constraint is provided by the
L<Types::Common::String> library. Please see that documentation.

=item C<< UpperCaseStr >>

The UpperCaseStr type constraint is provided by the L<Types::Common::String>
library. Please see that documentation.

=item C<< Value >>

The Value type constraint is provided by the L<Types::Standard> library. Please
see that documentation.

=back

=head1 AUTHOR

Al Newkirk <anewkirk@ana.io>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2014 by Al Newkirk.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
