use v5.14;

package Role::Switchable
{
	use Moose::Role;
	
	has _switchable_base_class => (
		is        => 'ro',
		writer    => '_set_switchable_base_class',
		clearer   => '_clear_switchable_base_class',
		default   => sub { ref($_[0])->Moose::Util::find_meta },
		isa       => 'Class::MOP::Class',
	);
	
	has switchable_role => (
		init_arg  => undef,
		is        => 'ro',
		writer    => '_set_switchable_role',
		predicate => 'has_switchable_role',
		clearer   => '_clear_switchable_role',
		isa       => 'Moose::Meta::Role',
	);
	
	has _switchable_data => (
		init_arg  => 'switchable',
		is        => 'ro',
		writer    => '_set_switchable_data',
		clearer   => '_clear_switchable_data',
		default   => sub { +{} },
		isa       => 'HashRef[HashRef]',
	);
	
	sub BUILD { }
		
	after BUILD => sub
	{
		my ($self, $params) = @_;
		
		$self->_switchable_data->{_} = $params;
		
		if (my $role = delete $params->{switchable_role})
		{
			$self->switch_role($role);
		}
	};
	
	around dump => sub
	{
		my $next = shift;
		my $self = shift;
		
		my $tmp_class = $self->_switchable_base_class; $self->_clear_switchable_base_class;
		my $tmp_role  = $self->switchable_role;        $self->_clear_switchable_role;
		my $tmp_data  = $self->_switchable_data;       $self->_clear_switchable_data;
		
		my $r = $self->$next(@_);
		
		$self->_set_switchable_base_class($tmp_class);
		$self->_set_switchable_role($tmp_role);
		$self->_set_switchable_data($tmp_data);
		
		return $r;
	};
	
	sub switch_role
	{
		my $self = shift;
		my ($new_role, %new_attrs) = @_;
		
		$new_role = $new_role->Moose::Util::find_meta
			if defined($new_role) && !ref($new_role);
		
		my $meta = $self->Moose::Util::find_meta;
		
		if ( $self->has_switchable_role )
		{
			my $current_role = $self->switchable_role;
			
			# Keep current attribute values
			my %attr_values;
			for ($current_role->get_attribute_list)
			{
				my $attr = $meta->find_attribute_by_name($_);
				$attr_values{ $attr->name } = $attr->get_value($self)
					if $attr->has_value($self);
			}
			$self->_switchable_data->{ $current_role->name } = \%attr_values;
			
			# Rebless back to base class before applying new.
			$self->_switchable_base_class->rebless_instance_back($self);
			$self->_clear_switchable_role;
		}
		
		if ($new_role)
		{
			my %attrs = (
				%{ $self->_switchable_data->{ $new_role->name } or {} },
				%new_attrs,
			);
			
			my $class = Moose::Util::with_traits($self->_switchable_base_class->name, $new_role->name);
			$self->_set_switchable_role($new_role);
			$class->Moose::Util::find_meta->rebless_instance($self, %attrs);
		}
		
		return;
	}
}

package Car
{
	use Moose::Role;
	has wheels => (is => 'rw');
	sub drive { say 'driving' }
}

package Plane
{
	use Moose::Role;
	has wings => (is => 'ro');
	sub fly { say 'flying' }
}

package Boat
{
	use Moose::Role;
	sub float { say 'floating' }
}

package Batmobile
{
	use Moose;
	has owner => (is => 'rw');
	with 'Role::Switchable';
}

my $bat = Batmobile->new(
	owner  => 'Bruce Wayne',
	switchable => {
		Plane => { wings => 'blue' },
		Car   => { wheels => 'red' },
	},
);

$bat->switch_role('Car');
say $bat->wheels, " wheels";
$bat->drive if $bat->can('drive');
$bat->fly if $bat->can('fly');
print $bat->dump;

$bat->switch_role('Boat');
$bat->owner('Batman');
print $bat->dump;

$bat->switch_role('Plane');
say $bat->wings, " wings";
$bat->drive if $bat->can('drive');
$bat->fly if $bat->can('fly');
print $bat->dump;