incremented version and updated changelog, fixed bug that created extra coercions...
John Napiorkowski [Thu, 4 Sep 2008 18:55:29 +0000 (18:55 +0000)]
Changes
lib/MooseX/Types.pm
lib/MooseX/Types/TypeDecorator.pm
t/13_typedecorator.t
t/lib/DecoratorLibrary.pm

diff --git a/Changes b/Changes
index a2b51c1..297da0f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
 
+0.06    Fri Aug  5 12:00:00 EST 2008
+        - Added support for parameterized types and type unions, tests for all
+        that and documentation updates.
+        
 0.05    ...
         - moved export mechanism to Sub::Exporter. ::Base contains
           a bunch of wrapping logic to allow the export-along functionality
index 0f6e7a8..c0f575b 100644 (file)
@@ -19,7 +19,7 @@ use Carp::Clan                      qw( ^MooseX::Types );
 
 use namespace::clean -except => [qw( meta )];
 
-our $VERSION = 0.05;
+our $VERSION = 0.06;
 
 my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'};
 
@@ -31,7 +31,11 @@ my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'};
 
   # predeclare our own types
   use MooseX::Types 
-      -declare => [qw( PositiveInt NegativeInt )];
+    -declare => [qw(
+        PositiveInt NegativeInt
+        ArrayRefOfPositiveInt ArrayRefOfAtLeastThreeNegativeInts
+        LotsOfInnerConstraints StrOrArrayRef
+    )];
 
   # import builtin types
   use MooseX::Types::Moose 'Int';
@@ -52,6 +56,23 @@ my $UndefMsg = q{Action for type '%s' not yet defined in library '%s'};
       from Int,
           via { 1 };
 
+  # with parameterized constraints.  Please note the containing '(...)'
+  
+  subtype ArrayRefOfPositiveInt,
+    as (ArrayRef[PositiveInt]);
+    
+  subtype ArrayRefOfAtLeastThreeNegativeInts,
+    as (ArrayRef[NegativeInt]),
+    where { scalar(@$_) > 2 };
+
+  subtype LotsOfInnerConstraints,
+    as (ArrayRef[ArrayRef[HashRef[Int]]]);
+    
+  # with TypeConstraint Unions
+  
+  subtype StrOrArrayRef,
+    as Str|ArrayRef;
+
   1;
 
 =head2 Usage
@@ -244,6 +265,44 @@ type does not yet exist.
 
 =back
 
+=head1 NOTES REGARDING PARAMETERIZED CONSTRAINTS
+
+L<MooseX::Types> uses L<MooseX::Types::TypeDecorator> to do some overloading
+which generally allows you to easily create types with parameters such as:
+
+    subtype ParameterType,
+      as (ArrayRef[Int]);
+
+However, due to an outstanding issue you will need to wrap the parameterized
+type inside parenthesis, as in the example above.  Hopefully this limitation
+will be lifted in a future version of this module.
+
+If you are using paramterized types in the options section of an attribute
+declaration, the parenthesis are not needed:
+
+    use Moose;
+    use MooseX::Types::Moose qw(HashRef Int);
+    
+    has 'attr' => (isa=>HashRef[Str]);
+
+=head1 NOTES REGARDING TYPE UNIONS
+
+L<MooseX::Types> uses L<MooseX::Types::TypeDecorator> to do some overloading
+which generally allows you to easily create union types:
+
+  subtype StrOrArrayRef,
+    as Str|ArrayRef;    
+
+As with parameterized constrains, this overloading extends to modules using the
+types you define in a type library.
+
+    use Moose;
+    use MooseX::Types::Moose qw(HashRef Int);
+    
+    has 'attr' => (isa=>HashRef|Int);
+
+And everything should just work as you'd think.
+    
 =head1 METHODS
 
 =head2 import
@@ -315,8 +374,14 @@ sub type_export_generator {
         }
         $type_constraint = defined($type_constraint) ? $type_constraint
          : MooseX::Types::UndefinedType->new($name);
+         
+        return $class->create_type_decorator($type_constraint);
         
-        return $class->create_type_decorator($type_constraint);  
+        #if(@_ && wantarray) {
+        #    return ($class->create_type_decorator($type_constraint), @_);  
+        #} else {
+        #    return $class->create_type_decorator($type_constraint);
+        #}
     };
 }
 
@@ -330,6 +395,10 @@ sub create_arged_type_constraint {
     my ($class, $name, @args) = @_;
     ### This whole section is a real TODO :)  Ugly hack to get the base tests working.
     my $fullname = $name."[$args[0]]";
+    
+    #use Data::Dump qw/dump/;
+    #my $tc = Moose::Util::TypeConstraints::find_or_create_type_constraint($name);
     return Moose::Util::TypeConstraints::create_parameterized_type_constraint($fullname);
 }
 
@@ -353,7 +422,7 @@ instance.
 
 sub create_type_decorator {
     my ($class, $type_constraint) = @_;
-    return MooseX::Types::TypeDecorator->new(type_constraint=>$type_constraint);
+    return MooseX::Types::TypeDecorator->new($type_constraint);
 }
 
 =head2 coercion_export_generator
@@ -415,6 +484,8 @@ L<Sub::Exporter>
 Robert 'phaylon' Sedlacek C<E<lt>rs@474.atE<gt>>, with many thanks to
 the C<#moose> cabal on C<irc.perl.org>.
 
+Additional features by John Napiorkowski (jnapiorkowski) <jjnapiork@cpan.org>.
+
 =head1 LICENSE
 
 This program is free software; you can redistribute it and/or modify
index f39bd55..57827b2 100644 (file)
@@ -4,12 +4,12 @@ use strict;
 use warnings;
 
 use Carp::Clan qw( ^MooseX::Types );
