# 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.01'; # VERSION

extends 'Types::Standard';

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} // sub { 1 };

    $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 not $code->(@args);
        return 1;
    };

    $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"],
);

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"],
);

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.01

=head1 SYNOPSIS

    use Data::Object::Library -types;

=head1 DESCRIPTION

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

=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
