Merge pull request #2 from tobyink/tied-typed-array

Tied typed array
avenj · Sep 5, 2013 · 9fbd15d · 9fbd15d
2 parents 666cf36 + a5d2709
commit 9fbd15d
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 47 deletions.
diff --git a/lib/List/Objects/WithUtils/Array/Typed.pm b/lib/List/Objects/WithUtils/Array/Typed.pm
@@ -10,20 +10,16 @@ use Exporter 'import';
 our @EXPORT = 'array_of';
 sub array_of { __PACKAGE__->new(@_) }
 
-use overload
-  '@{}'    => sub { $_[0]->{array} },
-  fallback => 1;
-
 sub type {
-  $_[0]->{type}
+  tied(@{$_[0]})->type
 }
 
 sub new {
   my $class = shift;
   my $type;
 
   if (my $blessed = Scalar::Util::blessed $class) {
-    $type  = $class->{type};
+    $type  = $class->type;
     $class = $blessed;
   } else {
     $type = shift;
@@ -33,47 +29,11 @@ sub new {
     unless Scalar::Util::blessed($type)
     && $type->isa('Type::Tiny');
 
-  my $self = +{ type => $type };
+  require Type::Tie;
+  my $self = [];
+  tie(@$self, 'Type::Tie::ARRAY', $type);
+  push @$self, @_;
   bless $self, $class;
-
-  $self->{array} = [ map {; $self->_try_coerce($type, $_) } @_ ];
-
-  $self
-}
-
-sub push {
-  my $self = shift;
-  $self->SUPER::push( 
-    map {; $self->_try_coerce($self->type, $_) } @_
-  )
-}
-
-sub unshift {
-  my $self = shift;
-  $self->SUPER::unshift(
-    map {; $self->_try_coerce($self->type, $_) } @_
-  )
-}
-
-sub set {
-  my $self = shift;
-  $self->SUPER::set( $_[0], $self->_try_coerce($self->type, $_[1]) )
-}
-
-sub insert {
-  my $self = shift;
-  $self->SUPER::insert( $_[0], $self->_try_coerce($self->type, $_[1]) )
-}
-
-sub splice {
-  my ($self, $one, $two) = splice @_, 0, 3;
-  $self->SUPER::splice(
-    $one, $two,
-    ( @_ ? 
-      map {; $self->_try_coerce($self->type, $_) } @_
-      : ()
-    ),
-  )
 }
 
 print
@@ -110,6 +70,8 @@ List::Objects::WithUtils::Array::Typed - Type-checking array objects
 A L<List::Objects::WithUtils::Array> subclass providing type-checking via
 L<Type::Tiny> types.
 
+This module requires L<Type::Tie>.
+
 The first argument passed to the constructor should be a L<Type::Tiny> type:
 
   use Types::Standard -all;

diff --git a/t/typecheck.t b/t/typecheck.t
@@ -2,7 +2,7 @@
 BEGIN {
   unless (
     eval {; require List::Objects::Types; 1 } && !$@
-    && eval {; require Types::Standard; 1 }   && !$@
+    && eval {; require Types::Standard; require Type::Tie; 1 }   && !$@
   ) {
     require Test::More;
     Test::More::plan(skip_all => 
@@ -100,4 +100,25 @@ use Types::Standard -all;
   isa_ok $mapped, 'List::Objects::WithUtils::Array::Typed';
 }
 
+# tied array
+{
+  use List::Objects::WithUtils 'array_of';
+  my $arr = array_of Int() => 1 .. 3;
+
+  eval {; push @$arr, 'foo' };
+  ok $@ =~ /type/, 'invalid type push died ok';
+  push @$arr, 4 .. 6;
+  ok $arr->count == 6, 'count ok after push';
+
+  eval {; unshift @$arr, 'bar' };
+  ok $@ =~ /type/, 'invalid type unshift died ok';
+  unshift @$arr, 7 .. 9;
+  ok $arr->count == 9, 'count ok after unshift';
+
+  eval {; $arr->[0] = 'foo' };
+  ok $@ =~ /type/, 'invalid type set died ok';
+  $arr->[0] = 42;
+  is $arr->[0], 42, 'valid type set ok';
+}
+
 done_testing;