package Typed;

use strict;
use warnings FATAL => 'all';
use feature qw(:5.10);

use Carp qw();
use Scalar::Util qw(blessed);

use Types::Standard "-types";
use Type::Utils qw();
use Exporter::Tiny;

use parent qw(Exporter::Tiny);

our @EXPORT = qw(has new as from subtype);
our @TINY_UTILS = qw(message where inline_as declare coerce);

our $VERSION = '0.10';

sub import {
    shift->SUPER::import({ into => scalar(caller(0)) }, @EXPORT );
    Type::Utils->import({ into => scalar(caller(0)) }, @TINY_UTILS );
}

sub new {
    my $self = shift;
    
    my $class = ref($self) || $self;
    my $blessed = bless({}, $class);

    my $meta_pkg = __PACKAGE__;
    my $meta = do { no strict 'refs'; \%{"${meta_pkg}::meta"}; };

     my %user_vals = @_;
     foreach my $k (keys %user_vals) {
         $blessed->$k($user_vals{$k});
     }

    my $build = $blessed->can("BUILD");
    if ($build) {
        $build->($blessed);
    }

    return($blessed);
}

# Yes, we use a global cache for metadata
our %meta = (
);

sub process_has {
    my $self = shift;
    my $name = shift;
    my $package = shift;

    my $isa = $meta{$package}{$name}{isa};

    my $is = $meta{$package}{$name}{is};
    my $writable = $is && "rw" eq $is;
    my $opts = $meta{$package}{$name};

    my $attribute = sub {
        if (!exists $_[0]->{$name} && $$opts{default}) {
            $_[0]->{$name} = $$opts{default};
        }
        
        # Do we set the value
        if (1 == $#_) {
            if ($writable) {
                return($_[0]->{$name} = undef) if !defined $_[1];

                if ($isa) {
                    my $package = blessed($_[0]);
                    my $type = Types::Standard->get_type($isa) || $meta{subtype}{$package}{$isa};

                    if ($type) {
                        my $msg = $type->validate($_[1]);
                        Carp::croak($msg) if $msg; 
                    }
                }

                $_[0]->{$name} = $_[1];
            }
            else {
                Carp::croak("Attempt to modify read-only attribute: $name");
            }
        }

        return("CODE" eq ref($_[0]->{$name}) ? $_[0]->{$name}->() : $_[0]->{$name});
    };

    return($attribute);
}

sub has {
    my $name = shift;
    my %opts = @_;
    my $package = caller;

    $meta{$package}{$name} = \%opts;

    my $attribute = __PACKAGE__->process_has($name, $package);
    { no strict 'refs'; *{"${package}::$name"} = $attribute; };
}

sub as (@) {
	unless (blessed($_[0])) {
        my $type = shift(@_);
        unshift(@_, __PACKAGE__->$type);
    }

    Type::Utils::as(@_);
}

sub from (@)
{
	unless (blessed($_[0])) {
        my $type = shift(@_);
        unshift(@_, __PACKAGE__->$type);
    }

    Type::Utils::from(@_);
}

sub subtype
{
    my $subtype = Type::Utils::subtype(@_);
    my $package = caller;
    my $name = $_[0];
    $meta{subtype}{$package}{$name} = $subtype;
}

1;

__END__

=head1 NAME

Typed - Minimal typed Object Oriented layer

=head1 SYNOPSIS

    package User;
    
    use Typed;
    use Email::Valid;
    
    subtype 'Email'
    
        => as 'Str'
        => where { Email::Valid->address($_) }
        => message { $_ ? "$_ is not a valid email address" : "No value given for address validation" };
    
    has 'id' => ( isa => 'Int', is => 'rw' );
    
    has 'email' => ( isa => 'Email', is => 'rw' );
    
    has 'password' => ( isa => 'Str', is => 'rw' );
    
    1;
    
    package main;
    
    use strict;
    use warnings;
    use feature qw(:5.10);
    
    my $user = User->new();
    
    $user->id(1);
    
    say($user->id());
    
    eval {
        $user->email("abc");
    };
    if ($@) {
        $user->email('abc@nowhere.com');
    }
    say($user->email());

=head1 DESCRIPTION

L<Typed> is a minimalistic typed Object Oriented layer.

The goal is to be mostly compatible with L<Moose::Manual::Types>.

=cut