finished Optional, wrote docs and tests for it
[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm
index 37b2efc..6063e4c 100644 (file)
@@ -1,12 +1,12 @@
 package MooseX::Types::Structured;
 
+use 5.008;
 use Moose;
 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.02';
+our $VERSION = '0.06';
 our $AUTHORITY = 'cpan:JJNAPIORK';
 
 =head1 NAME
@@ -21,51 +21,93 @@ 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
 
 A structured type constraint is a standard container L</Moose> type constraint,
 such as an arrayref or hashref, which has been enhanced to allow you to
-explicitely name all the allow type constraints inside the structure.  The
+explicitly name all the allow type constraints inside the structure.  The
 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
+if you are not familiar with it.
+
+=head2 Comparing Parameterized types to Structured types
 
-This type library enables structured type constraints. These work in a similar
-way to parameterized constraints that are built into the core Moose types,
-except that you are allowed to define the container's entire structure.  For
-example, you could define a parameterized constraint like so:
+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 constrain explicitly names all it's allowed type
+other hand, a structured type constraint explicitly names all it's allowed type
 parameter constraints.  For the example:
 
     subtype StringFollowedByInt,
      as Tuple[Str,Int];
        
-would constrain it's value to something like ['hello', 111];
+would constrain it's value to something like ['hello', 111] but ['hello', '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:
@@ -78,7 +120,11 @@ combine various structured, parameterized and simple constraints all together:
      ];
        
 Which would match "[1, {name=>'John', age=>25},[10,11,12]]".  Please notice how
-the type parameters
+the type parameters can be visually arranged to your liking and to improve the
+clarity of your meaning.  You don't need to run then altogether onto a single
+line.
+
+=head2 Alternatives
 
 You should exercise some care as to whether or not your complex structured
 constraints would be better off contained by a real object as in the following
@@ -107,16 +153,12 @@ method, granting some interesting possibilities for coercion.  Try:
     
     coerce 'MyStruct',
      from (Dict[name=>Str, age=>Int]),
-     via {
-        MyApp::MyStruct->new(%$_);
-     },
+     via { MyApp::MyStruct->new(%$_) },
      from (Dict[last_name=>Str, first_name=>Str, dob=>DateTime]),
      via {
         my $name = $_->{first_name} .' '. $_->{last_name};
         my $age = DateTime->now - $_->{dob};
-        MyApp::MyStruct->new(
-        name=>$name,
-        age=>$age->years );
+        MyApp::MyStruct->new( name=>$name, age=>$age->years );
      };
         
 =head2 Subtyping a structured subtype
@@ -125,17 +167,17 @@ 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];
         
 This will actually work BUT you have to take care that the subtype has a
 structure that does not contradict the structure of it's parent.  For now the
-above works, but I will probably clarify how this works at a future point, so
+above works, but I will clarify the syntax for this at a future point, so
 it's recommended to avoid (should not realy be needed so much anyway).  For
-now this is supported in an EXPERIMENTAL way.  In the future we will probably
-clarify how to augment existing structured types.
+now this is supported in an EXPERIMENTAL way.  Your thoughts, test cases and
+patches are welcomed for discussion.
 
 =head2 Coercions
 
@@ -148,10 +190,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;
@@ -186,16 +231,79 @@ 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
+be found also in the 't/examples.t' test.  Your contributions are also welcomed.
+
+=head2 Normalize a HashRef
+
+You need a hashref to conform to a canonical structure but are required accept a
+bunch of different incoming structures.  You can normalize using the Dict type
+constraint and coercions.  This example also shows structured types mixed which
+other MooseX::Types libraries.
+
+    package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
+    
+    use Moose;
+    use DateTime;
+    
+    use MooseX::Types::Structured qw(Dict Tuple);
+    use MooseX::Types::DateTime qw(DateTime);
+    use MooseX::Types::Moose qw(Int Str Object);
+    use MooseX::Types -declare => [qw(Name Age Person)];
+     
+    subtype Person,
+     as Dict[name=>Str, age=>Int];
+    
+    coerce Person,
+     from Dict[first=>Str, last=>Str, years=>Int],
+     via { +{
+        name => "$_->{first} $_->{last}",
+        age=>$_->{years},
+     }},
+     from Dict[fullname=>Dict[last=>Str, first=>Str], dob=>DateTime],
+     via { +{
+        name => "$_->{fullname}{first} $_->{fullname}{last}",
+        age => ($_->{dob} - 'DateTime'->now)->years,
+     }};
+     
+    has person => (is=>'rw', isa=>Person, coerce=>1);
+
 =cut
 
 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;
@@ -205,7 +313,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.
@@ -224,10 +334,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;
@@ -237,22 +348,15 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                        delete $values{$key};
                                        unless($type_constraint->check($value)) {
                                                return;
-                                               #if ($type_constraint->has_coercion) {    
-                                               #       my $temp = $type_constraint->coerce($value);
-                                               #       use Data::Dump qw/dump/; warn dump $value, $temp; 
-                                               #       unless($type_constraint->check($temp)) {
-                                               #               return;
-                                               #       }
-                                               #} else {
-                                               #       return;
-                                               #}
                                        }
-                               } else {
-                                       return;
+                               } else { 
+                                       unless($type_constraint->check()) {
+                                               return;
+                                       }
                                }
                        }
                        ## Make sure there are no leftovers.
-                       if(%values) {
+                       if(%values) { 
                                return;
                        } elsif(%type_constraints) {
                                return;
@@ -263,6 +367,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.