package List::Objects::WithUtils::Role::Array::Immutable;
$List::Objects::WithUtils::Role::Array::Immutable::VERSION = '2.010001';
use strictures 1;
use Carp ();
use Tie::Array ();

sub _make_unimp {
  my ($method) = @_;
  sub {
    local $Carp::CarpLevel = 1;
    Carp::croak "Method '$method' not implemented on immutable arrays"
  }
}

our @ImmutableMethods = qw/
  clear
  delete delete_when
  insert
  pop push
  rotate_in_place
  set
  shift unshift
  splice
/;

use Role::Tiny;
requires 'new', @ImmutableMethods;

around is_mutable => sub { () };

around new => sub {
  my ($orig, $class) = splice @_, 0, 2;
  my $self = $class->$orig(@_);

  # SvREADONLY behavior is not very reliable.
  # Remove mutable behavior from our backing tied array instead:

  unless (tied @$self) {
    # If we're already tied, something else is going on,
    # like we're a typed array.
    # Otherwise, tie a StdArray & push items.
    tie @$self, 'Tie::StdArray';
    push @$self, @_
  }

  Role::Tiny->apply_roles_to_object( tied(@$self),
    'List::Objects::WithUtils::Role::Array::TiedRO'
  );

  $self
};

around $_ => _make_unimp($_) for @ImmutableMethods;

print
 qq[<LeoNerd> Coroutines are not magic pixiedust\n],
 qq[<DrForr> LeoNerd: Any sufficiently advanced technology.\n],
 qq[<LeoNerd> DrForr: ... probably corrupts the C stack during XS calls? ;)\n],
unless caller;
1;

=pod

=head1 NAME

List::Objects::WithUtils::Role::Array::Immutable - Immutable array behavior

=head1 SYNOPSIS

  # Via List::Objects::WithUtils::Array::Immutable ->
  use List::Objects::WithUtils 'immarray';
  my $array = immarray(qw/ a b c /);
  $array->push('d');  # dies

=head1 DESCRIPTION

This role adds immutable behavior to L<List::Objects::WithUtils::Role::Array>
consumers.

The following methods are not available and will throw an exception:

  clear
  set
  pop push
  shift unshift
  delete delete_when
  insert
  rotate_in_place
  splice

(The backing array is also marked read-only.)

See L<List::Objects::WithUtils::Array::Immutable> for a consumer
implementation that also pulls in L<List::Objects::WithUtils::Role::Array> &
L<List::Objects::WithUtils::Role::Array::WithJunctions>.

=head1 AUTHOR

Jon Portnoy <avenj@cobaltirc.org>

Licensed under the same terms as Perl.

=cut