package Moose::Sugar::Role;
use Moose::Role qw(confess);

sub extends {
    my $class = shift;
    return sub (@) {
        confess "Must derive at least one class" unless @_;
        Class::MOP::load_class($_) for @_;

        # this checks the metaclass to make sure
        # it is correct, sometimes it can get out
        # of sync when the classes are being built
        my $meta = $class->meta->_fix_metaclass_incompatability(@_);
        $meta->superclasses(@_);
    };
}

sub with {
    my $class = shift;
    return sub (@) {
        my (@roles) = @_;
        confess "Must specify at least one role" unless @roles;
        Class::MOP::load_class($_) for @roles;
        $class->meta->_apply_all_roles(@roles);
    };
}

sub has {
    my $class = shift;
    return sub ($;%) {
        my ( $name, %options ) = @_;
        my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ];
        $class->meta->_process_attribute( $_, %options ) for @$attrs;
    };
}

sub before {
    my $class = shift;
    return sub (@&) {
        my $code = pop @_;
        my $meta = $class->meta;
        $meta->add_before_method_modifier( $_, $code ) for @_;
    };
}

sub after {
    my $class = shift;
    return sub (@&) {
        my $code = pop @_;
        my $meta = $class->meta;
        $meta->add_after_method_modifier( $_, $code ) for @_;
    };
}

sub around {
    my $class = shift;
    return sub (@&) {
        my $code = pop @_;
        my $meta = $class->meta;
        $meta->add_around_method_modifier( $_, $code ) for @_;
    };
}

sub super {
    my $class = shift;
    {
        our %SUPER_SLOT;
        no strict 'refs';
        $SUPER_SLOT{shift} = \*{"${class}::super"};
    }
    return sub { };
}

sub override {
    my $class = shift;
    return sub ($&) {
        my ( $name, $method ) = @_;
        $class->meta->add_override_method_modifier( $name => $method );
    };
}

sub inner {
    my $class = shift;    
    {
        our %INNER_SLOT;
        no strict 'refs';
        $INNER_SLOT{shift} = \*{"${class}::inner"};
    }
    return sub { };
}

sub augment {
    my $class = shift;
    return sub (@&) {
        my ( $name, $method ) = @_;
        $class->meta->add_augment_method_modifier( $name => $method );
    };
}


1;