lib/MooseX/Types/Structured.pm

   1 package MooseX::Types::Structured;
   2
   3 use Moose;
   4 use Moose::Util::TypeConstraints;
   5 use MooseX::Meta::TypeConstraint::Structured;
   6 use MooseX::Types -declare => [qw(Dict Tuple)];
   7
   8
   9 our $VERSION = '0.02';
  10 our $AUTHORITY = 'cpan:JJNAPIORK';
  11
  12 =head1 NAME
  13
  14 MooseX::Types::Structured - Structured Type Constraints for Moose
  15
  16 =head1 SYNOPSIS
  17
  18 The following is example usage for this module.
  19
  20     package MyApp::MyClass;
  21
  22     use Moose;
  23     use MooseX::Types::Moose qw(Str Int);
  24     use MooseX::Types::Structured qw(Dict Tuple);
  25
  26     has name => (isa=>Dict[first_name=>Str, last_name=>Str]);
  27
  28 Then you can instantiate this class with something like:
  29
  30     my $instance = MyApp::MyClass->new(
  31                 name=>{first_name=>'John', last_name=>'Napiorkowski'},
  32         );
  33
  34 But all of these would cause an error:
  35
  36     my $instance = MyApp::MyClass->new(name=>'John');
  37     my $instance = MyApp::MyClass->new(name=>{first_name=>'John'});
  38     my $instance = MyApp::MyClass->new(name=>{first_name=>'John', age=>39});
  39
  40 Please see the test cases for more examples.
  41
  42 =head1 DESCRIPTION
  43
  44 A structured type constraint is a standard container L</Moose> type constraint,
  45 such as an arrayref or hashref, which has been enhanced to allow you to
  46 explicitely name all the allow type constraints inside the structure.  The
  47 generalized form is:
  48
  49     TypeConstraint[TypeParameters]
  50
  51 Where TypeParameters is a list of type constraints.
  52
  53 This type library enables structured type constraints. These work in a similar
  54 way to parameterized constraints that are built into the core Moose types,
  55 except that you are allowed to define the container's entire structure.  For
  56 example, you could define a parameterized constraint like so:
  57
  58     subtype HashOfInts,
  59      as Hashref[Int];
  60
  61 which would constraint a value to something like [1,2,3,...] and so on.  On the
  62 other hand, a structured type constrain explicitly names all it's allowed type
  63 parameter constraints.  For the example:
  64
  65     subtype StringFollowedByInt,
  66      as Tuple[Str,Int];
  67
  68 would constrain it's value to something like ['hello', 111];
  69
  70 These structures can be as simple or elaborate as you wish.  You can even
  71 combine various structured, parameterized and simple constraints all together:
  72
  73     subtype crazy,
  74      as Tuple[
  75         Int,
  76         Dict[name=>Str, age=>Int],
  77         ArrayRef[Int]
  78      ];
  79
  80 Which would match "[1, {name=>'John', age=>25},[10,11,12]]".  Please notice how
  81 the type parameters
  82
  83 You should exercise some care as to whether or not your complex structured
  84 constraints would be better off contained by a real object as in the following
  85 example:
  86
  87     package MyApp::MyStruct;
  88     use Moose;
  89
  90     has $_ for qw(name age);
  91
  92     package MyApp::MyClass;
  93     use Moose;
  94
  95     has person => (isa=>'MyApp::MyStruct');
  96
  97     my $instance = MyApp::MyClass->new(
  98         person=>MyApp::MyStruct->new(name=>'John', age=>39),
  99     );
 100
 101 This method may take some additional time to setup but will give you more
 102 flexibility.  However, structured constraints are highly compatible with this
 103 method, granting some interesting possibilities for coercion.  Try:
 104
 105     subtype 'MyStruct',
 106      as 'MyApp::MyStruct';
 107
 108     coerce 'MyStruct',
 109      from (Dict[name=>Str, age=>Int]),
 110      via {
 111         MyApp::MyStruct->new(%$_);
 112      },
 113      from (Dict[last_name=>Str, first_name=>Str, dob=>DateTime]),
 114      via {
 115         my $name = $_->{first_name} .' '. $_->{last_name};
 116         my $age = DateTime->now - $_->{dob};
 117         MyApp::MyStruct->new(
 118         name=>$name,
 119         age=>$age->years );
 120      };
 121
 122 =head2 Subtyping a structured subtype
 123
 124 You need to exercise some care when you try to subtype a structured type
 125 as in this example:
 126
 127     subtype Person,
 128      as Dict[name=>Str, age=>iIt];
 129
 130     subtype FriendlyPerson,
 131      as Person[name=>Str, age=>Int, totalFriends=>Int];
 132
 133 This will actually work BUT you have to take care that the subtype has a
 134 structure that does not contradict the structure of it's parent.  For now the
 135 above works, but I will probably clarify how this works at a future point, so
 136 it's recommended to avoid (should not realy be needed so much anyway).  For
 137 now this is supported in an EXPERIMENTAL way.  In the future we will probably
 138 clarify how to augment existing structured types.
 139
 140 =head2 Coercions
 141
 142 Coercions currently work for 'one level' deep.  That is you can do:
 143
 144     subtype Person,
 145      as Dict[name=>Str, age=>Int];
 146
 147     subtype Fullname,
 148      as Dict[first=>Str, last=>Str];
 149
 150     coerce Person,
 151      from BlessedPersonObject,
 152      via { +{name=>$_->name, age=>$_->age} },
 153      from ArrayRef,
 154      via { +{name=>$_->[0], age=>$_->[1] },
 155      from Dict[fullname=>Fullname, dob=>DateTime],
 156      via {
 157         my $age = $_->dob - DateTime->now;
 158         +{
 159             name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last},
 160             age=>$age->years
 161         }
 162      };
 163
 164 And that should just work as expected.  However, if there are any 'inner'
 165 coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
 166 won't currently get activated.
 167
 168 Please see the test '07-coerce.t' for a more detailed example.
 169
 170 =head1 TYPE CONSTRAINTS
 171
 172 This type library defines the following constraints.
 173
 174 =head2 Tuple[@constraints]
 175
 176 This defines an arrayref based constraint which allows you to validate a specific
 177 list of constraints.  For example:
 178
 179     Tuple[Int,Str]; ## Validates [1,'hello']
 180     Tuple[Str|Object, Int]; ##Validates ['hello', 1] or [$object, 2]
 181
 182 =head2 Dict [%constraints]
 183
 184 This defines a hashref based constraint which allowed you to validate a specific
 185 hashref.  For example:
 186
 187     Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
 188
 189 =cut
 190
 191 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 192         MooseX::Meta::TypeConstraint::Structured->new(
 193                 name => "MooseX::Types::Structured::Tuple" ,
 194                 parent => find_type_constraint('ArrayRef'),
 195                 constraint_generator=> sub {
 196                         ## Get the constraints and values to check
 197                         my @type_constraints = @{shift @_};
 198                         my @values = @{shift @_};
 199                         ## Perform the checking
 200                         while(@type_constraints) {
 201                                 my $type_constraint = shift @type_constraints;
 202                                 if(@values) {
 203                                         my $value = shift @values;
 204                                         unless($type_constraint->check($value)) {
 205                                                 return;
 206                                         }
 207                                 } else {
 208                                         return;
 209                                 }
 210                         }
 211                         ## Make sure there are no leftovers.
 212                         if(@values) {
 213                                 return;
 214                         } elsif(@type_constraints) {
 215                                 return;
 216                         }else {
 217                                 return 1;
 218                         }
 219                 }
 220         )
 221 );
 222
 223 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 224         MooseX::Meta::TypeConstraint::Structured->new(
 225                 name => "MooseX::Types::Structured::Dict",
 226                 parent => find_type_constraint('HashRef'),
 227                 constraint_generator=> sub {
 228                         ## Get the constraints and values to check
 229                         my %type_constraints = @{shift @_};
 230                         my %values = %{shift @_};
 231                         ## Perform the checking
 232                         while(%type_constraints) {
 233                                 my($key, $type_constraint) = each %type_constraints;
 234                                 delete $type_constraints{$key};
 235                                 if(exists $values{$key}) {
 236                                         my $value = $values{$key};
 237                                         delete $values{$key};
 238                                         unless($type_constraint->check($value)) {
 239                                                 return;
 240                                                 #if ($type_constraint->has_coercion) {
 241                                                 #       my $temp = $type_constraint->coerce($value);
 242                                                 #       use Data::Dump qw/dump/; warn dump $value, $temp;
 243                                                 #       unless($type_constraint->check($temp)) {
 244                                                 #               return;
 245                                                 #       }
 246                                                 #} else {
 247                                                 #       return;
 248                                                 #}
 249                                         }
 250                                 } else {
 251                                         return;
 252                                 }
 253                         }
 254                         ## Make sure there are no leftovers.
 255                         if(%values) {
 256                                 return;
 257                         } elsif(%type_constraints) {
 258                                 return;
 259                         }else {
 260                                 return 1;
 261                         }
 262                 },
 263         )
 264 );
 265
 266 =head1 SEE ALSO
 267
 268 The following modules or resources may be of interest.
 269
 270 L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>,
 271 L<MooseX::Meta::TypeConstraint::Structured>
 272
 273 =head1 TODO
 274
 275 Need to clarify deep coercions, need to clarify subtypes of subtypes.
 276
 277 =head1 AUTHOR
 278
 279 John Napiorkowski, C<< <jjnapiork@cpan.org> >>
 280
 281 =head1 COPYRIGHT & LICENSE
 282
 283 This program is free software; you can redistribute it and/or modify
 284 it under the same terms as Perl itself.
 285
 286 =cut
 287
 288 1;