lib/MooseX/Types/Structured.pm

   1 package MooseX::Types::Structured;
   2
   3 use 5.008;
   4 use Moose;
   5 use Moose::Util::TypeConstraints;
   6 use MooseX::Meta::TypeConstraint::Structured;
   7 use MooseX::Types -declare => [qw(Dict Tuple Optional)];
   8
   9 our $VERSION = '0.06';
  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 Optional);
  25
  26     ## A name has a first and last part, but middle names are not required
  27     has name => (
  28         isa=>Dict[
  29             first=>Str,
  30             last=>Str,
  31             middle=>Optional[Str],
  32         ],
  33     );
  34
  35 Then you can instantiate this class with something like:
  36
  37     my $john = MyApp::MyClass->new(
  38         name => {
  39             first=>'John',
  40             middle=>'James'
  41             last=>'Napiorkowski',
  42         },
  43     );
  44
  45     my $vanessa = MyApp::MyClass->new(
  46         name => {
  47             first=>'Vanessa',
  48             last=>'Li'
  49         },
  50     );
  51
  52 But all of these would cause a constraint error for the 'name' attribute:
  53
  54     MyApp::MyClass->new( name=>'John' );
  55     MyApp::MyClass->new( name=>{first_name=>'John'} );
  56     MyApp::MyClass->new( name=>{first_name=>'John', age=>39} );
  57     MyApp::MyClass->new( name=>{first=>'Vanessa', middle=>[1,2], last=>'Li'} );
  58
  59 Please see the test cases for more examples.
  60
  61 =head1 DESCRIPTION
  62
  63 A structured type constraint is a standard container L</Moose> type constraint,
  64 such as an arrayref or hashref, which has been enhanced to allow you to
  65 explicitly name all the allow type constraints inside the structure.  The
  66 generalized form is:
  67
  68     TypeConstraint[TypeParameters]
  69
  70 Where 'TypeParameters' is an array or hash of L</Moose::Meta::TypeConstraint>
  71 type constraints.
  72
  73 This type library enables structured type constraints. It is build on top of the
  74 L<MooseX::Types> library system, so you should review the documentation for that
  75 if you are not familiar with it.
  76
  77 =head2 Comparing Parameterized types to Structured types
  78
  79 Parameterized constraints are built into the core Moose types 'HashRef' and
  80 'ArrayRef'.  Structured types have similar functionality, so their syntax is
  81 likewise similar. For example, you could define a parameterized constraint like:
  82
  83     subtype ArrayOfInts,
  84      as Arrayref[Int];
  85
  86 which would constraint a value to something like [1,2,3,...] and so on.  On the
  87 other hand, a structured type constraint explicitly names all it's allowed type
  88 parameter constraints.  For the example:
  89
  90     subtype StringFollowedByInt,
  91      as Tuple[Str,Int];
  92
  93 would constrain it's value to something like ['hello', 111] but ['hello', 'world']
  94 would fail, as well as ['hello', 111, 'world'] and so on.
  95
  96 Structured Constraints are not limited to arrays.  You can define a structure
  97 against a hashref with 'Dict' as in this example:
  98
  99     subtype FirstNameLastName,
 100      as Dict[firste=>Str, lastname=>Str];
 101
 102 This would constrain a hashref to something like:
 103
 104     {firstname=>'Vanessa', lastname=>'Li'};
 105
 106 but all the following would fail validation:
 107
 108      {first=>'Vanessa', last=>'Li'};
 109      {firstname=>'Vanessa', lastname=>'Li', middlename=>'NA'};
 110      ['Vanessa', 'Li'];
 111
 112 These structures can be as simple or elaborate as you wish.  You can even
 113 combine various structured, parameterized and simple constraints all together:
 114
 115     subtype crazy,
 116      as Tuple[
 117         Int,
 118         Dict[name=>Str, age=>Int],
 119         ArrayRef[Int]
 120      ];
 121
 122 Which would match "[1, {name=>'John', age=>25},[10,11,12]]".  Please notice how
 123 the type parameters can be visually arranged to your liking and to improve the
 124 clarity of your meaning.  You don't need to run then altogether onto a single
 125 line.
 126
 127 =head2 Alternatives
 128
 129 You should exercise some care as to whether or not your complex structured
 130 constraints would be better off contained by a real object as in the following
 131 example:
 132
 133     package MyApp::MyStruct;
 134     use Moose;
 135
 136     has $_ for qw(name age);
 137
 138     package MyApp::MyClass;
 139     use Moose;
 140
 141     has person => (isa=>'MyApp::MyStruct');
 142
 143     my $instance = MyApp::MyClass->new(
 144         person=>MyApp::MyStruct->new(name=>'John', age=>39),
 145     );
 146
 147 This method may take some additional time to setup but will give you more
 148 flexibility.  However, structured constraints are highly compatible with this
 149 method, granting some interesting possibilities for coercion.  Try:
 150
 151     subtype 'MyStruct',
 152      as 'MyApp::MyStruct';
 153
 154     coerce 'MyStruct',
 155      from (Dict[name=>Str, age=>Int]),
 156      via { MyApp::MyStruct->new(%$_) },
 157      from (Dict[last_name=>Str, first_name=>Str, dob=>DateTime]),
 158      via {
 159         my $name = $_->{first_name} .' '. $_->{last_name};
 160         my $age = DateTime->now - $_->{dob};
 161         MyApp::MyStruct->new( name=>$name, age=>$age->years );
 162      };
 163
 164 =head2 Subtyping a structured subtype
 165
 166 You need to exercise some care when you try to subtype a structured type
 167 as in this example:
 168
 169     subtype Person,
 170      as Dict[name=>Str, age=>Int];
 171
 172     subtype FriendlyPerson,
 173      as Person[name=>Str, age=>Int, totalFriends=>Int];
 174
 175 This will actually work BUT you have to take care that the subtype has a
 176 structure that does not contradict the structure of it's parent.  For now the
 177 above works, but I will clarify the syntax for this at a future point, so
 178 it's recommended to avoid (should not realy be needed so much anyway).  For
 179 now this is supported in an EXPERIMENTAL way.  Your thoughts, test cases and
 180 patches are welcomed for discussion.
 181
 182 =head2 Coercions
 183
 184 Coercions currently work for 'one level' deep.  That is you can do:
 185
 186     subtype Person,
 187      as Dict[name=>Str, age=>Int];
 188
 189     subtype Fullname,
 190      as Dict[first=>Str, last=>Str];
 191
 192     coerce Person,
 193      ## Coerce an object of a particular class
 194      from BlessedPersonObject,
 195      via { +{name=>$_->name, age=>$_->age} },
 196      ## Coerce from [$name, $age]
 197      from ArrayRef,
 198      via { +{name=>$_->[0], age=>$_->[1] },
 199      ## Coerce from {fullname=>{first=>...,last=>...}, dob=>$DateTimeObject}
 200      from Dict[fullname=>Fullname, dob=>DateTime],
 201      via {
 202         my $age = $_->dob - DateTime->now;
 203         +{
 204             name=> $_->{fullname}->{first} .' '. $_->{fullname}->{last},
 205             age=>$age->years
 206         }
 207      };
 208
 209 And that should just work as expected.  However, if there are any 'inner'
 210 coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
 211 won't currently get activated.
 212
 213 Please see the test '07-coerce.t' for a more detailed example.
 214
 215 =head1 TYPE CONSTRAINTS
 216
 217 This type library defines the following constraints.
 218
 219 =head2 Tuple[@constraints]
 220
 221 This defines an arrayref based constraint which allows you to validate a specific
 222 list of constraints.  For example:
 223
 224     Tuple[Int,Str]; ## Validates [1,'hello']
 225     Tuple[Str|Object, Int]; ##Validates ['hello', 1] or [$object, 2]
 226
 227 =head2 Dict [%constraints]
 228
 229 This defines a hashref based constraint which allowed you to validate a specific
 230 hashref.  For example:
 231
 232     Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
 233
 234 =head2 Optional [$constraint]
 235
 236 This is primarily a helper constraint for Dict and Tuple type constraints.  What
 237 this allows if for you to assert that a given type constraint is allowed to be
 238 null (but NOT undefined).  If the value is null, then the type constraint passes
 239 but if the value is defined it must validate against the type constraint.  This
 240 makes it easy to make a Dict where one or more of the keys doesn't have to exist
 241 or a tuple where some of the values are not required.  For example:
 242
 243     subtype Name() => as Dict[
 244         first=>Str,
 245         last=>Str,
 246         middle=>Optional[Str],
 247     ];
 248
 249 Creates a constraint that validates against a hashref with the keys 'first' and
 250 'last' being strings and required while an optional key 'middle' is must be a
 251 string if it appears but doesn't have to appear.  So in this case both the
 252 following are valid:
 253
 254     {first=>'John', middle=>'James', last=>'Napiorkowski'}
 255     {first=>'Vanessa', last=>'Li'}
 256
 257 =head1 EXAMPLES
 258
 259 Here are some additional example usage for structured types.  All examples can
 260 be found also in the 't/examples.t' test.  Your contributions are also welcomed.
 261
 262 =head2 Normalize a HashRef
 263
 264 You need a hashref to conform to a canonical structure but are required accept a
 265 bunch of different incoming structures.  You can normalize using the Dict type
 266 constraint and coercions.  This example also shows structured types mixed which
 267 other MooseX::Types libraries.
 268
 269     package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
 270
 271     use Moose;
 272     use DateTime;
 273
 274     use MooseX::Types::Structured qw(Dict Tuple);
 275     use MooseX::Types::DateTime qw(DateTime);
 276     use MooseX::Types::Moose qw(Int Str Object);
 277     use MooseX::Types -declare => [qw(Name Age Person)];
 278
 279     subtype Person,
 280      as Dict[name=>Str, age=>Int];
 281
 282     coerce Person,
 283      from Dict[first=>Str, last=>Str, years=>Int],
 284      via { +{
 285         name => "$_->{first} $_->{last}",
 286         age=>$_->{years},
 287      }},
 288      from Dict[fullname=>Dict[last=>Str, first=>Str], dob=>DateTime],
 289      via { +{
 290         name => "$_->{fullname}{first} $_->{fullname}{last}",
 291         age => ($_->{dob} - 'DateTime'->now)->years,
 292      }};
 293
 294     has person => (is=>'rw', isa=>Person, coerce=>1);
 295
 296 =cut
 297
 298 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 299         MooseX::Meta::TypeConstraint::Structured->new(
 300                 name => "MooseX::Types::Structured::Tuple" ,
 301                 parent => find_type_constraint('ArrayRef'),
 302                 constraint_generator=> sub {
 303                         ## Get the constraints and values to check
 304             my ($type_constraints, $values) = @_;
 305                         my @type_constraints = defined $type_constraints ? @$type_constraints: ();
 306                         my @values = defined $values ? @$values: ();
 307                         ## Perform the checking
 308                         while(@type_constraints) {
 309                                 my $type_constraint = shift @type_constraints;
 310                                 if(@values) {
 311                                         my $value = shift @values;
 312                                         unless($type_constraint->check($value)) {
 313                                                 return;
 314                                         }
 315                                 } else {
 316                                         unless($type_constraint->check()) {
 317                                                 return;
 318                                         }
 319                                 }
 320                         }
 321                         ## Make sure there are no leftovers.
 322                         if(@values) {
 323                                 return;
 324                         } elsif(@type_constraints) {
 325                                 return;
 326                         }else {
 327                                 return 1;
 328                         }
 329                 }
 330         )
 331 );
 332
 333 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 334         MooseX::Meta::TypeConstraint::Structured->new(
 335                 name => "MooseX::Types::Structured::Dict",
 336                 parent => find_type_constraint('HashRef'),
 337                 constraint_generator=> sub {
 338                         ## Get the constraints and values to check
 339             my ($type_constraints, $values) = @_;
 340                         my %type_constraints = defined $type_constraints ? @$type_constraints: ();
 341                         my %values = defined $values ? %$values: ();
 342                         ## Perform the checking
 343                         while(%type_constraints) {
 344                                 my($key, $type_constraint) = each %type_constraints;
 345                                 delete $type_constraints{$key};
 346                                 if(exists $values{$key}) {
 347                                         my $value = $values{$key};
 348                                         delete $values{$key};
 349                                         unless($type_constraint->check($value)) {
 350                                                 return;
 351                                         }
 352                                 } else {
 353                                         unless($type_constraint->check()) {
 354                                                 return;
 355                                         }
 356                                 }
 357                         }
 358                         ## Make sure there are no leftovers.
 359                         if(%values) {
 360                                 return;
 361                         } elsif(%type_constraints) {
 362                                 return;
 363                         }else {
 364                                 return 1;
 365                         }
 366                 },
 367         )
 368 );
 369
 370 OPTIONAL: {
 371     my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
 372         name => 'MooseX::Types::Structured::Optional',
 373         package_defined_in => __PACKAGE__,
 374         parent => find_type_constraint('Item'),
 375         constraint => sub { 1 },
 376         constraint_generator => sub {
 377             my ($type_parameter, @args) = @_;
 378             my $check = $type_parameter->_compiled_type_constraint();
 379             return sub {
 380                 my (@args) = @_;
 381                 if(exists($args[0])) {
 382                     ## If it exists, we need to validate it
 383                     $check->($args[0]);
 384                 } else {
 385                     ## But it's is okay if the value doesn't exists
 386                     return 1;
 387                 }
 388             }
 389         }
 390     );
 391
 392     Moose::Util::TypeConstraints::register_type_constraint($Optional);
 393     Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
 394 }
 395
 396
 397 =head1 SEE ALSO
 398
 399 The following modules or resources may be of interest.
 400
 401 L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>,
 402 L<MooseX::Meta::TypeConstraint::Structured>
 403
 404 =head1 TODO
 405
 406 Need to clarify deep coercions, need to clarify subtypes of subtypes.
 407
 408 =head1 AUTHOR
 409
 410 John Napiorkowski, C<< <jjnapiork@cpan.org> >>
 411
 412 =head1 COPYRIGHT & LICENSE
 413
 414 This program is free software; you can redistribute it and/or modify
 415 it under the same terms as Perl itself.
 416
 417 =cut
 418
 419 1;