package MASCIP::Utils::Roles;
use version; our $VERSION = qv('0.0.1');
use Perl6::Export::Attrs;
use Moose::Util qw( ensure_all_roles );

## List of Role names that an object (instance) composes
sub role_names_of :Export(:DEFAULT) {
    return [ split('\|', $_[0]->meta->roles->[0]->name) ];
}

## Switches one Role for another
# @params: old Role name to un-apply, new Role name to apply
sub switch_role :Export(:DEFAULT) {
    my ($object, $class_of_object, $old, $new) = @_;

    # Un-apply old Role
    unapply_role($object, $class_of_object, $old);

    # Apply new Role
    my @new_roles = @{ role_names_of($object) };
    push @new_roles, $new;
    _rebless_and_apply_new_roles($object, $class_of_object, @new_roles);
}

## Un-apply a Role from an object (instance)
sub unapply_role :Export(:DEFAULT) {
    my ($object, $class_of_object, $role_name) = @_;
        # the class is used to rebless

    my @new_roles = grep { $_ ne $role_name } 
                        @{ role_names_of($object) };

    _rebless_and_apply_new_roles($object, $class_of_object, @new_roles);
}

## Gets rid of all old Roles, and apply a list of new ones
sub _rebless_and_apply_new_roles {
    my ($object, $class_of_object, @new_roles) = @_;

    bless $object, $class_of_object;  # THIS IS BAD !!! 
                                      # But it works for this simple example
    ensure_all_roles($object, @new_roles);
}

1;