package Moose::Declare;

use strict;
use warnings;

our $VERSION = '0.01';

use base 'Object::Declare';

use Moose ();

my $CURRENT;

sub import {
    push @_ => (
        mapping    => {
            class => sub { 
                my ($name, %description) = @_;
                
                $description{superclasses} = [ 'Moose::Object' ] 
                    unless exists $description{superclasses};
                
                my $version;
                $version = $description{version};
                
                my $meta = Class::MOP::Class->create($name, $version, %description);
                
                $meta->add_method(meta => sub { $meta });
                
                $CURRENT = $meta;
                
                return { class  => $name, 'is' => \%description };
            },
            has   => sub { 
                my ($name, %description) = @_;     
                
                $description{'is'} = 'rw' 
                    unless exists $description{rw};                
                    
                $description{'is'} = 'ro' 
                    unless exists $description{readonly};                    
                           
                return { attribute => $name, 'is' => \%description };
            }
        }, 
        declarator => 'moose',
        copula     => ['is', 'of', 'isa', 'does', 'are' ],    
    );
    goto &Object::Declare::import;
}

# Make a star from the Katamari!
sub Object::Declare::_make_object {
    my ($build, $schema) = @_;

    return sub {
        my $name = shift;
        push @$schema, $build->($name => map { $_->unroll } @_);
    };
}


1;

__END__

=pod

=head1 NAME

Moose::Declare - Declarative sugar for Moose

=head1 SYNOPSIS
  
  use Moose::Declare; moose {
      
      class BinaryTree => 
          authority is 'cpan://MOOSE',
            version is '0.01',
                    is rw;
        
      has node   => isa Any;
  
      has parent => isa BinaryTree,
                    is weakref,                 
          predicate is 'has_parent';
      
      has left   => isa BinaryTree,		
                    is lazy,
          predicate is 'has_left',  
            default is sub { BinaryTree->new(parent => $_[0]) };
        
      has right  => isa BinaryTree,		
                    is lazy,
          predicate is 'has_left',  
            default is sub { BinaryTree->new(parent => $_[0]) };
  };

=head1 DESCRIPTION

So experimental right now, it doesn't even work ;)

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

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

=cut