use strict;
package Person;
use IMPL::lang qw(:declare);
use IMPL::declare {
	base => [
		'IMPL::Object'           => undef,
		'IMPL::Object::Autofill' => '@_'
	]
};

BEGIN {
	public property name      => PROP_ALL;
	public property age       => PROP_ALL;
	public property addresses => PROP_ALL | PROP_LIST;
}

package Address;
use IMPL::lang qw(:declare);
use IMPL::declare {
	base => [
		'IMPL::Object'           => undef,
		'IMPL::Object::Autofill' => '@_'
	]
};

BEGIN {
	public property country => PROP_ALL;
	public property city    => PROP_ALL;
}

package main;

my $data = {
	name      => 'Peter',
	age       => '99',
	addresses => {
		address => [
			{
				country => 'Airot',
				city    => 'Torhiq',
				street => 'avenu1'
			},
			{
				country => 'Olkson',
				city    => 'Zoxs',
				street => 'av2'
			}
		]
	}
};

use Carp qw(confess);

sub Rule(&) {
	my ($block) = @_;
	
	return sub {
        local $_ = shift;
        $block->();
    }
}

sub Inspect($$) {
	my ($path,$block) = @_;
    my $data = $_;
    
    foreach my $name (@$path) {
    	$data = ref $data ? $data->{$name} : undef;
    	print "$name = $data\n";
    }
    
    local $_ = $data;
    $block->($data);
}

sub Required(@);

sub Required(@) {
	if(@_) {
	   Inspect([@_],Rule { Required });
	} else {
	   confess "required" unless $_;
	}
}

sub Regexp($) {
	my $rx = shift;
	die "Regular expression doesn't match" unless m/$rx/; 
}

my $validate = Rule {
	Required('name');
	
	Inspect ['age'] => Rule {
		Regexp(qr/^\d+$/);
		die "invalid person age" unless $_ > 0 && $_ < 200;
	};
	
	Inspect ['addresses', 'address'] => Rule {
		Required;
		foreach(@{$_}) {
            Required('street');
		}
	}
};

$validate->($data);

my ($person) =
  map {
	Person->new(
		name      => $_->{name},
		age       => $_->{age},
		addresses => [
			map {
				Address->new(
					country => $_->{country},
					city    => $_->{city}
				  )
			  } as_list( $_->{addresses}{address} )
		]
	  )
  } $data;
  
use Data::Dumper;
print Dumper($person);

sub as_list {
	return @{ $_[0] } if ref $_[0] eq 'ARRAY';
	return @_;
}