updated changelog in preparation for release, added immutable to files that needed...
[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm
index 9a7a282..c4231af 100644 (file)
@@ -1,12 +1,11 @@
 package MooseX::Types::Structured;
 
-use 5.008008;
-use Moose;
+use 5.008;
 use Moose::Util::TypeConstraints;
 use MooseX::Meta::TypeConstraint::Structured;
-use MooseX::Types -declare => [qw(Dict Tuple)];
+use MooseX::Types -declare => [qw(Dict Tuple Optional)];
 
-our $VERSION = '0.03';
+our $VERSION = '0.06';
 our $AUTHORITY = 'cpan:JJNAPIORK';
 
 =head1 NAME
@@ -21,22 +20,41 @@ The following is example usage for this module.
        
     use Moose;
     use MooseX::Types::Moose qw(Str Int);
-    use MooseX::Types::Structured qw(Dict Tuple);
-
-    has name => (isa=>Dict[first_name=>Str, last_name=>Str]);
+    use MooseX::Types::Structured qw(Dict Optional);
+
+    ## A name has a first and last part, but middle names are not required
+    has name => (
+        isa=>Dict[
+            first=>Str,
+            last=>Str,
+            middle=>Optional[Str],
+        ],
+    );
 
 Then you can instantiate this class with something like:
 
-    my $instance = MyApp::MyClass->new(
-               name=>{first_name=>'John', last_name=>'Napiorkowski'},
-       );
-
-But all of these would cause an error:
+    my $john = MyApp::MyClass->new(
+        name => {
+            first=>'John',
+            middle=>'James'
+            last=>'Napiorkowski',
+        },
+    );
+    
+    my $vanessa = MyApp::MyClass->new(
+        name => {
+            first=>'Vanessa',
+            last=>'Li'
+        },
+    );
 
-    my $instance = MyApp::MyClass->new(name=>'John');
-    my $instance = MyApp::MyClass->new(name=>{first_name=>'John'});
-    my $instance = MyApp::MyClass->new(name=>{first_name=>'John', age=>39});
+But all of these would cause a constraint error for the 'name' attribute:
 
+    MyApp::MyClass->new( name=>'John' );
+    MyApp::MyClass->new( name=>{first_name=>'John'} );
+    MyApp::MyClass->new( name=>{first_name=>'John', age=>39} );
+    MyApp::MyClass->new( name=>{first=>'Vanessa', middle=>[1,2], last=>'Li'} );
+    
 Please see the test cases for more examples.
 
 =head1 DESCRIPTION
@@ -48,7 +66,8 @@ generalized form is:
 
     TypeConstraint[TypeParameters]
 
-Where TypeParameters is a list of type constraints.
+Where 'TypeParameters' is an array or hash of L</Moose::Meta::TypeConstraint> 
+type constraints.
 
 This type library enables structured type constraints. It is build on top of the
 L<MooseX::Types> library system, so you should review the documentation for that
@@ -60,8 +79,8 @@ Parameterized constraints are built into the core Moose types 'HashRef' and
 'ArrayRef'.  Structured types have similar functionality, so their syntax is
 likewise similar. For example, you could define a parameterized constraint like:
 
-    subtype HashOfInts,
-     as Hashref[Int];
+    subtype ArrayOfInts,
+     as Arrayref[Int];
 
 which would constraint a value to something like [1,2,3,...] and so on.  On the
 other hand, a structured type constraint explicitly names all it's allowed type
@@ -71,7 +90,23 @@ parameter constraints.  For the example:
      as Tuple[Str,Int];
        
 would constrain it's value to something like ['hello', 111] but ['hello', 'world']
-would fail, as well as ['hello', 111, 'world']
+would fail, as well as ['hello', 111, 'world'] and so on.
+
+Structured Constraints are not limited to arrays.  You can define a structure
+against a hashref with 'Dict' as in this example:
+
+    subtype FirstNameLastName,
+     as Dict[firste=>Str, lastname=>Str];
+
+This would constrain a hashref to something like:
+
+    {firstname=>'Vanessa', lastname=>'Li'};
+    
+but all the following would fail validation:
+
+     {first=>'Vanessa', last=>'Li'};
+     {firstname=>'Vanessa', lastname=>'Li', middlename=>'NA'};   
+     ['Vanessa', 'Li']; 
 
 These structures can be as simple or elaborate as you wish.  You can even
 combine various structured, parameterized and simple constraints all together:
@@ -131,7 +166,7 @@ You need to exercise some care when you try to subtype a structured type
 as in this example:
 
     subtype Person,
-     as Dict[name=>Str, age=>iIt];
+     as Dict[name=>Str, age=>Int];
         
     subtype FriendlyPerson,
      as Person[name=>Str, age=>Int, totalFriends=>Int];
@@ -154,10 +189,13 @@ Coercions currently work for 'one level' deep.  That is you can do:
      as Dict[first=>Str, last=>Str];
     
     coerce Person,
+     ## Coerce an object of a particular class
      from BlessedPersonObject,
      via { +{name=>$_->name, age=>$_->age} },
+     ## Coerce from [$name, $age]
      from ArrayRef,
      via { +{name=>$_->[0], age=>$_->[1] },
+     ## Coerce from {fullname=>{first=>...,last=>...}, dob=>$DateTimeObject}
      from Dict[fullname=>Fullname, dob=>DateTime],
      via {
         my $age = $_->dob - DateTime->now;
@@ -192,6 +230,29 @@ hashref.  For example:
 
     Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
 
+=head2 Optional [$constraint]
+
+This is primarily a helper constraint for Dict and Tuple type constraints.  What
+this allows if for you to assert that a given type constraint is allowed to be
+null (but NOT undefined).  If the value is null, then the type constraint passes
+but if the value is defined it must validate against the type constraint.  This
+makes it easy to make a Dict where one or more of the keys doesn't have to exist
+or a tuple where some of the values are not required.  For example:
+
+    subtype Name() => as Dict[
+        first=>Str,
+        last=>Str,
+        middle=>Optional[Str],
+    ];
+        
+Creates a constraint that validates against a hashref with the keys 'first' and
+'last' being strings and required while an optional key 'middle' is must be a
+string if it appears but doesn't have to appear.  So in this case both the
+following are valid:
+
+    {first=>'John', middle=>'James', last=>'Napiorkowski'}
+    {first=>'Vanessa', last=>'Li'}
+    
 =head1 EXAMPLES
 
 Here are some additional example usage for structured types.  All examples can
@@ -237,10 +298,11 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
        MooseX::Meta::TypeConstraint::Structured->new(
                name => "MooseX::Types::Structured::Tuple" ,
                parent => find_type_constraint('ArrayRef'),
-               constraint_generator=> sub {
+               constraint_generator=> sub { 
                        ## Get the constraints and values to check
-                       my @type_constraints = @{shift @_};            
-                       my @values = @{shift @_};
+            my ($type_constraints, $values) = @_;
+                       my @type_constraints = defined $type_constraints ? @$type_constraints: ();            
+                       my @values = defined $values ? @$values: ();
                        ## Perform the checking
                        while(@type_constraints) {
                                my $type_constraint = shift @type_constraints;
@@ -250,7 +312,9 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                                return;
                                        }                               
                                } else {
-                                       return;
+                                       unless($type_constraint->check()) {
+                                               return;
+                                       }
                                }
                        }
                        ## Make sure there are no leftovers.
@@ -269,10 +333,11 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
        MooseX::Meta::TypeConstraint::Structured->new(
                name => "MooseX::Types::Structured::Dict",
                parent => find_type_constraint('HashRef'),
-               constraint_generator=> sub {
+               constraint_generator=> sub { 
                        ## Get the constraints and values to check
-                       my %type_constraints = @{shift @_};            
-                       my %values = %{shift @_};
+            my ($type_constraints, $values) = @_;
+                       my %type_constraints = defined $type_constraints ? @$type_constraints: ();            
+                       my %values = defined $values ? %$values: ();
                        ## Perform the checking
                        while(%type_constraints) {
                                my($key, $type_constraint) = each %type_constraints;
@@ -283,12 +348,14 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                        unless($type_constraint->check($value)) {
                                                return;
                                        }
-                               } else {
-                                       return;
+                               } else { 
+                                       unless($type_constraint->check()) {
+                                               return;
+                                       }
                                }
                        }
                        ## Make sure there are no leftovers.
-                       if(%values) {
+                       if(%values) { 
                                return;
                        } elsif(%type_constraints) {
                                return;
@@ -299,6 +366,33 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
        )
 );
 
+OPTIONAL: {
+    my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
+        name => 'MooseX::Types::Structured::Optional',
+        package_defined_in => __PACKAGE__,
+        parent => find_type_constraint('Item'),
+        constraint => sub { 1 },
+        constraint_generator => sub {
+            my ($type_parameter, @args) = @_;
+            my $check = $type_parameter->_compiled_type_constraint();
+            return sub {
+                my (@args) = @_;                       
+                if(exists($args[0])) {
+                    ## If it exists, we need to validate it
+                    $check->($args[0]);
+                } else {
+                    ## But it's is okay if the value doesn't exists
+                    return 1;
+                }
+            }
+        }
+    );
+
+    Moose::Util::TypeConstraints::register_type_constraint($Optional);
+    Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
+}
+
+
 =head1 SEE ALSO
 
 The following modules or resources may be of interest.