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