lib/MooseX/Types/Structured.pm

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