-use Moose::Util::TypeConstraints;
+use Moose::Util::TypeConstraints ();
 use Moose::Meta::TypeConstraint::Union;
 
 use overload(
     '""' => sub {
-        shift->type_constraint->name;  
+        shift->__type_constraint->name;  
     },
     '|' => sub {
         my @tc = grep {ref $_} @_;
@@ -38,17 +38,19 @@ Old school instantiation
 =cut
 
 sub new {
-    my ($class, %args) = @_;
-    if(
-        $args{type_constraint} && ref($args{type_constraint}) &&
-        ($args{type_constraint}->isa('Moose::Meta::TypeConstraint') ||
-        $args{type_constraint}->isa('MooseX::Types::UndefinedType'))
-    ) {
-        return bless \%args, $class;        
+    my $class = shift @_;
+    if(my $arg = shift @_) {
+        if(ref $arg && $arg->isa('Moose::Meta::TypeConstraint')) {
+            return bless {'__type_constraint'=>$arg}, $class;
+        } elsif(ref $arg && $arg->isa('MooseX::Types::UndefinedType')) {
+            ## stub in case we'll need to handle these types differently
+            return bless {'__type_constraint'=>$arg}, $class;
+        } else {
+            croak "Argument must be ->isa('Moose::Meta::TypeConstraint') or ->isa('MooseX::Types::UndefinedType')";
+        }
     } else {
-        croak "The argument 'type_constraint' is not valid.";
+        croak "This method [new] requires a single argument";        
     }
-
 }
 
 =head type_constraint ($type_constraint)
@@ -57,12 +59,12 @@ Set/Get the type_constraint.
 
 =cut
 
-sub type_constraint {
+sub __type_constraint {
     my $self = shift @_;
     if(defined(my $tc = shift @_)) {
-        $self->{type_constraint} = $tc;
+        $self->{__type_constraint} = $tc;
     }
-    return $self->{type_constraint};
+    return $self->{__type_constraint};
 }
 
 =head2 isa
@@ -74,8 +76,7 @@ handle $self->isa since AUTOLOAD can't.
 sub isa {
     my ($self, $target) = @_;
     if(defined $target) {
-        my $isa = $self->type_constraint->isa($target);
-        return $isa;
+        return $self->__type_constraint->isa($target);
     } else {
         return;
     }
@@ -90,8 +91,7 @@ handle $self->can since AUTOLOAD can't.
 sub can {
     my ($self, $target) = @_;
     if(defined $target) {
-        my $can = $self->type_constraint->can($target);
-        return $can;
+        return $self->__type_constraint->can($target);
     } else {
         return;
     }
@@ -114,8 +114,13 @@ Delegate to the decorator targe
 =cut
 
 sub AUTOLOAD {
+    my ($self, @args) = @_;
     my ($method) = (our $AUTOLOAD =~ /([^:]+)$/);
-    return shift->type_constraint->$method(@_);
+    if($self->__type_constraint->can($method)) {
+        return $self->__type_constraint->$method(@args);
+    } else {
+        croak "Method '$method' is not supported";   
+    }
 }
 
 =head1 AUTHOR AND COPYRIGHT
index cc600f4..89cc3a2 100644 (file)
@@ -26,7 +26,10 @@ use lib "$FindBin::Bin/lib";
     has 'StrOrArrayRef' => (is=>'rw', isa=>StrOrArrayRef);
     has 'AtLeastOneInt' => (is=>'rw', isa=>AtLeastOneInt);
     has 'pipeoverloading' => (is=>'rw', isa=>Int|Str);
-    has 'deep' => (is=>'rw', isa=>ArrayRef([ArrayRef([HashRef([Int])])]));
+    #has 'deep' => (is=>'rw', isa=>ArrayRef([ArrayRef([HashRef([Int])])]));
+    
+    has 'deep' => (is=>'rw', isa=>ArrayRef[ArrayRef[HashRef[Int]]] );
+    
 }
 
 ## Make sure we have a 'create object sanity check'
index 6ded368..9eee6ff 100644 (file)
@@ -1,8 +1,5 @@
 package DecoratorLibrary;
 
-use warnings;
-use strict;
-
 use MooseX::Types::Moose qw( Str ArrayRef HashRef Int );
 use MooseX::Types
     -declare => [qw(
@@ -15,6 +12,21 @@ use MooseX::Types
         AtLeastOneInt
     )];
 
+## Some questionable messing around
+    sub my_subtype {
+        my ($subtype, $basetype, @rest) = @_;
+        return subtype($subtype, $basetype, shift @rest, shift @rest);
+    }
+    
+    sub my_from {
+        return @_;
+        
+    }
+    sub my_as {
+        return @_;
+    }
+## End
+
 subtype MyArrayRefBase,
     as ArrayRef;
     
@@ -48,17 +60,19 @@ coerce MyArrayRefInt02,
     from MyHashRefOfStr,
     via {[ sort map { length $_ } values(%$_) ]},
     ## Can't do HashRef[ArrayRef] here since if I do HashRef get the via {}
-    ## Stuff passed as args.  
-    from HashRef([ArrayRef]),
+    ## Stuff passed as args and the associated prototype messed with it.  MST
+    ## seems to have a line on it but might not fix fixable.
+    from (HashRef[ArrayRef]),
     via {[ sort map { @$_ } values(%$_) ]};
 
 subtype StrOrArrayRef,
     as Str|ArrayRef;
-    
+
 subtype AtLeastOneInt,
     ## Same problem as MyArrayRefInt02, see above.  Another way to solve it by
     ## forcing some sort of context.  Tried to fix this with method prototypes
     ## but just couldn't make it work.
     as (ArrayRef[Int]),
     where { @$_ > 0 };
+
 1;