t/lib/DecoratorLibrary.pm

   1 package DecoratorLibrary;
   2
   3 use MooseX::Types::Moose qw( Str ArrayRef HashRef Int );
   4 use MooseX::Types
   5     -declare => [qw(
   6         MyArrayRefBase
   7         MyArrayRefInt01
   8         MyArrayRefInt02
   9         MyHashRefOfInts
  10         MyHashRefOfStr
  11         StrOrArrayRef
  12         AtLeastOneInt
  13     )];
  14
  15 ## Some questionable messing around
  16     sub my_subtype {
  17         my ($subtype, $basetype, @rest) = @_;
  18         return subtype($subtype, $basetype, shift @rest, shift @rest);
  19     }
  20
  21     sub my_from {
  22         return @_;
  23
  24     }
  25     sub my_as {
  26         return @_;
  27     }
  28 ## End
  29
  30 subtype MyArrayRefBase,
  31     as ArrayRef;
  32
  33 coerce MyArrayRefBase,
  34     from Str,
  35     via {[split(',', $_)]};
  36
  37 subtype MyArrayRefInt01,
  38     as ArrayRef[Int];
  39
  40 coerce MyArrayRefInt01,
  41     from Str,
  42     via {[split('\.',$_)]},
  43     from HashRef,
  44     via {[sort values(%$_)]};
  45
  46 subtype MyArrayRefInt02,
  47     as MyArrayRefBase[Int];
  48
  49 subtype MyHashRefOfInts,
  50     as HashRef[Int];
  51
  52 subtype MyHashRefOfStr,
  53     as HashRef[Str];
  54
  55 coerce MyArrayRefInt02,
  56     from Str,
  57     via {[split(':',$_)]},
  58     from MyHashRefOfInts,
  59     via {[sort values(%$_)]},
  60     from MyHashRefOfStr,
  61     via {[ sort map { length $_ } values(%$_) ]},
  62     ## Can't do HashRef[ArrayRef] here since if I do HashRef get the via {}
  63     ## Stuff passed as args and the associated prototype messed with it.  MST
  64     ## seems to have a line on it but might not fix fixable.
  65     from (HashRef[ArrayRef]),
  66     via {[ sort map { @$_ } values(%$_) ]};
  67
  68 subtype StrOrArrayRef,
  69     as Str|ArrayRef;
  70
  71 subtype AtLeastOneInt,
  72     ## Same problem as MyArrayRefInt02, see above.  Another way to solve it by
  73     ## forcing some sort of context.  Tried to fix this with method prototypes
  74     ## but just couldn't make it work.
  75     as (ArrayRef[Int]),
  76     where { @$_ > 0 };
  77
  78 1;