use v5.14; use strict; use warnings; # The ugly lives in this package package MooseX::UnionInheritedTypeConstraint { use Moose::Role; use Moose::Util::TypeConstraints -all; use namespace::clean -except => ['meta']; around new => sub { my ($orig, $class, $name, %options) = @_; if (my $new = $options{isa}) { my $existing = $options{associated_class} -> find_attribute_by_name($name) -> type_constraint; if ($existing) { $new = Moose::Util::TypeConstraints::find_or_parse_type_constraint($new) unless ref $new; $options{isa} = union([$existing, $new]); } } $class->_process_isa_option($name, \%options); # maybe need to process coerce too?? return $class->$orig($name, %options); }; } # No ugly below! package KeyAtom { use Moose; has data => ( is => 'rw', isa => 'Str | RegexpRef', ); } package ValAtom { use Moose; extends 'KeyAtom'; has '+data' => ( traits => [ 'MooseX::UnionInheritedTypeConstraint' ], isa => 'ArrayRef | HashRef', ); } ValAtom->new(data => 'Hello'); # Str ValAtom->new(data => qr{Hello}); # RegexpRef ValAtom->new(data => []); # ArrayRef ValAtom->new(data => {}); # HashRef ValAtom->new(data => \*STDOUT); # none of the above... crash! #### my $tc = ValAtom->meta->get_attribute('data')->type_constraint; say $tc->_inline_check('$value') if $tc->can_be_inlined;