lib/MooseX/Types/Structured.pm

   1 package MooseX::Types::Structured;
   2
   3 use 5.008;
   4
   5 use Moose::Util::TypeConstraints;
   6 use MooseX::Meta::TypeConstraint::Structured;
   7 use MooseX::Types -declare => [qw(Dict Tuple Optional)];
   8 use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
   9
  10 our $VERSION = '0.07';
  11 our $AUTHORITY = 'cpan:JJNAPIORK';
  12
  13 =head1 NAME
  14
  15 MooseX::Types::Structured - Structured Type Constraints for Moose
  16
  17 =head1 SYNOPSIS
  18
  19 The following is example usage for this module.
  20
  21     package Person;
  22
  23     use Moose;
  24     use MooseX::Types::Moose qw(Str Int HashRef);
  25     use MooseX::Types::Structured qw(Dict Tuple Optional);
  26
  27     ## A name has a first and last part, but middle names are not required
  28     has name => (
  29         isa=>Dict[
  30             first => Str,
  31             last => Str,
  32             middle => Optional[Str],
  33         ],
  34     );
  35
  36     ## description is a string field followed by a HashRef of tagged data.
  37     has description => (
  38       isa=>Tuple[
  39         Str,
  40         Optional[HashRef],
  41      ],
  42     );
  43
  44 Then you can instantiate this class with something like:
  45
  46     my $john = Person->new(
  47         name => {
  48             first => 'John',
  49             middle => 'James'
  50             last => 'Napiorkowski',
  51         },
  52         description => [
  53             'A cool guy who loves Perl and Moose.', {
  54                 married_to => 'Vanessa Li',
  55                 born_in => 'USA',
  56             };
  57         ]
  58     );
  59
  60 Or with:
  61
  62     my $vanessa = Person->new(
  63         name => {
  64             first => 'Vanessa',
  65             last => 'Li'
  66         },
  67         description => ['A great student!'],
  68     );
  69
  70 But all of these would cause a constraint error for the 'name' attribute:
  71
  72     ## Value for 'name' not a HashRef
  73     Person->new( name => 'John' );
  74
  75     ## Value for 'name' has incorrect hash key and missing required keys
  76     Person->new( name => {
  77         first_name => 'John'
  78     });
  79
  80     ## Also incorrect keys
  81     Person->new( name => {
  82         first_name => 'John',
  83         age => 39,
  84     });
  85
  86     ## key 'middle' incorrect type, should be a Str not a ArrayRef
  87     Person->new( name => {
  88         first => 'Vanessa',
  89         middle => [1,2],
  90         last => 'Li',
  91     });
  92
  93 And these would cause a constraint error for the 'description' attribute:
  94
  95     ## Should be an ArrayRef
  96     Person->new( description => 'Hello I am a String' );
  97
  98     ## First element must be a string not a HashRef.
  99     Person->new (description => [{
 100         tag1 => 'value1',
 101         tag2 => 'value2'
 102     }]);
 103
 104 Please see the test cases for more examples.
 105
 106 =head1 DESCRIPTION
 107
 108 A structured type constraint is a standard container L<Moose> type constraint,
 109 such as an ArrayRef or HashRef, which has been enhanced to allow you to
 110 explicitly name all the allowed type constraints inside the structure.  The
 111 generalized form is:
 112
 113     TypeConstraint[@TypeParameters or %TypeParameters]
 114
 115 Where 'TypeParameters' is an array reference or hash references of
 116 L<Moose::Meta::TypeConstraint> objects.
 117
 118 This type library enables structured type constraints. It is built on top of the
 119 L<MooseX::Types> library system, so you should review the documentation for that
 120 if you are not familiar with it.
 121
 122 =head2 Comparing Parameterized types to Structured types
 123
 124 Parameterized constraints are built into core Moose and you are probably already
 125 familar with the type constraints 'HashRef' and 'ArrayRef'.  Structured types
 126 have similar functionality, so their syntax is likewise similar. For example,
 127 you could define a parameterized constraint like:
 128
 129     subtype ArrayOfInts,
 130      as Arrayref[Int];
 131
 132 which would constrain a value to something like [1,2,3,...] and so on.  On the
 133 other hand, a structured type constraint explicitly names all it's allowed
 134 'internal' type parameter constraints.  For the example:
 135
 136     subtype StringFollowedByInt,
 137      as Tuple[Str,Int];
 138
 139 would constrain it's value to things like ['hello', 111] but ['hello', 'world']
 140 would fail, as well as ['hello', 111, 'world'] and so on.  Here's another
 141 example:
 142
 143     subtype StringIntOptionalHashRef,
 144      as Tuple[
 145         Str, Int,
 146         Optional[HashRef]
 147      ];
 148
 149 This defines a type constraint that validates values like:
 150
 151     ['Hello', 100, {key1 => 'value1', key2 => 'value2'}];
 152     ['World', 200];
 153
 154 Notice that the last type constraint in the structure is optional.  This is
 155 enabled via the helper Optional type constraint, which is a variation of the
 156 core Moose type constraint 'Maybe'.  The main difference is that Optional type
 157 constraints are required to validate if they exist, while 'Maybe' permits
 158 undefined values.  So the following example would not validate:
 159
 160     StringIntOptionalHashRef->validate(['Hello Undefined', 1000, undef]);
 161
 162 Please note the subtle difference between undefined and null.  If you wish to
 163 allow both null and undefined, you should use the core Moose 'Maybe' type
 164 constraint instead:
 165
 166     use MooseX::Types -declare [qw(StringIntMaybeHashRef)];
 167     use MooseX::Types::Moose qw(Maybe);
 168     use MooseX::Types::Structured qw(Tuple);
 169
 170     subtype StringIntMaybeHashRef,
 171      as Tuple[
 172         Str, Int, Maybe[HashRef]
 173      ];
 174
 175 This would validate the following:
 176
 177     ['Hello', 100, {key1 => 'value1', key2 => 'value2'}];
 178     ['World', 200, undef];
 179     ['World', 200];
 180
 181 Structured constraints are not limited to arrays.  You can define a structure
 182 against a HashRef with 'Dict' as in this example:
 183
 184     subtype FirstNameLastName,
 185      as Dict[
 186         firstname => Str,
 187         lastname => Str,
 188      ];
 189
 190 This would constrain a HashRef to something like:
 191
 192     {firstname => 'Christopher', lastname= > 'Parsons'};
 193
 194 but all the following would fail validation:
 195
 196     ## Incorrect keys
 197     {first => 'Christopher', last => 'Parsons'};
 198
 199     ## Too many keys
 200     {firstname => 'Christopher', lastname => 'Parsons', middlename => 'Allen'};
 201
 202     ## Not a HashRef
 203     ['Christopher', 'Christopher'];
 204
 205 These structures can be as simple or elaborate as you wish.  You can even
 206 combine various structured, parameterized and simple constraints all together:
 207
 208     subtype Crazy,
 209      as Tuple[
 210         Int,
 211         Dict[name=>Str, age=>Int],
 212         ArrayRef[Int]
 213      ];
 214
 215 Which would match "[1, {name=>'John', age=>25},[10,11,12]]".  Please notice how
 216 the type parameters can be visually arranged to your liking and to improve the
 217 clarity of your meaning.  You don't need to run then altogether onto a single
 218 line.
 219
 220 =head2 Alternatives
 221
 222 You should exercise some care as to whether or not your complex structured
 223 constraints would be better off contained by a real object as in the following
 224 example:
 225
 226     package MyApp::MyStruct;
 227     use Moose;
 228
 229     ## lazy way to make a bunch of attributes
 230     has $_ for qw(full_name age_in_years);
 231
 232     package MyApp::MyClass;
 233     use Moose;
 234
 235     has person => (isa => 'MyApp::MyStruct');
 236
 237     my $instance = MyApp::MyClass->new(
 238         person=>MyApp::MyStruct->new(
 239             full_name => 'John',
 240             age_in_years => 39,
 241         ),
 242     );
 243
 244 This method may take some additional time to setup but will give you more
 245 flexibility.  However, structured constraints are highly compatible with this
 246 method, granting some interesting possibilities for coercion.  Try:
 247
 248     package MyApp::MyClass;
 249
 250     use Moose;
 251     use MyApp::MyStruct;
 252
 253     ## It's recommended your type declarations live in a separate class in order
 254     ## to promote reusability and clarity.  Inlined here for brevity.
 255
 256     use MooseX::Types::DateTime qw(DateTime);
 257     use MooseX::Types -declare [qw(MyStruct)];
 258     use MooseX::Types::Moose qw(Str Int);
 259     use MooseX::Types::Structured qw(Dict);
 260
 261     ## Use class_type to create an ISA type constraint if your object doesn't
 262     ## inherit from Moose::Object.
 263     class_type 'MyApp::MyStruct';
 264
 265     ## Just a shorter version really.
 266     subtype MyStruct,
 267      as 'MyApp::MyStruct';
 268
 269     ## Add the coercions.
 270     coerce MyStruct,
 271      from Dict[
 272         full_name=>Str,
 273         age_in_years=>Int
 274      ], via {
 275         MyApp::MyStruct->new(%$_);
 276      },
 277      from Dict[
 278         lastname=>Str,
 279         firstname=>Str,
 280         dob=>DateTime
 281      ], via {
 282         my $name = $_->{firstname} .' '. $_->{lastname};
 283         my $age = DateTime->now - $_->{dob};
 284
 285         MyApp::MyStruct->new(
 286             full_name=>$name,
 287             age_in_years=>$age->years,
 288         );
 289      };
 290
 291     has person => (isa=>MyStruct);
 292
 293 This would allow you to instantiate with something like:
 294
 295     my $obj = MyApp::MyClass->new( person => {
 296         full_name=>'John Napiorkowski',
 297         age_in_years=>39,
 298     });
 299
 300 Or even:
 301
 302     my $obj = MyApp::MyClass->new( person => {
 303         lastname=>'John',
 304         firstname=>'Napiorkowski',
 305         dob=>DateTime->new(year=>1969),
 306     });
 307
 308 If you are not familiar with how coercions work, check out the L<Moose> cookbook
 309 entry L<Moose::Cookbook::Recipe5> for an explanation.  The section L</Coercions>
 310 has additional examples and discussion.
 311
 312 =head2 Subtyping a Structured type constraint
 313
 314 You need to exercise some care when you try to subtype a structured type as in
 315 this example:
 316
 317     subtype Person,
 318      as Dict[name => Str];
 319
 320     subtype FriendlyPerson,
 321      as Person[
 322         name => Str,
 323         total_friends => Int,
 324      ];
 325
 326 This will actually work BUT you have to take care that the subtype has a
 327 structure that does not contradict the structure of it's parent.  For now the
 328 above works, but I will clarify the syntax for this at a future point, so
 329 it's recommended to avoid (should not really be needed so much anyway).  For
 330 now this is supported in an EXPERIMENTAL way.  Your thoughts, test cases and
 331 patches are welcomed for discussion.  If you find a good use for this, please
 332 let me know.
 333
 334 =head2 Coercions
 335
 336 Coercions currently work for 'one level' deep.  That is you can do:
 337
 338     subtype Person,
 339      as Dict[
 340         name => Str,
 341         age => Int
 342     ];
 343
 344     subtype Fullname,
 345      as Dict[
 346         first => Str,
 347         last => Str
 348      ];
 349
 350     coerce Person,
 351      ## Coerce an object of a particular class
 352      from BlessedPersonObject, via {
 353         +{
 354             name=>$_->name,
 355             age=>$_->age,
 356         };
 357      },
 358
 359      ## Coerce from [$name, $age]
 360      from ArrayRef, via {
 361         +{
 362             name=>$_->[0],
 363             age=>$_->[1],
 364         },
 365      },
 366      ## Coerce from {fullname=>{first=>...,last=>...}, dob=>$DateTimeObject}
 367      from Dict[fullname=>Fullname, dob=>DateTime], via {
 368         my $age = $_->dob - DateTime->now;
 369         my $firstn = $_->{fullname}->{first};
 370         my $lastn = $_->{fullname}->{last}
 371         +{
 372             name => $_->{fullname}->{first} .' '. ,
 373             age =>$age->years
 374         }
 375      };
 376
 377 And that should just work as expected.  However, if there are any 'inner'
 378 coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
 379 won't currently get activated.
 380
 381 Please see the test '07-coerce.t' for a more detailed example.  Discussion on
 382 extending coercions to support this welcome on the Moose development channel or
 383 mailing list.
 384
 385 =head2 Recursion
 386
 387 Newer versions of L<MooseX::Types> support recursive type constraints.  That is
 388 you can include a type constraint as a contained type constraint of itself.  For
 389 example:
 390
 391         subtype Person,
 392          as Dict[
 393                 name=>Str,
 394                 friends=>Optional[
 395                         ArrayRef[Person]
 396                 ],
 397          ];
 398
 399 This would declare a Person subtype that contains a name and an optional
 400 ArrayRef of Persons who are friends as in:
 401
 402         {
 403                 name => 'Mike',
 404                 friends => [
 405                         { name => 'John' },
 406                         { name => 'Vincent' },
 407                         {
 408                                 name => 'Tracey',
 409                                 friends => [
 410                                         { name => 'Stephenie' },
 411                                         { name => 'Ilya' },
 412                                 ],
 413                         },
 414                 ],
 415         };
 416
 417 Please take care to make sure the recursion node is either Optional, or declare
 418 a Union with an non recursive option such as:
 419
 420         subtype Value
 421          as Tuple[
 422                 Str,
 423                 Str|Tuple,
 424          ];
 425
 426 Which validates:
 427
 428         [
 429                 'Hello', [
 430                         'World', [
 431                                 'Is', [
 432                                         'Getting',
 433                                         'Old',
 434                                 ],
 435                         ],
 436                 ],
 437         ];
 438
 439 Otherwise you will define a subtype thatis impossible to validate since it is
 440 infinitely recursive.  For more information about defining recursive types,
 441 please see the documentation in L<MooseX::Types> and the test cases.
 442
 443 =head1 TYPE CONSTRAINTS
 444
 445 This type library defines the following constraints.
 446
 447 =head2 Tuple[@constraints]
 448
 449 This defines an ArrayRef based constraint which allows you to validate a specific
 450 list of contained constraints.  For example:
 451
 452     Tuple[Int,Str]; ## Validates [1,'hello']
 453     Tuple[Str|Object, Int]; ## Validates ['hello', 1] or [$object, 2]
 454
 455 =head2 Dict[%constraints]
 456
 457 This defines a HashRef based constraint which allowed you to validate a specific
 458 hashref.  For example:
 459
 460     Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
 461
 462 =head2 Optional[$constraint]
 463
 464 This is primarily a helper constraint for Dict and Tuple type constraints.  What
 465 this allows if for you to assert that a given type constraint is allowed to be
 466 null (but NOT undefined).  If the value is null, then the type constraint passes
 467 but if the value is defined it must validate against the type constraint.  This
 468 makes it easy to make a Dict where one or more of the keys doesn't have to exist
 469 or a tuple where some of the values are not required.  For example:
 470
 471     subtype Name() => as Dict[
 472         first=>Str,
 473         last=>Str,
 474         middle=>Optional[Str],
 475     ];
 476
 477 Creates a constraint that validates against a hashref with the keys 'first' and
 478 'last' being strings and required while an optional key 'middle' is must be a
 479 string if it appears but doesn't have to appear.  So in this case both the
 480 following are valid:
 481
 482     {first=>'John', middle=>'James', last=>'Napiorkowski'}
 483     {first=>'Vanessa', last=>'Li'}
 484
 485 =head1 EXAMPLES
 486
 487 Here are some additional example usage for structured types.  All examples can
 488 be found also in the 't/examples.t' test.  Your contributions are also welcomed.
 489
 490 =head2 Normalize a HashRef
 491
 492 You need a hashref to conform to a canonical structure but are required accept a
 493 bunch of different incoming structures.  You can normalize using the Dict type
 494 constraint and coercions.  This example also shows structured types mixed which
 495 other MooseX::Types libraries.
 496
 497     package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
 498
 499     use Moose;
 500     use DateTime;
 501
 502     use MooseX::Types::Structured qw(Dict Tuple);
 503     use MooseX::Types::DateTime qw(DateTime);
 504     use MooseX::Types::Moose qw(Int Str Object);
 505     use MooseX::Types -declare => [qw(Name Age Person)];
 506
 507     subtype Person,
 508      as Dict[
 509         name=>Str,
 510         age=>Int,
 511      ];
 512
 513     coerce Person,
 514      from Dict[
 515         first=>Str,
 516         last=>Str,
 517         years=>Int,
 518      ], via { +{
 519         name => "$_->{first} $_->{last}",
 520         age => $_->{years},
 521      }},
 522      from Dict[
 523         fullname=>Dict[
 524                 last=>Str,
 525                 first=>Str,
 526         ],
 527         dob=>DateTime,
 528      ],
 529      ## DateTime needs to be inside of single quotes here to disambiguate the
 530      ## class package from the DataTime type constraint imported via the
 531      ## line "use MooseX::Types::DateTime qw(DateTime);"
 532      via { +{
 533         name => "$_->{fullname}{first} $_->{fullname}{last}",
 534         age => ($_->{dob} - 'DateTime'->now)->years,
 535      }};
 536
 537     has person => (is=>'rw', isa=>Person, coerce=>1);
 538
 539 And now you can instantiate with all the following:
 540
 541     __PACKAGE__->new(
 542         name=>'John Napiorkowski',
 543         age=>39,
 544     );
 545
 546     __PACKAGE__->new(
 547         first=>'John',
 548         last=>'Napiorkowski',
 549         years=>39,
 550     );
 551
 552     __PACKAGE__->new(
 553         fullname => {
 554             first=>'John',
 555             last=>'Napiorkowski'
 556         },
 557         dob => 'DateTime'->new(
 558             year=>1969,
 559             month=>2,
 560             day=>13
 561         ),
 562     );
 563
 564 This technique is a way to support various ways to instantiate your class in a
 565 clean and declarative way.
 566
 567 =cut
 568
 569 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 570         MooseX::Meta::TypeConstraint::Structured->new(
 571                 name => "MooseX::Types::Structured::Tuple" ,
 572                 parent => find_type_constraint('ArrayRef'),
 573                 constraint_generator=> sub {
 574                         ## Get the constraints and values to check
 575             my ($type_constraints, $values) = @_;
 576                         my @type_constraints = defined $type_constraints ?
 577              @$type_constraints : ();
 578
 579             my $overflow_handler;
 580             if(ref $type_constraints[-1] eq 'CODE') {
 581                 $overflow_handler = pop @type_constraints;
 582             }
 583
 584                         my @values = defined $values ? @$values: ();
 585                         ## Perform the checking
 586                         while(@type_constraints) {
 587                                 my $type_constraint = shift @type_constraints;
 588                                 if(@values) {
 589                                         my $value = shift @values;
 590                                         unless($type_constraint->check($value)) {
 591                                                 return;
 592                                         }
 593                                 } else {
 594                     ## Test if the TC supports null values
 595                                         unless($type_constraint->check()) {
 596                                                 return;
 597                                         }
 598                                 }
 599                         }
 600                         ## Make sure there are no leftovers.
 601                         if(@values) {
 602                 if($overflow_handler) {
 603                     return $overflow_handler->(@values);
 604                 } else {
 605                     return;
 606                 }
 607                         } elsif(@type_constraints) {
 608                 warn "I failed due to left over TC";
 609                                 return;
 610                         } else {
 611                                 return 1;
 612                         }
 613                 }
 614         )
 615 );
 616
 617 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 618         MooseX::Meta::TypeConstraint::Structured->new(
 619                 name => "MooseX::Types::Structured::Dict",
 620                 parent => find_type_constraint('HashRef'),
 621                 constraint_generator=> sub {
 622                         ## Get the constraints and values to check
 623             my ($type_constraints, $values) = @_;
 624                         my @type_constraints = defined $type_constraints ?
 625              @$type_constraints : ();
 626
 627             my $overflow_handler;
 628             if(ref $type_constraints[-1] eq 'CODE') {
 629                 $overflow_handler = pop @type_constraints;
 630             }
 631             my (%type_constraints) = @type_constraints;
 632                         my %values = defined $values ? %$values: ();
 633                         ## Perform the checking
 634                         while(%type_constraints) {
 635                                 my($key, $type_constraint) = each %type_constraints;
 636                                 delete $type_constraints{$key};
 637                                 if(exists $values{$key}) {
 638                                         my $value = $values{$key};
 639                                         delete $values{$key};
 640                                         unless($type_constraint->check($value)) {
 641                                                 return;
 642                                         }
 643                                 } else {
 644                     ## Test to see if the TC supports null values
 645                                         unless($type_constraint->check()) {
 646                                                 return;
 647                                         }
 648                                 }
 649                         }
 650                         ## Make sure there are no leftovers.
 651                         if(%values) {
 652                 if($overflow_handler) {
 653                     return $overflow_handler->(%values);
 654                 } else {
 655                     return;
 656                 }
 657                         } elsif(%type_constraints) {
 658                                 return;
 659                         } else {
 660                                 return 1;
 661                         }
 662                 },
 663         )
 664 );
 665
 666 OPTIONAL: {
 667     my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
 668         name => 'MooseX::Types::Structured::Optional',
 669         package_defined_in => __PACKAGE__,
 670         parent => find_type_constraint('Item'),
 671         constraint => sub { 1 },
 672         constraint_generator => sub {
 673             my ($type_parameter, @args) = @_;
 674             my $check = $type_parameter->_compiled_type_constraint();
 675             return sub {
 676                 my (@args) = @_;
 677                 ## Does the arg exist?  Something exists if it's a 'real' value
 678                 ## or if it is set to undef.
 679                 if(exists($args[0])) {
 680                     ## If it exists, we need to validate it
 681                     $check->($args[0]);
 682                 } else {
 683                     ## But it's is okay if the value doesn't exists
 684                     return 1;
 685                 }
 686             }
 687         }
 688     );
 689
 690     Moose::Util::TypeConstraints::register_type_constraint($Optional);
 691     Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
 692 }
 693
 694 sub slurpy($) {
 695         my $tc = shift @_;
 696         ## we don't want to force the TC to be a Moose::Meta::TypeConstraint, we
 697         ## just want to make sure it provides the minimum needed bits to function.
 698         if($tc and ref $tc and $tc->can('check') and $tc->can('is_subtype_of') ) {
 699                 return sub {
 700                         if($tc->is_subtype_of('HashRef')) {
 701                                 return $tc->check(+{@_});
 702                         } elsif($tc->is_subtype_of('ArrayRef')) {
 703                                 return $tc->check([@_]);
 704                         } else {
 705                                 return;
 706                         }
 707                 };
 708         } else {
 709                 ## For now just pass it all to check and cross our fingers
 710                 return sub {
 711                         return $tc->check(@_);
 712                 };
 713         }
 714 }
 715
 716 =head1 SEE ALSO
 717
 718 The following modules or resources may be of interest.
 719
 720 L<Moose>, L<MooseX::Types>, L<Moose::Meta::TypeConstraint>,
 721 L<MooseX::Meta::TypeConstraint::Structured>
 722
 723 =head1 TODO
 724
 725 Here's a list of stuff I would be happy to get volunteers helping with:
 726
 727 All POD examples need test cases in t/documentation/*.t
 728 Want to break out the examples section to a separate cookbook style POD.
 729 Want more examples and best practice / usage guidance for authors
 730 Need to clarify deep coercions,
 731 Need to clarify subtypes of subtypes.
 732
 733 =head1 AUTHOR
 734
 735 John Napiorkowski, C<< <jjnapiork@cpan.org> >>
 736
 737 =head1 COPYRIGHT & LICENSE
 738
 739 This program is free software; you can redistribute it and/or modify
 740 it under the same terms as Perl itself.
 741
 742 =cut
 743
 744 1;